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.2 by williamc, Fri Aug 4 18:35:28 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: Cannont setup 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");
134 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
135   }
136  
137 < sub parentconfig {
137 > sub toolbox {
138          my $self=shift;
139 <        @_?$self->{parentconfig}=shift
140 <          :$self->{parentconfig};
139 >        if ( ! defined $self->{toolbox} ) {
140 >          $self->{toolbox}=BuildSystem::ToolBox->new($self);
141 >        }
142 >        return $self->{toolbox};
143   }
144  
145 < sub store {
145 > sub requirementsdoc {
146          my $self=shift;
147 <        my $location=shift;
148 <
149 <        my $fh=$self->openfile(">".$location);
150 <        $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();
147 >        if ( @_ ) {
148 >          $self->{reqdoc}=shift;
149 >        }
150 >        return (defined $self->{reqdoc})?$self->{reqdoc}:undef;
151   }
152  
153 < sub satellite {
153 > sub scramversion {
154          my $self=shift;
155 <        my $newarea=$self->copy(@_);
156 <        $newarea->_makesatellites();
157 <        return $newarea;
155 >        if ( ! defined $self->{scramversion} ) {
156 >          my $filename=$self->location()."/".$self->configurationdir()."/".
157 >                                                        "scram_version";
158 >          if ( -f $filename ) {
159 >            use FileHandle;
160 >            $fh=FileHandle->new();
161 >            open ($fh, "<".$filename);
162 >            my $version=<$fh>;
163 >            chomp $version;
164 >            $self->{scramversion}=$version;
165 >            undef $fh;
166 >          }
167 >        }
168 >        return $self->{scramversion};
169   }
170  
171 < sub copy {
171 > sub bootstrapfromlocation {
172          my $self=shift;
218        use File::Basename;
219        # create the area
173  
174 <        my $destination;
175 <        if ( @_ ) {
176 <         $destination=shift;
174 >        my $rv=0;
175 >        
176 >        my $location;
177 >        if ( ! defined ($location=$self->searchlocation(@_)) ) {
178 >         $rv=1;
179 >         $self->verbose("Unable to locate the top of local configuration area");
180          }
181          else {
182 <          my($location,$name)=$self->_defaultoptions();
183 <          $destination=$location."/".$name
182 >         $self->location($location);
183 >         $self->verbose("Found top ".$self->location());
184 >         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
185 >         $self->_LoadEnvFile();
186          }
187 <        #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};
187 >        return $rv;
188   }
189  
190   sub location {
# Line 292 | Line 205 | sub searchlocation {
205  
206          #start search in current directory if not specified
207          my $thispath;
208 <        @_?$thispath=shift
209 <          :$thispath=cwd();
208 >        if ( @_ ) {
209 >          $thispath=shift
210 >        }
211 >        else {
212 >          $thispath=cwd();
213 >        }
214  
215          my $rv=0;
216  
217 +        # chop off any files - we only want dirs
218 +        if ( -f $thispath ) {
219 +          $thispath=~s/(.*)\/.*/$1/;
220 +        }
221          Sloop:{
222          do {
223 < #         print "Searching $thispath\n";
223 >          $self->verbose("Searching $thispath");
224            if ( -e "$thispath/".$self->{admindir} ) {
225 < #           print "Found\n";
225 >            $self->verbose("Found\n");
226              $rv=1;
227              last Sloop;
228            }
# Line 310 | Line 231 | sub searchlocation {
231          return $rv?$thispath:undef;
232   }
233  
234 < sub meta {
234 > sub satellite {
235          my $self=shift;
236  
237 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
238 <                $self->location;
237 >        # -- create the sat object
238 >        my $sat=Configuration::ConfigArea->new();
239 >        $sat->name($self->name());
240 >        $sat->version($self->version());
241 >        $sat->requirementsdoc($self->requirementsdoc());
242 >        $sat->configurationdir($self->configurationdir());
243 >        $sat->setup(@_);
244 >
245 >        # -- copy across the cache
246 >        copy($self->cache()->location(),$sat->cache()->location());
247 >        # and make sure in reinitialises
248 >        undef ($sat->{cache});
249 >
250 >        # -- link it to this area
251 >        $sat->linkarea($self);
252 >
253   }
254  
255 < sub configitem {
255 > sub copy {
256          my $self=shift;
257 <        
258 <        return ($self->config()->find("ConfigItem",@_));
257 >        my $destination=shift;
258 >
259 >        # copy across the admin dir
260 >        my $temp=$self->location()."/".$self->{admindir};
261 >        AddDir::copydir($temp,"$destination/".$self->{admindir});
262   }
263  
264 < sub addconfigitem {
264 > sub align {
265          my $self=shift;
266 <        my $url=shift;
266 >        use File::Copy;
267  
268 <        my $docref=$self->activatedoc($url);
269 <        # Set up the document
270 <        $docref->setup();
271 <        $docref->save();
272 < #       $self->config()->storepolicy("local");
268 >        $self->_LoadEnvFile();
269 >        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
270 >        my $tmpEnvfile=$Envfile.".bak";
271 >        my $rel=$self->{ENV}{RELEASETOP};
272 >        my $local=$self->location();
273 >
274 >        rename( $Envfile, $tmpEnvfile );
275 >        use FileHandle;
276 >        my $fh=FileHandle->new();
277 >        my $fout=FileHandle->new();
278 >        open ( $fh, "<".$tmpEnvfile ) or
279 >                $self->error("Cannot find Environment file. Area Corrupted? ("
280 >                                .$self->location().")\n $!");
281 >        open ( $fout, ">".$Envfile ) or
282 >                $self->error("Cannot find Environment file. Area Corrupted? ("
283 >                                .$self->location().")\n $!");
284 >        while ( <$fh> ) {
285 >          $_=~s/\Q$rel\L/$local/g;
286 >          print $fout $_;
287 >        }
288 >        undef $fh;
289 >        undef $fout;
290   }
291  
292 < sub downloadtotop {
292 > sub copysetup {
293          my $self=shift;
294 <        my $url=shift;
295 <        my $dir=shift;
296 <        
297 <        # only download once
298 <        if ( ! -e $self->location()."/".$dir ) {
299 <          $self->{urlhandler}->download($url,$self->location()."/".$dir);
294 >        my $dest=shift;
295 >
296 >        my $rv=1;
297 >        # copy across the admin dir
298 >        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
299 >        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
300 >        if ( $temp ne $temp2 ) {
301 >         if ( -d $temp ) {
302 >          AddDir::copydir($temp,$temp2);
303 >          $rv=0;
304 >         }
305          }
306 +        return $rv;
307   }
308  
309 < sub _makesatellites {
309 > sub copyenv {
310          my $self=shift;
311 <        foreach $st ( values %{$self->{structures}} ) {
312 <           $st->setupsatellite()
311 >        my $hashref=shift;
312 >        
313 >        foreach $elem ( keys %{$self->{ENV}} ) {
314 >           $$hashref{$elem}=$self->{ENV}{$elem};
315          }
316   }
317  
318 < sub _storestructures {
318 > sub arch {
319          my $self=shift;
320 <        foreach $struct ( values %{$self->{structures}} ) {
358 <          $self->config()->store($struct, "Structures", $struct->name());
359 <        }
320 >        return $ENV{SCRAM_ARCH};
321   }
322  
323 < sub _restorestructures {
323 > sub linkto {
324          my $self=shift;
325 <        my @strs=$self->config()->find("Structures");
326 <        foreach $struct ( @strs ) {
327 <          $struct->parent($self);
328 <          $self->{structures}{$struct->name()}=$struct;
325 >        my $location=shift;
326 >        if ( -d $location ) {
327 >        my $area=Configuration::ConfigArea->new();
328 >        $area->bootstrapfromlocation($location);
329 >        $self->linkarea($area);
330 >        }
331 >        else {
332 >          $self->error("ConfigArea : Unable to link to non existing directory ".
333 >                         $location);
334          }
335   }
336  
337 < sub _defaultoptions {
337 > sub unlinkarea {
338          my $self=shift;
339 <        my $name;
340 <        my $location;
341 <
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);
339 >        undef $self->{linkarea};
340 >        $self->{linkarea}=undef;
341 >        $self->save();
342   }
392 # -------------- Tags ---------------------------------
393 # -- init parse
394 sub Project_Start {
395        my $self=shift;
396        my $name=shift;
397        my $hashref=shift;
343  
344 <        $self->checktag($name,$hashref,'name');
345 <        $self->checktag($name,$hashref,'version');
346 <
347 <        $self->name($$hashref{'name'});
348 <        $self->version($$hashref{'version'});
344 > sub linkarea {
345 >        my $self=shift;
346 >        my $area=shift;
347 >        if ( defined $area ) {
348 >          $self->{linkarea}=$area;
349 >        }
350 >        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
351 >                        $self->{linkarea}:undef;
352   }
353  
354 <
407 < sub Project_text {
354 > sub save {
355          my $self=shift;
356 <        my $name=shift;
410 <        my $string=shift;
411 <
412 <        print $string;
356 >        $self->_SaveEnvFile();
357   }
358  
359 < # ---- download parse
359 > # ---- support routines
360  
361 < sub Download_Start {
361 > sub _SaveEnvFile {
362          my $self=shift;
363 <        my $name=shift;
364 <        my $hashref=shift;
365 <
366 <        $self->checktag($name,$hashref,'url');
367 <        $self->checktag($name,$hashref,'location');
368 <        if ( $$hashref{'location'}!~/^\w/ ) {
369 <          $self->parseerror("location must start with an".
370 <                " alphanumeric character");
363 >        use FileHandle;
364 >        my $fh=FileHandle->new();
365 >        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
366 >                "Environment" ) or
367 >                $self->error("Cannot Open Environment file to Save ("
368 >                                .$self->location().")\n $!");
369 >        
370 >        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
371 >        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
372 >        print $fh "projconfigdir=".$self->configurationdir()."\n";
373 >        print $fh "SCRAM_ProjReqsDoc=".$self->requirementsdoc()."\n";
374 >        if ( defined $self->linkarea() ) {
375 >          my $area=$self->linkarea()->location();
376 >          if ( $area ne "" ) {
377 >          print $fh "RELEASETOP=".$area."\n";
378 >          }
379          }
380 <        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'});
380 >        undef $fh;
381   }
382  
442 # --- setup parse
383  
384 < sub Structure_Start {
384 > sub _LoadEnvFile {
385          my $self=shift;
446        my $name=shift;
447        my $hashref=shift;
386  
387 <        $self->checktag($name,$hashref,'name');
388 <        if ( !(( exists $$hashref{'type'}) || ( exists $$hashref{'url'})) ) {
389 <            $self->parseerror("No url or type given in <$name> tag");
390 <        }
391 <        if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
392 <          if ( exists $$hashref{'type'}) {
393 <            # create a new object of the specified type
394 <            eval "require $$hashref{'type'} ";
395 <            if  ( $@ ) {
396 <                $self->parseerror("Unable to instantiate type=".
397 <                        $$hashref{'type'}." in <$name> .".$@);
398 <            }
399 <            $self->{structures}{$$hashref{'name'}}=
400 <                $$hashref{'type'}->new($self->config());
401 <            $self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
402 <            $self->{structures}{$$hashref{'name'}}->parent($self);
403 <            $self->{structures}{$$hashref{'name'}}->vars($hashref);
404 <            $self->{structures}{$$hashref{'name'}}->arch($self->arch());
405 <          }
406 <          else { # its an activedoc
407 <                $self->{structures}{$$hashref{'name'}}=
408 <                                $self->activatedoc($$hashref{'url'});
409 <          }
410 <          $self->{structures}{$$hashref{'name'}}->setupbase();
387 >        use FileHandle;
388 >        my $fh=FileHandle->new();
389 >        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
390 >                "Environment" ) or
391 >                $self->error("Cannot find Environment file. Area Corrupted? ("
392 >                                .$self->location().")\n $!");
393 >        while ( <$fh> ) {
394 >           chomp;
395 >           next if /^#/;
396 >           next if /^\s*$/ ;
397 >           ($name, $value)=split /=/;
398 >           eval "\$self->{ENV}{${name}}=\"$value\"";
399 >        }
400 >        undef $fh;
401 >        
402 >        # -- set internal variables appropriately
403 >        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
404 >          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
405 >        }
406 >        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
407 >          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
408 >        }
409 >        if ( defined $self->{ENV}{"projconfigdir"} ) {
410 >          $self->configurationdir($self->{ENV}{projconfigdir});
411 >        }
412 >        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
413 >          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
414 >        }
415 >        if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
416 >                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
417 >          $self->linkto($self->{ENV}{"RELEASETOP"});
418          }
419          else {
420 <             $self->parseerror("Multiply defined Structure - ".
476 <                                                        $$hashref{'name'});
420 >          $self->{ENV}{"RELEASETOP"}=$self->location();
421          }
422   }
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