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