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.9 by williamc, Wed Feb 23 13:24:13 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->addtag("init","project",\&Project_Start,$self,
66 <            \&Project_text,$self,"", $self );
67 <        $self->addurltags("download");
68 <        $self->addtag("download","download",\&Download_Start,$self,
69 <                                                "", $self, "",$self);
70 <        $self->addtag("download","use",\&Use_download_Start,$self,
71 <                                                "", $self, "",$self);
72 <        $self->addurltags("setup");
73 <        $self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);
74 <        $self->addtag("setup","structure",\&Structure_Start,$self,
75 <                         "", $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;
83
84        my $area;
67          if ( @_ ) {
68 <          $area=shift;
87 <          $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();
104 <        $vers=~s/^$name\_//;
105 <        $name=$name."_".$vers;
106 <        return $name;
85 >        @_?$self->{version}=shift
86 >          :$self->{version};
87   }
88  
109
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 ) {
125 <          $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");
134 <        
135 <        # --- and parse the setup file
136 <        $self->parse("setup");
137 <        
138 <        # --- store bootstrap info
139 <        $self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
140 <
141 <        # --- store self in original database
142 <        $self->parentconfig()->store($self,"ConfigArea",$self->name(),
143 <                                                        $self->version());
144 < }
118 >        # -- create top level structure and work area
119 >        AddDir::adddir($workloc);
120  
121 < sub structure {
122 <        my $self=shift;
148 <        my $vr=shift;
149 <        return $self->{structures}{$vr};
150 < }
151 <
152 < sub structurelist {
153 <        my $self=shift;
154 <        return ( keys %{$self->{structures}} );
155 < }
156 <
157 < sub _setupstore {
158 <        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().
162 <                                "/".$self->{admindir}, $self->arch());
124 >        # -- Save Environment File
125 >        $self->_SaveEnvFile();
126  
164        $self->parentconfig($self->config());
165 #        $self->config(Configuration::ConfigureStore->new());
166 #        $self->config()->db("local",$ad);
167 #        $self->config()->db("parent",$self->parentconfig());
168 #        $self->config()->policy("cache","local");
169        $self->config($ad);
170        $self->config()->basedoc($self->parentconfig()->basedoc());
127   }
128  
129 < sub bootstrapfromlocation {
129 > sub configurationdir {
130          my $self=shift;
131 <        
132 <        if ( ! defined $self->location(@_) ) {
177 <          $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";
180 <        $self->_setupstore();
181 <        $self->restore($self->location()."/".$self->{admindir}.
182 <                                                "/ConfigArea.dat");
183 < }
184 <
185 < sub parentconfig {
186 <        my $self=shift;
187 <        @_?$self->{parentconfig}=shift
188 <          :$self->{parentconfig};
189 < }
190 <
191 < sub store {
192 <        my $self=shift;
193 <        my $location=shift;
194 <
195 <        my $fh=$self->openfile(">".$location);
196 <        $self->savevar($fh,"location", $self->location());
197 <        $self->savevar($fh,"url", $self->url());
198 <        $self->savevar($fh,"name", $self->name());
199 <        $self->savevar($fh,"version", $self->version());
200 <        $fh->close();
201 <
202 <        $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;
214        use File::Basename;
215        # create the area
216
217        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();
223 <          $destination=$location."/".$name
154 >          return undef;
155          }
225        #AddDir::adddir(dirname($destination)."/".$self->{admindir});
226        #AddDir::adddir($destination."/".$self->{admindir});
227        
228        # copy across the admin dir
229        $temp=$self->location()."/".$self->{admindir};
230        AddDir::copydir($temp,"$destination/".$self->{admindir});
231        # create a new object based on the new area
232        my $newarea=ref($self)->new($self->parentconfig());
233        $newarea->bootstrapfromlocation($destination);
234        # save it with the new location info
235        $newarea->store($self->location()."/".$self->{admindir}.
236                                                        "/ConfigArea.dat");
237        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 <
256 <        $self->_restorestructures();
257 < }
258 <
259 < sub name {
260 <        my $self=shift;
261 <
262 <        @_?$self->{name}=shift
263 <          :$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 288 | 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 306 | 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}} ) {
354 <          $self->config()->store($struct, "Structures", $struct->name());
355 <        }
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 <
372 <        # --- find out the location - default is cwd
373 <        $location=$self->option("ConfigArea_location");
374 <        if ( ! defined $location ) {
375 <                $location=cwd();
376 <        }
377 <        elsif ( $location!~/^\// ) {
378 <                $location=cwd()."/".$location;
379 <        }
380 <
381 <        # --- find area directory name , default name projectname_version
382 <        $name=$self->option("ConfigArea_name");
383 <        if ( ! defined $name ) {
384 <          $name=$self->defaultdirname();
385 <        }
386 <        return ($location,$name);
344 >        undef $self->{linkarea};
345 >        $self->{linkarea}=undef;
346 >        $self->save();
347   }
388 # -------------- Tags ---------------------------------
389 # -- init parse
390 sub Project_Start {
391        my $self=shift;
392        my $name=shift;
393        my $hashref=shift;
394
395        $self->checktag($name,$hashref,'name');
396        $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 <
403 < sub Project_text {
359 > sub save {
360          my $self=shift;
361 <        my $name=shift;
406 <        my $string=shift;
407 <
408 <        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";
425 <        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
426 < }
427 <
428 < sub Use_download_Start {
429 <        my $self=shift;
430 <        my $name=shift;
431 <        my $hashref=shift;
432 <
433 <        $self->checktag($name,$hashref,'url');
434 <        print "Downloading .... ".$$hashref{'url'}."\n";
435 <        $self->getfile($$hashref{'url'});
385 >        undef $fh;
386   }
387  
438 # --- setup parse
388  
389 < sub Structure_Start {
389 > sub _LoadEnvFile {
390          my $self=shift;
442        my $name=shift;
443        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 <          }
410 <          else { # its an activedoc
411 <                $self->{structures}{$$hashref{'name'}}=
412 <                                $self->activatedoc($$hashref{'url'});
413 <          }
414 <          $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 - ".
471 <                                                        $$hashref{'name'});
425 >          $self->{ENV}{"RELEASETOP"}=$self->location();
426          }
427   }
474
475 sub Use_Start {
476        my $self=shift;
477        my $name=shift;
478        my $hashref=shift;
479        
480        $self->checktag($name,$hashref,'url');
481        $self->addconfigitem($$hashref{'url'});
482 }
483

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines