ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/Configuration/ConfigArea.pm
(Generate patch)

Comparing COMP/SCRAM/src/Configuration/ConfigArea.pm (file contents):
Revision 1.11 by williamc, Thu Feb 24 14:24:29 2000 UTC vs.
Revision 1.13.2.6.2.3 by williamc, Tue Aug 8 11:11:58 2000 UTC

# Line 1 | Line 1
1   #
2   # ConfigArea.pm
3   #
4 < # Originally Written by Christopher Williams
4 > # Written by Christopher Williams
5   #
6   # Description
7   # -----------
8   # creates and manages a configuration area
9   #
10 < # Options
10 > # Notes
11   # -------
12 < # ConfigArea_location
13 < # ConfigArea_name
12 > # Persistency - remember to call the save method to make changes persistent
13   #
14   # Interface
15   # ---------
16 < # new(ActiveConfig)             : A new ConfigArea object
17 < # setup()                       : setup the configuration area
18 < # location([dir])               : set/return the location of the area
19 < # version([version])            : set/return the version of the area
20 < # name([name])                  : set/return the name of the area
21 < # store(location)               : store data in file location
22 < # restore(location)             : restore data from file location
23 < # meta()                        : return a description string of the area
24 < # addconfigitem(url)            : add a new item to the area
25 < # configitem(@keys)             : return a list of fig items that match
27 < #                                 the keys - all if left blank
28 < # parentstore()                 : set/return the parent ObjectStore
29 < # basearea(ConfigArea)          : Set/Get the base area
30 < # freebase()                    : Remove any link to a base area
31 < # bootstrapfromlocation([location]): bootstrap the object based on location.
32 < #                                 no location specified - cwd used
16 > # new()                         : A new ConfigArea object
17 > # name()                        : get/set project name
18 > # setup(dir[,areaname])         : setup a fresh area in dir
19 > # satellite(dir[,areaname])     : setup a satellite area in dir
20 > # version()                     : get/set project version
21 > # location([dir])               : set/return the location of the work area
22 > # bootstrapfromlocation([location]) : bootstrap the object based on location.
23 > #                                     no location specified - cwd used
24 > #                                     return 0 if succesful 1 otherwise
25 > # requirementsdoc()             : get set the requirements doc
26   # searchlocation([startdir])    : returns the location directory. search starts
27   #                                 from cwd if not specified
28 < # defaultdirname()              : return the default directory name string
29 < # copy(location)                : make a copy of the current area at the
30 < #                                 specified location - defaults to cwd/default
31 < #                                 if not specified . ConfigArea_name,
32 < #                                 ConfigArea_location also override .
33 < #                                 Return an object representing the area
34 < # satellite()                   : make a satellite area based on $self
35 < # arch([archobj])               : Set/get the architecture object
36 < # structure(name)               : return the object corresponding to the
37 < #                                 structure name
38 < # structurelist()               : return list of structure objectS
39 < # downloadtotop(dir,url)        : download the url to a dir in the config area
40 < #                                
28 > # scramversion()                : return the scram version associated with
29 > #                                 area
30 > # configurationdir()            : return the location of the project
31 > #                                 configuration directory
32 > # copy(location)                : copy a configuration
33 > # copysetup(location)           : copy the architecture specific tool setup
34 > #                                 returns 0 if successful, 1 otherwise
35 > # copyenv($ref)                 : copy the areas environment into the hashref
36 > # toolbox()                     : return the areas toolbox object
37 > # save()                        : save changes permanently
38 > # linkto(location)              : link the current area to that at location
39 > # unlinkarea()                  : destroy link (autosave)
40 > # linkarea([ConfigArea])        : link the current area to the apec Area Object
41 > # - temporary
42 > # align()                       : adjust hard paths to suit local loaction
43  
44   package Configuration::ConfigArea;
50 use ActiveDoc::ActiveDoc;
45   require 5.004;
46 + use URL::URLcache;
47   use Utilities::AddDir;
48 < use ObjectUtilities::ObjectStore;
54 < use Configuration::ConfigStore;
55 < use Configuration::ActiveDoc_arch;
48 > use Utilities::Verbose;
49   use Cwd;
50 < @ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
50 > @ISA=qw(Utilities::Verbose);
51  
52 < sub init {
53 <        my $self=shift;
54 <
55 <        $self->newparse("init");
63 <        $self->newparse("download");
64 <        $self->newparse("setup");
65 <        $self->newparse("setup_tools");
66 <        $self->addarchtags("setup_tools");
67 <        $self->addarchtags("setup");
68 <        $self->addtag("init","project",\&Project_Start,$self,
69 <            \&Project_text,$self,"", $self );
70 <        $self->addurltags("download");
71 <        $self->addtag("download","download",\&Download_Start,$self,
72 <                                                "", $self, "",$self);
73 <        $self->addtag("download","use",\&Use_download_Start,$self,
74 <                                                "", $self, "",$self);
75 <        $self->addurltags("setup");
76 <        $self->addtag("setup_tools","use",\&Use_Start,$self, "", $self, "",$self);
77 <        $self->addtag("setup","structure",\&Structure_Start,$self,
78 <                         "", $self, "",$self);
52 > sub new {
53 >        my $class=shift;
54 >        my $self={};
55 >        bless $self, $class;
56  
57          # data init
58 <        $self->{admindir}=".SCRAM";
58 >        $self->{admindir}=".SCRAM";
59 >        $self->{cachedir}="cache";
60 >        undef $self->{linkarea};
61 >
62 >        return $self;
63   }
64  
65 < sub basearea {
65 > sub cache {
66          my $self=shift;
86
87        my $area;
67          if ( @_ ) {
68 <          $area=shift;
90 <          $self->config()->store($area,"BaseArea");
68 >          $self->{cache}=shift;
69          }
70 <        else {
71 <          ($area)=$self->config()->restore("BaseArea");
70 >        elsif ( ! defined $self->{cache} ) {
71 >          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
72 >          $self->{cache}=URL::URLcache->new($loc);
73          }
74 <        return $area;
74 >        return $self->{cache};
75   }
76  
77 < sub freebase {
77 > sub name {
78          my $self=shift;
79 <        $self->config()->delete("BaseArea");
79 >        @_?$self->{name}=shift
80 >          :$self->{name};
81   }
82  
83 < sub defaultdirname {
83 > sub version {
84          my $self=shift;
85 <        my $name=$self->name();
86 <        my $vers=$self->version();
107 <        $vers=~s/^$name\_//;
108 <        $name=$name."_".$vers;
109 <        return $name;
85 >        @_?$self->{version}=shift
86 >          :$self->{version};
87   }
88  
112
89   sub setup {
90          my $self=shift;
91 +        my $location=shift;
92 +        my $areaname;
93  
94 <        # --- find out the location - default is cwd
95 <        my $location=$self->option("ConfigArea_location");
94 >        # -- check we have a project name and version
95 >        my $name=$self->name();
96 >        my $vers=$self->version();
97 >        if ( ( ! defined $name ) && ( ! defined $version )) {
98 >          $self->error("Set ConfigArea name and version before setup");
99 >        }
100 >
101 >        # -- check arguments and set location
102          if ( ! defined $location ) {
103 <                $location=cwd();
103 >          $self->error("ConfigArea: Cannot setup new area without a location");
104          }
105 <        elsif ( $location!~/^\// ) {
106 <                $location=cwd()."/".$location;
105 >        if ( @_ ) {
106 >          $areaname=shift;
107          }
108 <
109 <        # --- find area directory name , default name projectname_version
110 <        my $name=$self->option("ConfigArea_name");
111 <        if ( ! defined $name ) {
128 <          $name=$self->defaultdirname();
108 >        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
109 >          # -- make up a name from the project name and version
110 >          $vers=~s/^$name\_//;
111 >          $areaname=$name."_".$vers;
112          }
113 <        $self->location($location."/".$name);
114 <
115 <        # make a new store handler
116 <        $self->_setupstore();
113 >        my $arealoc=$location."/".$areaname;
114 >        my $workloc=$arealoc."/".$self->{admindir};
115 >        $self->verbose("Building at $arealoc");
116 >        $self->location($arealoc);
117  
118 <        # --- download everything first
119 <        $self->parse("download");
137 <        
138 <        # --- and parse the setup file
139 <        $self->parse("setup");
140 <        $self->parse("setup_tools");
141 <        
142 <        # --- store bootstrap info
143 <        $self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
144 <
145 <        # --- store self in original database
146 <        $self->parentconfig()->store($self,"ConfigArea",$self->name(),
147 <                                                        $self->version());
148 < }
118 >        # -- create top level structure and work area
119 >        AddDir::adddir($workloc);
120  
121 < sub structure {
122 <        my $self=shift;
152 <        my $vr=shift;
153 <        return $self->{structures}{$vr};
154 < }
155 <
156 < sub structurelist {
157 <        my $self=shift;
158 <        return ( keys %{$self->{structures}} );
159 < }
160 <
161 < sub _setupstore {
162 <        my $self=shift;
121 >        # -- add a cache
122 >        $self->cache();
123  
124 <        # --- make a new ConfigStore at the location and add it to the db list
125 <        my $ad=Configuration::ConfigStore->new($self->location().
166 <                                "/".$self->{admindir}, $self->arch());
124 >        # -- Save Environment File
125 >        $self->_SaveEnvFile();
126  
168        $self->parentconfig($self->config());
169 #        $self->config(Configuration::ConfigureStore->new());
170 #        $self->config()->db("local",$ad);
171 #        $self->config()->db("parent",$self->parentconfig());
172 #        $self->config()->policy("cache","local");
173        $self->config($ad);
174        $self->config()->basedoc($self->parentconfig()->basedoc());
127   }
128  
129 < sub bootstrapfromlocation {
129 > sub configurationdir {
130          my $self=shift;
131 <        
132 <        if ( ! defined $self->location(@_) ) {
181 <          $self->error("Unable to locate the top of local configuration area");
131 >        if ( @_ ) {
132 >          $self->{configurationdir}=shift;
133          }
134 <        print "Found top ".$self->location()."\n";
184 <        $self->_setupstore();
185 <        $self->restore($self->location()."/".$self->{admindir}.
186 <                                                "/ConfigArea.dat");
187 < }
188 <
189 < sub parentconfig {
190 <        my $self=shift;
191 <        @_?$self->{parentconfig}=shift
192 <          :$self->{parentconfig};
193 < }
194 <
195 < sub store {
196 <        my $self=shift;
197 <        my $location=shift;
198 <
199 <        my $fh=$self->openfile(">".$location);
200 <        $self->savevar($fh,"location", $self->location());
201 <        $self->savevar($fh,"url", $self->url());
202 <        $self->savevar($fh,"name", $self->name());
203 <        $self->savevar($fh,"version", $self->version());
204 <        $fh->close();
205 <
206 <        $self->_storestructures();
134 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
135   }
136  
137 < sub satellite {
137 > sub toolbox {
138          my $self=shift;
139 <        my $newarea=$self->copy(@_);
140 <        $newarea->_makesatellites();
141 <        return $newarea;
139 >        if ( ! defined $self->{toolbox} ) {
140 >          $self->{toolbox}=BuildSystem::ToolBox->new($self);
141 >        }
142 >        return $self->{toolbox};
143   }
144  
145 < sub copy {
145 > sub requirementsdoc {
146          my $self=shift;
218        use File::Basename;
219        # create the area
220
221        my $destination;
147          if ( @_ ) {
148 <         $destination=shift;
148 >          $self->{reqdoc}=shift;
149 >        }
150 >        if ( defined $self->{reqdoc} ) {
151 >          return $self->location()."/".$self->{reqdoc};
152          }
153          else {
154 <          my($location,$name)=$self->_defaultoptions();
227 <          $destination=$location."/".$name
154 >          return undef;
155          }
229        #AddDir::adddir(dirname($destination)."/".$self->{admindir});
230        #AddDir::adddir($destination."/".$self->{admindir});
231        
232        # copy across the admin dir
233        $temp=$self->location()."/".$self->{admindir};
234        AddDir::copydir($temp,"$destination/".$self->{admindir});
235        # create a new object based on the new area
236        my $newarea=ref($self)->new($self->parentconfig());
237        $newarea->bootstrapfromlocation($destination);
238        # save it with the new location info
239        $newarea->store($self->location()."/".$self->{admindir}.
240                                                        "/ConfigArea.dat");
241        return $newarea;
156   }
157  
158 < sub restore {
158 > sub scramversion {
159          my $self=shift;
160 <        my $location=shift;
161 <
162 <        my $fh=$self->openfile("<".$location);
163 <        my $varhash={};
164 <        $self->restorevars($fh,$varhash);
165 <        if ( ! defined $self->location() ) {
166 <          $self->location($$varhash{"location"});
167 <        }
168 <        $self->_setupstore();
169 <        $self->url($$varhash{"url"});
170 <        $self->name($$varhash{"name"});
171 <        $self->version($$varhash{"version"});
172 <        $fh->close();
173 <
260 <        $self->_restorestructures();
261 < }
262 <
263 < sub name {
264 <        my $self=shift;
265 <
266 <        @_?$self->{name}=shift
267 <          :$self->{name};
160 >        if ( ! defined $self->{scramversion} ) {
161 >          my $filename=$self->location()."/".$self->configurationdir()."/".
162 >                                                        "scram_version";
163 >          if ( -f $filename ) {
164 >            use FileHandle;
165 >            $fh=FileHandle->new();
166 >            open ($fh, "<".$filename);
167 >            my $version=<$fh>;
168 >            chomp $version;
169 >            $self->{scramversion}=$version;
170 >            undef $fh;
171 >          }
172 >        }
173 >        return $self->{scramversion};
174   }
175  
176 < sub version {
176 > sub bootstrapfromlocation {
177          my $self=shift;
178  
179 <        @_?$self->{version}=shift
180 <          :$self->{version};
179 >        my $rv=0;
180 >        
181 >        my $location;
182 >        if ( ! defined ($location=$self->searchlocation(@_)) ) {
183 >         $rv=1;
184 >         $self->verbose("Unable to locate the top of local configuration area");
185 >        }
186 >        else {
187 >         $self->location($location);
188 >         $self->verbose("Found top ".$self->location());
189 >         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
190 >         $self->_LoadEnvFile();
191 >        }
192 >        return $rv;
193   }
194  
195   sub location {
# Line 292 | Line 210 | sub searchlocation {
210  
211          #start search in current directory if not specified
212          my $thispath;
213 <        @_?$thispath=shift
214 <          :$thispath=cwd();
213 >        if ( @_ ) {
214 >          $thispath=shift
215 >        }
216 >        else {
217 >          $thispath=cwd();
218 >        }
219  
220          my $rv=0;
221  
222 +        # chop off any files - we only want dirs
223 +        if ( -f $thispath ) {
224 +          $thispath=~s/(.*)\/.*/$1/;
225 +        }
226          Sloop:{
227          do {
228 < #         print "Searching $thispath\n";
228 >          $self->verbose("Searching $thispath");
229            if ( -e "$thispath/".$self->{admindir} ) {
230 < #           print "Found\n";
230 >            $self->verbose("Found\n");
231              $rv=1;
232              last Sloop;
233            }
# Line 310 | Line 236 | sub searchlocation {
236          return $rv?$thispath:undef;
237   }
238  
239 < sub meta {
239 > sub satellite {
240          my $self=shift;
241  
242 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
243 <                $self->location;
242 >        # -- create the sat object
243 >        my $sat=Configuration::ConfigArea->new();
244 >        $sat->name($self->name());
245 >        $sat->version($self->version());
246 >        $sat->requirementsdoc($self->{reqdoc});
247 >        $sat->configurationdir($self->configurationdir());
248 >        $sat->setup(@_);
249 >
250 >        # -- copy across the cache
251 >        copy($self->cache()->location(),$sat->cache()->location());
252 >        # and make sure in reinitialises
253 >        undef ($sat->{cache});
254 >
255 >        # -- link it to this area
256 >        $sat->linkarea($self);
257 >
258   }
259  
260 < sub configitem {
260 > sub copy {
261          my $self=shift;
262 <        
263 <        return ($self->config()->find("ConfigItem",@_));
262 >        my $destination=shift;
263 >
264 >        # copy across the admin dir
265 >        my $temp=$self->location()."/".$self->{admindir};
266 >        AddDir::copydir($temp,"$destination/".$self->{admindir});
267   }
268  
269 < sub addconfigitem {
269 > sub align {
270          my $self=shift;
271 <        my $url=shift;
271 >        use File::Copy;
272  
273 <        my $docref=$self->activatedoc($url);
274 <        # Set up the document
275 <        $docref->setup();
276 <        $docref->save();
277 < #       $self->config()->storepolicy("local");
273 >        $self->_LoadEnvFile();
274 >        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
275 >        my $tmpEnvfile=$Envfile.".bak";
276 >        my $rel=$self->{ENV}{RELEASETOP};
277 >        my $local=$self->location();
278 >
279 >        rename( $Envfile, $tmpEnvfile );
280 >        use FileHandle;
281 >        my $fh=FileHandle->new();
282 >        my $fout=FileHandle->new();
283 >        open ( $fh, "<".$tmpEnvfile ) or
284 >                $self->error("Cannot find Environment file. Area Corrupted? ("
285 >                                .$self->location().")\n $!");
286 >        open ( $fout, ">".$Envfile ) or
287 >                $self->error("Cannot find Environment file. Area Corrupted? ("
288 >                                .$self->location().")\n $!");
289 >        while ( <$fh> ) {
290 >          $_=~s/\Q$rel\L/$local/g;
291 >          print $fout $_;
292 >        }
293 >        undef $fh;
294 >        undef $fout;
295   }
296  
297 < sub downloadtotop {
297 > sub copysetup {
298          my $self=shift;
299 <        my $url=shift;
300 <        my $dir=shift;
301 <        
302 <        # only download once
303 <        if ( ! -e $self->location()."/".$dir ) {
304 <          $self->{urlhandler}->download($url,$self->location()."/".$dir);
299 >        my $dest=shift;
300 >
301 >        my $rv=1;
302 >        # copy across the admin dir
303 >        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
304 >        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
305 >        if ( $temp ne $temp2 ) {
306 >         if ( -d $temp ) {
307 >          AddDir::copydir($temp,$temp2);
308 >          $rv=0;
309 >         }
310          }
311 +        return $rv;
312   }
313  
314 < sub _makesatellites {
314 > sub copyenv {
315          my $self=shift;
316 <        foreach $st ( values %{$self->{structures}} ) {
317 <           $st->setupsatellite()
316 >        my $hashref=shift;
317 >        
318 >        foreach $elem ( keys %{$self->{ENV}} ) {
319 >           $$hashref{$elem}=$self->{ENV}{$elem};
320          }
321   }
322  
323 < sub _storestructures {
323 > sub arch {
324          my $self=shift;
325 <        foreach $struct ( values %{$self->{structures}} ) {
358 <          $self->config()->store($struct, "Structures", $struct->name());
359 <        }
325 >        return $ENV{SCRAM_ARCH};
326   }
327  
328 < sub _restorestructures {
328 > sub linkto {
329          my $self=shift;
330 <        my @strs=$self->config()->find("Structures");
331 <        foreach $struct ( @strs ) {
332 <          $struct->parent($self);
333 <          $self->{structures}{$struct->name()}=$struct;
330 >        my $location=shift;
331 >        if ( -d $location ) {
332 >        my $area=Configuration::ConfigArea->new();
333 >        $area->bootstrapfromlocation($location);
334 >        $self->linkarea($area);
335 >        }
336 >        else {
337 >          $self->error("ConfigArea : Unable to link to non existing directory ".
338 >                         $location);
339          }
340   }
341  
342 < sub _defaultoptions {
342 > sub unlinkarea {
343          my $self=shift;
344 <        my $name;
345 <        my $location;
346 <
376 <        # --- find out the location - default is cwd
377 <        $location=$self->option("ConfigArea_location");
378 <        if ( ! defined $location ) {
379 <                $location=cwd();
380 <        }
381 <        elsif ( $location!~/^\// ) {
382 <                $location=cwd()."/".$location;
383 <        }
384 <
385 <        # --- find area directory name , default name projectname_version
386 <        $name=$self->option("ConfigArea_name");
387 <        if ( ! defined $name ) {
388 <          $name=$self->defaultdirname();
389 <        }
390 <        return ($location,$name);
344 >        undef $self->{linkarea};
345 >        $self->{linkarea}=undef;
346 >        $self->save();
347   }
392 # -------------- Tags ---------------------------------
393 # -- init parse
394 sub Project_Start {
395        my $self=shift;
396        my $name=shift;
397        my $hashref=shift;
398
399        $self->checktag($name,$hashref,'name');
400        $self->checktag($name,$hashref,'version');
348  
349 <        $self->name($$hashref{'name'});
350 <        $self->version($$hashref{'version'});
349 > sub linkarea {
350 >        my $self=shift;
351 >        my $area=shift;
352 >        if ( defined $area ) {
353 >          $self->{linkarea}=$area;
354 >        }
355 >        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
356 >                        $self->{linkarea}:undef;
357   }
358  
359 <
407 < sub Project_text {
359 > sub save {
360          my $self=shift;
361 <        my $name=shift;
410 <        my $string=shift;
411 <
412 <        print $string;
361 >        $self->_SaveEnvFile();
362   }
363  
364 < # ---- download parse
364 > # ---- support routines
365  
366 < sub Download_Start {
366 > sub _SaveEnvFile {
367          my $self=shift;
368 <        my $name=shift;
369 <        my $hashref=shift;
370 <
371 <        $self->checktag($name,$hashref,'url');
372 <        $self->checktag($name,$hashref,'location');
373 <        if ( $$hashref{'location'}!~/^\w/ ) {
374 <          $self->parseerror("location must start with an".
375 <                " alphanumeric character");
368 >        use FileHandle;
369 >        my $fh=FileHandle->new();
370 >        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
371 >                "Environment" ) or
372 >                $self->error("Cannot Open Environment file to Save ("
373 >                                .$self->location().")\n $!");
374 >        
375 >        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
376 >        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
377 >        print $fh "projconfigdir=".$self->configurationdir()."\n";
378 >        print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
379 >        if ( defined $self->linkarea() ) {
380 >          my $area=$self->linkarea()->location();
381 >          if ( $area ne "" ) {
382 >          print $fh "RELEASETOP=".$area."\n";
383 >          }
384          }
385 <        print "Downloading .... ".$$hashref{'url'}."\n";
429 <        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
430 < }
431 <
432 < sub Use_download_Start {
433 <        my $self=shift;
434 <        my $name=shift;
435 <        my $hashref=shift;
436 <
437 <        $self->checktag($name,$hashref,'url');
438 <        print "Downloading .... ".$$hashref{'url'}."\n";
439 <        $self->getfile($$hashref{'url'});
385 >        undef $fh;
386   }
387  
442 # --- setup parse
388  
389 < sub Structure_Start {
389 > sub _LoadEnvFile {
390          my $self=shift;
446        my $name=shift;
447        my $hashref=shift;
391  
392 <        $self->checktag($name,$hashref,'name');
393 <        if ( !(( exists $$hashref{'type'}) || ( exists $$hashref{'url'})) ) {
394 <            $self->parseerror("No url or type given in <$name> tag");
395 <        }
396 <        if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
397 <          if ( exists $$hashref{'type'}) {
398 <            # create a new object of the specified type
399 <            eval "require $$hashref{'type'} ";
400 <            if  ( $@ ) {
401 <                $self->parseerror("Unable to instantiate type=".
402 <                        $$hashref{'type'}." in <$name> .".$@);
403 <            }
404 <            $self->{structures}{$$hashref{'name'}}=
405 <                $$hashref{'type'}->new($self->config());
406 <            $self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
407 <            $self->{structures}{$$hashref{'name'}}->parent($self);
408 <            $self->{structures}{$$hashref{'name'}}->vars($hashref);
409 <            $self->{structures}{$$hashref{'name'}}->arch($self->arch());
410 <          }
411 <          else { # its an activedoc
412 <                $self->{structures}{$$hashref{'name'}}=
413 <                                $self->activatedoc($$hashref{'url'});
414 <          }
415 <          $self->{structures}{$$hashref{'name'}}->setupbase();
392 >        use FileHandle;
393 >        my $fh=FileHandle->new();
394 >        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
395 >                "Environment" ) or
396 >                $self->error("Cannot find Environment file. Area Corrupted? ("
397 >                                .$self->location().")\n $!");
398 >        while ( <$fh> ) {
399 >           chomp;
400 >           next if /^#/;
401 >           next if /^\s*$/ ;
402 >           ($name, $value)=split /=/;
403 >           eval "\$self->{ENV}{${name}}=\"$value\"";
404 >        }
405 >        undef $fh;
406 >        
407 >        # -- set internal variables appropriately
408 >        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
409 >          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
410 >        }
411 >        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
412 >          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
413 >        }
414 >        if ( defined $self->{ENV}{"projconfigdir"} ) {
415 >          $self->configurationdir($self->{ENV}{projconfigdir});
416 >        }
417 >        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
418 >          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
419 >        }
420 >        if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
421 >                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
422 >          $self->linkto($self->{ENV}{"RELEASETOP"});
423          }
424          else {
425 <             $self->parseerror("Multiply defined Structure - ".
476 <                                                        $$hashref{'name'});
425 >          $self->{ENV}{"RELEASETOP"}=$self->location();
426          }
427   }
479
480 sub Use_Start {
481        my $self=shift;
482        my $name=shift;
483        my $hashref=shift;
484        
485        $self->checktag($name,$hashref,'url');
486        $self->addconfigitem($$hashref{'url'});
487 }
488

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines