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.8 by williamc, Thu Feb 10 10:59:44 2000 UTC vs.
Revision 1.22 by sashby, Tue Dec 4 19:24:04 2001 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 + # Notes
11 + # -------
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
20 < #                                 the keys - all if left blank
21 < # parentstore()                 : set/return the parent ObjectStore
22 < # bootstrapfromlocation([location]): bootstrap the object based on location.
23 < #                                 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 - return an object
31 < #                                 representing the area
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 > # archname()            : get/set a string to indicate architecture
42 > # archdir()             : return the location of the administration arch dep
43 > #                         directory
44 > # objectstore()         : return the objectStore object of the area
45 > # - temporary
46 > # align()                       : adjust hard paths to suit local loaction
47  
48   package Configuration::ConfigArea;
32 use ActiveDoc::ActiveDoc;
49   require 5.004;
50 + use URL::URLcache;
51   use Utilities::AddDir;
52 + use Utilities::Verbose;
53   use ObjectUtilities::ObjectStore;
36 use Configuration::ConfigStore;
54   use Cwd;
55 < @ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
55 > @ISA=qw(Utilities::Verbose);
56 >
57 > sub new {
58 >        my $class=shift;
59 >        my $self={};
60 >        bless $self, $class;
61  
62 < sub init {
62 >        # data init
63 >        $self->{admindir}=".SCRAM";
64 >        $self->{cachedir}="cache";
65 >        $self->{dbdir}="ObjectDB";
66 >        undef $self->{linkarea};
67 >
68 >        return $self;
69 > }
70 >
71 > sub cache {
72          my $self=shift;
73  
74 <        $self->newparse("init");
75 <        $self->newparse("download");
76 <        $self->newparse("setup");
77 <        $self->addtag("init","project",\&Project_Start,$self,
78 <            \&Project_text,$self,"", $self );
79 <        $self->addurltags("download");
80 <        $self->addtag("download","use",\&Use_download_Start,$self,
81 <                                                "", $self, "",$self);
82 <        $self->addurltags("setup");
83 <        $self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);
74 >        if ( @_ ) {
75 >           $self->{cache}=shift;
76 >        }
77 >        if ( ! defined $self->{cache} ) {
78 >          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
79 >          if ( -e $loc  ) {
80 >            $self->{cache}=URL::URLcache->new($loc);
81 >          }
82 >          else {
83 >            $self->{cache}=undef;
84 >          }
85 >        }
86 >        return $self->{cache};
87 > }
88  
89 <        # data init
90 <        $self->{admindir}=".SCRAM";
89 > sub _newcache {
90 >        my $self=shift;
91 >        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
92 >        $self->{cache}=URL::URLcache->new($loc);
93 >        return $self->{cache};
94   }
95  
96 + sub _newobjectstore {
97 +        my $self=shift;
98 +        my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
99 +        $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
100 +        return $self->{dbstore};
101 + }
102  
103 < sub defaultdirname {
103 > sub objectstore {
104          my $self=shift;
61        my $name=$self->name();
62        my $vers=$self->version();
63        $vers=~s/^$name_//;
64        $name=$name."_".$vers;
65        return $name;
105  
106 +        if ( @_ ) {
107 +            $self->{dbstore}=shift;
108 +        }
109 +        if ( ! defined $self->{dbstore} ) {
110 +          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
111 +          if ( -e $loc ) {
112 +            $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
113 +          }
114 +          else {
115 +            $self->{dbstore}=undef;
116 +          }
117 +        }
118 +        return $self->{dbstore}
119 + }
120 +
121 + sub name {
122 +        my $self=shift;
123 +        @_?$self->{name}=shift
124 +          :$self->{name};
125 + }
126 +
127 + sub version {
128 +        my $self=shift;
129 +        @_?$self->{version}=shift
130 +          :$self->{version};
131   }
132  
133   sub setup {
134          my $self=shift;
135 +        my $location=shift;
136 +        my $areaname;
137  
138 <        # --- find out the location - default is cwd
139 <        my $location=$self->option("area_location");
138 >        # -- check we have a project name and version
139 >        my $name=$self->name();
140 >        my $vers=$self->version();
141 >        if ( ( ! defined $name ) && ( ! defined $version )) {
142 >          $self->error("Set ConfigArea name and version before setup");
143 >        }
144 >
145 >        # -- check arguments and set location
146          if ( ! defined $location ) {
147 <                $location=cwd();
147 >          $self->error("ConfigArea: Cannot setup new area without a location");
148          }
149 <        elsif ( $location!~/^\// ) {
150 <                $location=cwd()."/".$location;
149 >        if ( @_ ) {
150 >          $areaname=shift;
151          }
152 <
153 <        # --- find area directory name , default name projectname_version
154 <        my $name=$self->option("area_name");
155 <        if ( ! defined $name ) {
84 <          $name=$self->defaultdirname();
152 >        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
153 >          # -- make up a name from the project name and version
154 >          $vers=~s/^$name\_//;
155 >          $areaname=$name."_".$vers;
156          }
157 <        $self->location($location."/".$name);
157 >        my $arealoc=$location."/".$areaname;
158 >        my $workloc=$arealoc."/".$self->{admindir};
159 >        $self->verbose("Building at $arealoc");
160 >        $self->location($arealoc);
161  
162 <        # make a new store handler
163 <        $self->_setupstore();
162 >        # -- create top level structure and work area
163 >        AddDir::adddir($workloc);
164  
165 <        # --- download everything first
166 < # FIX-ME --- cacheing is broken
93 <        $self->parse("download");
94 <        
95 <        # --- and parse the setup file
96 <        $self->parse("setup");
97 <        
98 <        # --- store bootstrap info
99 <        $self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
165 >        # -- add a cache
166 >        $self->_newcache();
167  
168 <        # --- store self in original database
169 <        $self->parentconfig()->store($self,"ConfigArea",$self->name(),
103 <                                                        $self->version());
104 < }
168 >        # -- add an Objectstore
169 >        $self->_newobjectstore();
170  
171 < sub _setupstore {
172 <        my $self=shift;
108 <
109 <        # --- make a new ConfigStore at the location and add it to the db list
110 <        my $ad=Configuration::ConfigStore->new($self->location().
111 <                                "/".$self->{admindir});
171 >        # -- Save Environment File
172 >        $self->_SaveEnvFile();
173  
113        $self->parentconfig($self->config());
114 #        $self->config(Configuration::ConfigureStore->new());
115 #        $self->config()->db("local",$ad);
116 #        $self->config()->db("parent",$self->parentconfig());
117 #        $self->config()->policy("cache","local");
118        $self->config($ad);
119        $self->config()->basedoc($self->parentconfig()->basedoc());
174   }
175  
176 < sub bootstrapfromlocation {
176 > sub configurationdir {
177          my $self=shift;
178 <        
179 <        if ( ! defined $self->location(@_) ) {
126 <          $self->error("Unable to locate the top of local configuration area");
178 >        if ( @_ ) {
179 >          $self->{configurationdir}=shift;
180          }
181 <        print "Found top ".$self->location()."\n";
129 <        $self->_setupstore();
130 <        $self->restore($self->location()."/".$self->{admindir}.
131 <                                                "/ConfigArea.dat");
132 < }
133 <
134 < sub parentconfig {
135 <        my $self=shift;
136 <        @_?$self->{parentconfig}=shift
137 <          :$self->{parentconfig};
181 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
182   }
183  
184 < sub store {
184 > sub toolbox {
185          my $self=shift;
186 <        my $location=shift;
187 <
188 <        my $fh=$self->openfile(">".$location);
189 <        $self->savevar($fh,"location", $self->location());
146 <        $self->savevar($fh,"url", $self->url());
147 <        $self->savevar($fh,"name", $self->name());
148 <        $self->savevar($fh,"version", $self->version());
149 <        $fh->close();
186 >        if ( ! defined $self->{toolbox} ) {
187 >          $self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH});
188 >        }
189 >        return $self->{toolbox};
190   }
191  
192 < sub copy {
192 > sub requirementsdoc {
193          my $self=shift;
194 <        my $destination=shift;
195 <        use File::Basename;
196 <        # create the area
197 <
198 <        AddDir::adddir(dirname($destination));
199 <        
200 <        $temp=$self->location();
201 <        my @cpcmd=(qw(cp -r), "$temp", "$destination");
202 <        print "@cpcmd"."\n";
163 < #       File::Copy::copy("$self->location()", "$destination") or
164 <        system(@cpcmd) == 0 or
165 <                        $self->error("Cannot copy ".$self->location().
166 <                        " to $destination ".$!);
167 <
168 <        # create a new object based on the new area
169 <        my $newarea=ref($self)->new($self->parentconfig());
170 <        $newarea->bootstrapfromlocation($destination);
171 <        # save it with the new location info
172 <        $newarea->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
194 >        if ( @_ ) {
195 >          $self->{reqdoc}=shift;
196 >        }
197 >        if ( defined $self->{reqdoc} ) {
198 >          return $self->location()."/".$self->{reqdoc};
199 >        }
200 >        else {
201 >          return undef;
202 >        }
203   }
204  
205 < sub restore {
205 > sub scramversion {
206          my $self=shift;
207 <        my $location=shift;
208 <
209 <        my $fh=$self->openfile("<".$location);
210 <        my $varhash={};
211 <        $self->restorevars($fh,$varhash);
212 <        if ( ! defined $self->location() ) {
213 <          $self->location($$varhash{"location"});
214 <        }
215 <        $self->_setupstore();
216 <        $self->url($$varhash{"url"});
217 <        $self->name($$varhash{"name"});
218 <        $self->version($$varhash{"version"});
219 <        $fh->close();
207 >        if ( ! defined $self->{scramversion} ) {
208 >          my $filename=$self->location()."/".$self->configurationdir()."/".
209 >                                                        "scram_version";
210 >          if ( -f $filename ) {
211 >            use FileHandle;
212 >            $fh=FileHandle->new();
213 >            open ($fh, "<".$filename);
214 >            my $version=<$fh>;
215 >            chomp $version;
216 >            $self->{scramversion}=$version;
217 >            undef $fh;
218 >          }
219 >        }
220 >        return $self->{scramversion};
221   }
222  
223 < sub name {
224 <        my $self=shift;
223 > sub sitename
224 >   {
225 >   ###############################################################
226 >   # sitename()                                                  #
227 >   ###############################################################
228 >   # modified : Mon Dec  3 15:45:35 2001 / SFA                   #
229 >   # params   :                                                  #
230 >   #          :                                                  #
231 >   #          :                                                  #
232 >   #          :                                                  #
233 >   # function : Read the site name from config/site/sitename and #
234 >   #          : export it.                                       #
235 >   #          :                                                  #
236 >   #          :                                                  #
237 >   ###############################################################
238 >   my $self = shift;
239 >   my $sitefile = $self->location()."/".$self->configurationdir()."/site/sitename";
240 >
241 >   $self->{sitename} = 'CERN'; # Use CERN as the default site name
242 >
243 >   use FileHandle;
244 >   my $sitefh = FileHandle->new();
245 >
246 >   # Be verbose and print file we're going to read:
247 >   $self->verbose(">> Going to try to get sitename from: ".$sitefile." ");
248 >  
249 >   # See if we can read from the file. If not, just
250 >   # use default site name:
251 >   open($sitefh,"<".$sitefile) ||
252 >      do
253 >         {
254 >         $self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name.");
255 >         return $self->{sitename};
256 >         };
257 >  
258 >   $sitename = <$sitefh>;
259 >   chomp($sitename);
260 >   $self->{sitename} = $sitename;
261 >  
262 >   # Close the file (be tidy!);
263 >   close($sitefile);
264 >   # Return:
265 >   return $self->{sitename};
266 >   }
267  
195        @_?$self->{name}=shift
196          :$self->{name};
197 }
268  
269 < sub version {
269 > sub bootstrapfromlocation {
270          my $self=shift;
271  
272 <        @_?$self->{version}=shift
273 <          :$self->{version};
272 >        my $rv=0;
273 >        
274 >        my $location;
275 >        if ( ! defined ($location=$self->searchlocation(@_)) ) {
276 >         $rv=1;
277 >         $self->verbose("Unable to locate the top of local configuration area");
278 >        }
279 >        else {
280 >         $self->location($location);
281 >         $self->verbose("Found top ".$self->location());
282 >         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
283 >         $self->_LoadEnvFile();
284 >        }
285 >        return $rv;
286   }
287  
288   sub location {
# Line 211 | Line 293 | sub location {
293          }
294          elsif ( ! defined $self->{location} ) {
295            # try and find the release location
296 <          #$self->{location}=$self->searchlocation();
296 >          $self->{location}=$self->searchlocation();
297          }
298          return  $self->{location};
299   }
300  
301   sub searchlocation {
302          my $self=shift;
303 <
303 >        
304          #start search in current directory if not specified
305          my $thispath;
306 <        @_?$thispath=shift
307 <          :$thispath=cwd();
308 <
306 >        if ( @_ ) {
307 >          $thispath=shift
308 >        }
309 >        else {
310 >          $thispath=cwd();
311 >        }
312 >        
313          my $rv=0;
314  
315 +        # chop off any files - we only want dirs
316 +        if ( -f $thispath ) {
317 +          $thispath=~s/(.*)\/.*/$1/;
318 +        }
319          Sloop:{
320          do {
321 < #         print "Searching $thispath\n";
321 >          $self->verbose("Searching $thispath");
322            if ( -e "$thispath/".$self->{admindir} ) {
323 < #           print "Found\n";
323 >            $self->verbose("Found\n");
324              $rv=1;
325              last Sloop;
326            }
327          } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
328 <
328 >      
329          return $rv?$thispath:undef;
330   }
331  
332 < sub meta {
332 > sub archname {
333          my $self=shift;
334 +        if ( @_ ) {
335 +          $self->{archname}=shift;
336 +        }
337 +        return $self->{archname};
338 + }
339  
340 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
341 <                $self->location;
340 > sub archdir {
341 >        my $self=shift;
342 >        if ( @_ ) {
343 >          $self->{archdir}=shift;
344 >        }
345 >        if ( ! defined $self->{archdir} ) {
346 >         if ( defined $self->{archname} ) {
347 >          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
348 >                                                        $self->{archname};
349 >         }
350 >         else {
351 >          $self->error("ConfigArea : cannot create arch directory - ".
352 >                                                "architecture name not set")
353 >         }
354 >        }
355 >        return $self->{archdir};
356   }
357  
358 < sub configitem {
358 > sub satellite {
359          my $self=shift;
360 +
361 +        # -- create the sat object
362 +        my $sat=Configuration::ConfigArea->new();
363 +        $sat->name($self->name());
364 +        $sat->version($self->version());
365 +        $sat->requirementsdoc($self->{reqdoc});
366 +        $sat->configurationdir($self->configurationdir());
367 +        $sat->setup(@_);
368 +
369 +        # -- copy across the cache and ObjectStore
370 +        # -- make sure we dont try building new caches in release areas
371 +        my $rcache=$self->cache();
372 +        if ( defined $rcache ) {
373 +          copy($rcache->location(),$sat->cache()->location());
374 +        }
375 +
376 +        # -- make sure we dont try building new objectstores in release areas
377 +        my $rostore=$self->objectstore();
378 +        if ( defined $rostore ) {
379 +          copy($rostore->location(),$sat->objectstore()->location());
380 +        }
381 +
382 +        # and make sure in reinitialises
383 +        undef ($sat->{cache});
384 +
385 +        # -- link it to this area
386 +        $sat->linkarea($self);
387          
388 <        return ($self->config()->find("ConfigItem",@_));
388 >        # -- save it
389 >        $sat->save();
390 >
391 >        return $sat;
392   }
393  
394 < sub addconfigitem {
394 > sub copy {
395          my $self=shift;
396 <        my $url=shift;
396 >        my $destination=shift;
397  
398 <        my $docref=$self->activatedoc($url);
399 <        # Set up the document
400 <        $docref->setup();
401 <        $docref->save();
402 < #       $self->config()->storepolicy("local");
398 >        # copy across the admin dir
399 >        my $temp=$self->location()."/".$self->{admindir};
400 >        AddDir::copydir($temp,"$destination/".$self->{admindir});
401 > }
402 >
403 > sub align {
404 >        my $self=shift;
405 >        use File::Copy;
406 >
407 >        $self->_LoadEnvFile();
408 >        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
409 >        my $tmpEnvfile=$Envfile.".bak";
410 >        my $rel=$self->{ENV}{RELEASETOP};
411 >        my $local=$self->location();
412 >
413 >        rename( $Envfile, $tmpEnvfile );
414 >        use FileHandle;
415 >        my $fh=FileHandle->new();
416 >        my $fout=FileHandle->new();
417 >        open ( $fh, "<".$tmpEnvfile ) or
418 >                $self->error("Cannot find Environment file. Area Corrupted? ("
419 >                                .$self->location().")\n $!");
420 >        open ( $fout, ">".$Envfile ) or
421 >                $self->error("Cannot find Environment file. Area Corrupted? ("
422 >                                .$self->location().")\n $!");
423 >        while ( <$fh> ) {
424 >          $_=~s/\Q$rel\L/$local/g;
425 >          print $fout $_;
426 >        }
427 >        undef $fh;
428 >        undef $fout;
429   }
430  
431 < # -------------- Tags ---------------------------------
267 < # -- init parse
268 < sub Project_Start {
431 > sub copysetup {
432          my $self=shift;
433 <        my $name=shift;
271 <        my $hashref=shift;
433 >        my $dest=shift;
434  
435 <        $self->checktag($name,$hashref,'name');
436 <        $self->checktag($name,$hashref,'version');
437 <
438 <        $self->name($$hashref{'name'});
439 <        $self->version($$hashref{'version'});
435 >        my $rv=1;
436 >        # copy across the admin dir
437 >        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
438 >        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
439 >        if ( $temp ne $temp2 ) {
440 >         if ( -d $temp ) {
441 >          AddDir::copydir($temp,$temp2);
442 >          $rv=0;
443 >         }
444 >        }
445 >        return $rv;
446   }
447  
448 + sub copyenv {
449 +        my $self=shift;
450 +        my $hashref=shift;
451 +        
452 +        foreach $elem ( keys %{$self->{ENV}} ) {
453 +           $$hashref{$elem}=$self->{ENV}{$elem};
454 +        }
455 + }
456  
457 < sub Project_text {
457 > sub arch {
458          my $self=shift;
459 <        my $name=shift;
460 <        my $string=shift;
459 >        return $ENV{SCRAM_ARCH};
460 > }
461  
462 <        print $string;
462 > sub linkto {
463 >        my $self=shift;
464 >        my $location=shift;
465 >        if ( -d $location ) {
466 >        my $area=Configuration::ConfigArea->new();
467 >        $area->bootstrapfromlocation($location);
468 >        $self->linkarea($area);
469 >        }
470 >        else {
471 >          $self->error("ConfigArea : Unable to link to non existing directory ".
472 >                         $location);
473 >        }
474   }
475  
476 < # ---- download parse
476 > sub unlinkarea {
477 >        my $self=shift;
478 >        undef $self->{linkarea};
479 >        $self->{linkarea}=undef;
480 >        $self->save();
481 > }
482  
483 < sub Use_download_Start {
483 > sub linkarea {
484          my $self=shift;
485 <        my $name=shift;
486 <        my $hashref=shift;
485 >        my $area=shift;
486 >        if ( defined $area ) {
487 >          $self->{linkarea}=$area;
488 >        }
489 >        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
490 >                        $self->{linkarea}:undef;
491 > }
492  
493 <        $self->checktag($name,$hashref,'url');
494 <        print "Downloading .... ".$$hashref{'url'}."\n";
495 <        $self->getfile($$hashref{'url'});
493 > sub save {
494 >        my $self=shift;
495 >        $self->_SaveEnvFile();
496   }
497  
498 < # --- setup parse
498 > # ---- support routines
499  
500 < sub Use_Start {
500 > sub _SaveEnvFile {
501          my $self=shift;
502 <        my $name=shift;
503 <        my $hashref=shift;
502 >        use FileHandle;
503 >        my $fh=FileHandle->new();
504 >        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
505 >                "Environment" ) or
506 >                $self->error("Cannot Open Environment file to Save ("
507 >                                .$self->location().")\n $!");
508          
509 <        $self->checktag($name,$hashref,'url');
510 <        $self->addconfigitem($$hashref{'url'});
509 >        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
510 >        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
511 >        print $fh "projconfigdir=".$self->configurationdir()."\n";
512 >        print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
513 >        if ( defined $self->linkarea() ) {
514 >          my $area=$self->linkarea()->location();
515 >          if ( $area ne "" ) {
516 >          print $fh "RELEASETOP=".$area."\n";
517 >          }
518 >        }
519 >        undef $fh;
520   }
521  
522 +
523 + sub _LoadEnvFile {
524 +        my $self=shift;
525 +
526 +        use FileHandle;
527 +        my $fh=FileHandle->new();
528 +        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
529 +                "Environment" ) or
530 +                $self->error("Cannot find Environment file. Area Corrupted? ("
531 +                                .$self->location().")\n $!");
532 +        while ( <$fh> ) {
533 +           chomp;
534 +           next if /^#/;
535 +           next if /^\s*$/ ;
536 +           ($name, $value)=split /=/;
537 +           eval "\$self->{ENV}{${name}}=\"$value\"";
538 +        }
539 +        undef $fh;
540 +        
541 +        # -- set internal variables appropriately
542 +        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
543 +          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
544 +        }
545 +        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
546 +          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
547 +        }
548 +        if ( defined $self->{ENV}{"projconfigdir"} ) {
549 +          $self->configurationdir($self->{ENV}{projconfigdir});
550 +        }
551 +        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
552 +          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
553 +        }
554 +        if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
555 +                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
556 +          $self->linkto($self->{ENV}{"RELEASETOP"});
557 +        }
558 +        else {
559 +          $self->{ENV}{"RELEASETOP"}=$self->location();
560 +        }
561 + }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines