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.40 by muzaffar, Tue Mar 12 15:19:44 2013 UTC

# Line 1 | Line 1
1 #
2 # ConfigArea.pm
3 #
4 # Originally Written by Christopher Williams
5 #
6 # Description
7 # -----------
8 # creates and manages a configuration area
9 #
10 # Options
11 # -------
12 # ConfigArea_location
13 # ConfigArea_name
14 #
15 # Interface
16 # ---------
17 # new(ActiveConfig)             : A new ConfigArea object
18 # setup()                       : setup the configuration area
19 # location([dir])               : set/return the location of the area
20 # version([version])            : set/return the version of the area
21 # name([name])                  : set/return the name of the area
22 # store(location)               : store data in file location
23 # restore(location)             : restore data from file location
24 # meta()                        : return a description string of the area
25 # 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
33 # searchlocation([startdir])    : returns the location directory. search starts
34 #                                 from cwd if not specified
35 # defaultdirname()              : return the default directory name string
36 # copy(location)                : make a copy of the current area at the
37 #                                 specified location - defaults to cwd/default
38 #                                 if not specified . ConfigArea_name,
39 #                                 ConfigArea_location also override .
40 #                                 Return an object representing the area
41 # satellite()                   : make a satellite area based on $self
42 # arch([archobj])               : Set/get the architecture object
43 # structure(name)               : return the object corresponding to the
44 #                                 structure name
45 # structurelist()               : return list of structure objectS
46 # downloadtotop(dir,url)        : download the url to a dir in the config area
47 #                                
48
1   package Configuration::ConfigArea;
50 use ActiveDoc::ActiveDoc;
2   require 5.004;
3   use Utilities::AddDir;
4 < use ObjectUtilities::ObjectStore;
54 < use Configuration::ConfigStore;
55 < use Configuration::ActiveDoc_arch;
4 > use Utilities::Verbose;
5   use Cwd;
6 < @ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
58 <
59 < sub init {
60 <        my $self=shift;
6 > @ISA=qw(Utilities::Verbose);
7  
8 <        $self->newparse("init");
9 <        $self->newparse("download");
10 <        $self->newparse("setup");
11 <        $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);
76 <
77 <        # data init
8 > sub new {
9 >        my $class=shift;
10 >        my $self={};
11 >        bless $self, $class;
12          $self->{admindir}=".SCRAM";
13 +        $self->{configurationdir} = "config";
14 +        $self->{forcearch} = shift || "";
15 +        $self->{arch} = $self->{forcearch} || $ENV{SCRAM_ARCH};
16 +        return $self;
17 + }
18 +
19 + sub toolcachename
20 +   {
21 +   my $self=shift;
22 +   return ($self->archdir()."/ToolCache.db.gz");
23 +   }
24 +
25 + sub projectcachename
26 +   {
27 +   my $self=shift;
28 +   return ($self->archdir()."/ProjectCache.db.gz");
29 +   }
30 +
31 + sub symlinks {
32 +        my $self=shift;
33 +        if (@_) {$self->{symlinks}=shift;}
34 +        return $self->{symlinks};
35 + }
36 +
37 + sub calchksum {
38 +        my $self=shift;
39 +        my $dir=$self->location()."/".$self->configurationdir();
40 +        my $sum="";
41 +        if (-f "${dir}/config_tag")
42 +           {
43 +           my $ref;
44 +           open ($ref, "${dir}/config_tag");
45 +           $sum=<$ref>;
46 +           close($ref);
47 +           chomp $sum;
48 +           }
49 +        else
50 +           {
51 +           push @INC,$dir;
52 +           require SCRAM::Plugins::ProjectChkSum;
53 +           $sum=&SCRAM::Plugins::ProjectChkSum::chksum($dir);
54 +           pop @INC;
55 +           }
56 +        return $sum;
57   }
58  
59 < sub basearea {
82 <        my $self=shift;
83 <
84 <        my $area;
85 <        if ( @_ ) {
86 <          $area=shift;
87 <          $self->config()->store($area,"BaseArea");
88 <        }
89 <        else {
90 <          ($area)=$self->config()->restore("BaseArea");
91 <        }
92 <        return $area;
93 < }
94 <
95 < sub freebase {
59 > sub configchksum {
60          my $self=shift;
61 <        $self->config()->delete("BaseArea");
61 >        if (@_) {$self->{configchksum}=shift;}
62 >        return $self->{configchksum};
63   }
64  
100 sub defaultdirname {
101        my $self=shift;
102        my $name=$self->name();
103        my $vers=$self->version();
104        $vers=~s/^$name\_//;
105        $name=$name."_".$vers;
106        return $name;
107 }
108
109
110 sub setup {
111        my $self=shift;
65  
66 <        # --- find out the location - default is cwd
114 <        my $location=$self->option("ConfigArea_location");
115 <        if ( ! defined $location ) {
116 <                $location=cwd();
117 <        }
118 <        elsif ( $location!~/^\// ) {
119 <                $location=cwd()."/".$location;
120 <        }
121 <
122 <        # --- find area directory name , default name projectname_version
123 <        my $name=$self->option("ConfigArea_name");
124 <        if ( ! defined $name ) {
125 <          $name=$self->defaultdirname();
126 <        }
127 <        $self->location($location."/".$name);
128 <
129 <        # make a new store handler
130 <        $self->_setupstore();
131 <
132 <        # --- download everything first
133 <        $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 < }
145 <
146 < sub structure {
66 > sub name {
67          my $self=shift;
68 <        my $vr=shift;
69 <        return $self->{structures}{$vr};
68 >        @_?$self->{name}=shift
69 >          :$self->{name};
70   }
71  
72 < sub structurelist {
72 > sub version {
73          my $self=shift;
74 <        return ( keys %{$self->{structures}} );
74 >        @_?$self->{version}=shift
75 >          :$self->{version};
76   }
77  
78 < sub _setupstore {
78 > sub setup {
79          my $self=shift;
80 <
81 <        # --- make a new ConfigStore at the location and add it to the db list
82 <        my $ad=Configuration::ConfigStore->new($self->location().
83 <                                "/".$self->{admindir}, $self->arch());
84 <
85 <        $self->parentconfig($self->config());
86 < #        $self->config(Configuration::ConfigureStore->new());
87 < #        $self->config()->db("local",$ad);
88 < #        $self->config()->db("parent",$self->parentconfig());
89 < #        $self->config()->policy("cache","local");
90 <        $self->config($ad);
91 <        $self->config()->basedoc($self->parentconfig()->basedoc());
80 >        my $location=shift;
81 >        my $areaname=shift  || undef;
82 >        my $symlinks=shift  || 0;
83 >        my $locarea = shift || undef;
84 >        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
85 >          $areaname=$self->version();
86 >        }
87 >        $self->location($location."/".$areaname);
88 >        $self->symlinks($symlinks);
89 >        if ($self->configchksum() ne "")
90 >           {
91 >           if ((!-defined $locarea) && (-f "${location}/${areaname}/".$self->admindir()."/Environment"))
92 >              {
93 >              $locarea=Configuration::ConfigArea->new();
94 >              $locarea->bootstrapfromlocation("${location}/${areaname}");
95 >              }
96 >           if ((defined $locarea) && ($locarea->configchksum() != $self->configchksum()))
97 >              {
98 >              print "ERROR: Can not setup your current working area for SCRAM_ARCH: $ENV{SCRAM_ARCH}\n",
99 >                    "Your current development area ${location}/${areaname}\n",
100 >                    "is using a different ${areaname}/config then the one used for\n",
101 >                    $self->releasetop(),".\n";
102 >              exit 1;
103 >              }
104 >           }
105 >        Utilities::AddDir::adddir($self->archdir());
106   }
107  
108 < sub bootstrapfromlocation {
108 > sub configurationdir {
109          my $self=shift;
110 <        
111 <        if ( ! defined $self->location(@_) ) {
177 <          $self->error("Unable to locate the top of local configuration area");
110 >        if ( @_ ) {
111 >          $self->{configurationdir}=shift;
112          }
113 <        print "Found top ".$self->location()."\n";
180 <        $self->_setupstore();
181 <        $self->restore($self->location()."/".$self->{admindir}.
182 <                                                "/ConfigArea.dat");
113 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
114   }
115  
116 < sub parentconfig {
116 > sub sourcedir {
117          my $self=shift;
118 <        @_?$self->{parentconfig}=shift
119 <          :$self->{parentconfig};
118 >        if ( @_ ) {
119 >          $self->{sourcedir}=shift;
120 >        }
121 >        return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
122   }
123  
124 < sub store {
124 > sub releasetop {
125          my $self=shift;
126 <        my $location=shift;
127 <
128 <        my $fh=$self->openfile(">".$location);
129 <        $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();
126 >        if ( @_ ) {
127 >          $self->{releasetop}=shift;
128 >        }
129 >        return (defined $self->{releasetop})?$self->{releasetop}:undef;
130   }
131  
132 < sub satellite {
133 <        my $self=shift;
134 <        my $newarea=$self->copy(@_);
135 <        $newarea->_makesatellites();
136 <        return $newarea;
137 < }
132 > sub admindir()
133 >   {
134 >   my $self=shift;
135 >  
136 >   @_ ? $self->{admindir} = shift
137 >      : $self->{admindir};
138 >   }
139  
140 < sub copy {
140 > sub bootstrapfromlocation {
141          my $self=shift;
142 <        use File::Basename;
143 <        # create the area
144 <
145 <        my $destination;
218 <        if ( @_ ) {
219 <         $destination=shift;
142 >        my $location = $self->searchlocation(shift);
143 >        my $rv=0;
144 >        if ( ! defined $location) {
145 >         $rv=1;
146          }
147          else {
148 <          my($location,$name)=$self->_defaultoptions();
149 <          $destination=$location."/".$name
148 >         $self->location($location);
149 >         $self->_LoadEnvFile();
150          }
151 <        #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;
238 < }
239 <
240 < sub restore {
241 <        my $self=shift;
242 <        my $location=shift;
243 <
244 <        my $fh=$self->openfile("<".$location);
245 <        my $varhash={};
246 <        $self->restorevars($fh,$varhash);
247 <        if ( ! defined $self->location() ) {
248 <          $self->location($$varhash{"location"});
249 <        }
250 <        $self->_setupstore();
251 <        $self->url($$varhash{"url"});
252 <        $self->name($$varhash{"name"});
253 <        $self->version($$varhash{"version"});
254 <        $fh->close();
255 <
256 <        $self->_restorestructures();
257 < }
258 <
259 < sub name {
260 <        my $self=shift;
261 <
262 <        @_?$self->{name}=shift
263 <          :$self->{name};
264 < }
265 <
266 < sub version {
267 <        my $self=shift;
268 <
269 <        @_?$self->{version}=shift
270 <          :$self->{version};
151 >        return $rv;
152   }
153  
154   sub location {
# Line 275 | Line 156 | sub location {
156  
157          if ( @_ ) {
158            $self->{location}=shift;
159 +          delete $self->{archs};
160 +          $self->_setAreaArch();
161          }
162          elsif ( ! defined $self->{location} ) {
163            # try and find the release location
164            $self->{location}=$self->searchlocation();
165 +          if (defined $self->{location})
166 +             {
167 +             $self->_setAreaArch()
168 +             }
169          }
170          return  $self->{location};
171   }
172  
173   sub searchlocation {
174          my $self=shift;
175 <
175 >        
176          #start search in current directory if not specified
177          my $thispath;
178 <        @_?$thispath=shift
179 <          :$thispath=cwd();
180 <
178 >        if ( @_ ) {
179 >          $thispath=shift
180 >        }
181 >        else {
182 >          $thispath=cwd();
183 >        }
184 >        
185          my $rv=0;
186  
187 +        # chop off any files - we only want dirs
188 +        if ( -f $thispath ) {
189 +          $thispath=~s/(.*)\/.*/$1/;
190 +        }
191          Sloop:{
192          do {
193 < #         print "Searching $thispath\n";
193 >          $self->verbose("Searching $thispath");
194            if ( -e "$thispath/".$self->{admindir} ) {
195 < #           print "Found\n";
195 >            $self->verbose("Found\n");
196              $rv=1;
197              last Sloop;
198            }
199          } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
200 <
200 >      
201          return $rv?$thispath:undef;
202   }
203  
204 < sub meta {
204 > sub archname {
205          my $self=shift;
206 <
207 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
208 <                $self->location;
209 < }
210 <
316 < sub configitem {
317 <        my $self=shift;
318 <        
319 <        return ($self->config()->find("ConfigItem",@_));
320 < }
321 <
322 < sub addconfigitem {
323 <        my $self=shift;
324 <        my $url=shift;
325 <
326 <        my $docref=$self->activatedoc($url);
327 <        # Set up the document
328 <        $docref->setup();
329 <        $docref->save();
330 < #       $self->config()->storepolicy("local");
331 < }
332 <
333 < sub downloadtotop {
334 <        my $self=shift;
335 <        my $url=shift;
336 <        my $dir=shift;
337 <        
338 <        # only download once
339 <        if ( ! -e $self->location()."/".$dir ) {
340 <          $self->{urlhandler}->download($url,$self->location()."/".$dir);
341 <        }
342 < }
343 <
344 < sub _makesatellites {
345 <        my $self=shift;
346 <        foreach $st ( values %{$self->{structures}} ) {
347 <           $st->setupsatellite()
206 >        if ( @_ ) {
207 >          $self->{arch} = shift;
208 >          if (defined $self->{location}) {
209 >             $self->archdir($self->{location}."/".$self->{admindir}."/".$self->{arch});
210 >          }
211          }
212 +        return $self->{arch};
213   }
214  
215 < sub _storestructures {
215 > sub archdir {
216          my $self=shift;
217 <        foreach $struct ( values %{$self->{structures}} ) {
218 <          $self->config()->store($struct, "Structures", $struct->name());
217 >        if ( @_ ) {
218 >          $self->{archdir}=shift;
219          }
220 +        return $self->{archdir};
221   }
222  
223 < sub _restorestructures {
223 > sub satellite {
224          my $self=shift;
225 <        my @strs=$self->config()->find("Structures");
226 <        foreach $struct ( @strs ) {
227 <          $struct->parent($self);
228 <          $self->{structures}{$struct->name()}=$struct;
229 <        }
225 >        my $relloc = $self->location();
226 >        my $sat=Configuration::ConfigArea->new($ENV{SCRAM_ARCH});
227 >        $sat->name($self->name());
228 >        $sat->version($self->version());
229 >        $sat->configurationdir($self->configurationdir());
230 >        $sat->sourcedir($self->sourcedir());
231 >        $sat->releasetop($relloc);
232 >        $sat->configchksum($self->configchksum());
233 >        $sat->setup(@_);
234 >        $self->copywithskip($self->archdir(),$sat->archdir(),["InstalledTools","ProjectCache.db.gz","RuntimeCache.db.gz","DirCache.db.gz","MakeData/DirCache","MakeData/DirCache.mk","MakeData/src.mk"]);
235 >        $envfile = $sat->archdir()."/Environment";
236 >        open ( $fh, "> $envfile" ) or  $sat->error("Cannot Open \"$envfile\" file to Save\n $!");
237 >        print $fh "RELEASETOP=$relloc\n";
238 >        close($fh);
239 >        my $devconf = $sat->location()."/".$sat->configurationdir();
240 >        my $relconf = $self->location()."/".$self->configurationdir();
241 >        if (!-d $devconf)
242 >           {
243 >           $self->copywithskip($relconf,$devconf,['toolbox']);
244 >           }
245 >        $envfile = $sat->location()."/".$self->{admindir}."/Environment";
246 >        if (! -f $envfile)
247 >           {
248 >           $sat->save ();
249 >           }
250 >        Utilities::AddDir::copydir("${relconf}/toolbox/".$self->{arch},"${devconf}/toolbox/".$self->{arch});
251 >        Utilities::AddDir::adddir ($sat->location()."/".$sat->sourcedir());
252 >        return $sat;
253 > }
254 >
255 > sub copywithskip {
256 >        my $self=shift;
257 >        my $src=shift;
258 >        my $des=shift;
259 >        my $filetoskip=shift || [];
260 >        my $rv=1;
261 >        if ( $src ne $des )
262 >           {
263 >           if ( -d $src )
264 >              {
265 >              my $fs=[];
266 >              foreach my $f (@$filetoskip) {push @$fs,"${src}/${f}";}
267 >              Utilities::AddDir::copydirwithskip($src,$des,$fs);
268 >              $rv=0;
269 >             }
270 >           }
271 >        return $rv;
272   }
273  
274 < sub _defaultoptions {
368 <        my $self=shift;
369 <        my $name;
370 <        my $location;
371 <
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);
387 < }
388 < # -------------- Tags ---------------------------------
389 < # -- init parse
390 < sub Project_Start {
274 > sub copyenv {
275          my $self=shift;
392        my $name=shift;
276          my $hashref=shift;
277 <
278 <        $self->checktag($name,$hashref,'name');
279 <        $self->checktag($name,$hashref,'version');
280 <
398 <        $self->name($$hashref{'name'});
399 <        $self->version($$hashref{'version'});
277 >        
278 >        foreach $elem ( keys %{$self->{ENV}} ) {
279 >           $$hashref{$elem}=$self->{ENV}{$elem};
280 >        }
281   }
282  
283 <
403 < sub Project_text {
283 > sub arch {
284          my $self=shift;
285 <        my $name=shift;
406 <        my $string=shift;
407 <
408 <        print $string;
285 >        return $self->{arch};
286   }
287  
288 < # ---- download parse
412 <
413 < sub Download_Start {
288 > sub save {
289          my $self=shift;
290 <        my $name=shift;
416 <        my $hashref=shift;
417 <
418 <        $self->checktag($name,$hashref,'url');
419 <        $self->checktag($name,$hashref,'location');
420 <        if ( $$hashref{'location'}!~/^\w/ ) {
421 <          $self->parseerror("location must start with an".
422 <                " alphanumeric character");
423 <        }
424 <        print "Downloading .... ".$$hashref{'url'}."\n";
425 <        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
290 >        $self->_SaveEnvFile();
291   }
292  
293 < 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'});
436 < }
293 > # ---- support routines
294  
295 < # --- setup parse
296 <
297 < sub Structure_Start {
298 <        my $self=shift;
299 <        my $name=shift;
300 <        my $hashref=shift;
301 <
302 <        $self->checktag($name,$hashref,'name');
303 <        if ( !( exists $$hashref{'type'}) || ( exists $$hashref{'url'}) ) {
304 <            $self->parseerror("No url or type given in <$name> tag");
305 <        }
306 <        if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
307 <          if ( exists $$hashref{'type'}) {
308 <            # create a new object of the specified type
309 <            eval "require $$hashref{'type'} ";
310 <            if  ( $@ ) {
311 <                $self->parseerror("Unable to instantiate type=".
312 <                        $$hashref{'type'}." in <$name> .".$@);
313 <            }
314 <            $self->{structures}{$$hashref{'name'}}=
458 <                $$hashref{'type'}->new($self->config());
459 <            $self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
460 <            $self->{structures}{$$hashref{'name'}}->parent($self);
461 <            $self->{structures}{$$hashref{'name'}}->vars($hashref);
462 <          }
463 <          else { # its an activedoc
464 <                $self->{structures}{$$hashref{'name'}}=
465 <                                $self->activatedoc($$hashref{'url'});
466 <          }
467 <          $self->{structures}{$$hashref{'name'}}->setupbase();
468 <        }
469 <        else {
470 <             $self->parseerror("Multiply defined Structure - ".
471 <                                                        $$hashref{'name'});
472 <        }
295 > sub _setAreaArch {
296 >  my ($self) = @_;
297 >  my $arch = $self->{forcearch};
298 >  if ($arch eq "")
299 >  {
300 >    if (!exists $self->{archs})
301 >    {
302 >      $self->{archs}=[];
303 >      my $toolbox = $self->{location}.'/'.$self->{configurationdir}.'/toolbox';
304 >      foreach my $arch (glob("${toolbox}/*")) {
305 >        if (-d "${arch}/tools") {
306 >          $arch=~s/^$toolbox\///;
307 >          push @{$self->{archs}},$arch;
308 >        }
309 >      }
310 >    }
311 >    if ((!-d "${toolbox}/".$self->{arch}) && (scalar(@{$self->{archs}})==1)) { $arch = $self->{archs}[0]; }
312 >  }
313 >  $self->archname($arch || $self->{arch});
314 >  return;
315   }
316  
317 < sub Use_Start {
318 <        my $self=shift;
319 <        my $name=shift;
320 <        my $hashref=shift;
317 > sub _SaveEnvFile
318 >   {
319 >   my $self=shift;
320 >  
321 >   my $fh;
322 >   my $envfile = $self->location()."/".$self->{admindir}."/Environment";
323 >   open ( $fh, "> $envfile" ) or  $self->error("Cannot Open \"$envfile\" file to Save\n $!");
324          
325 <        $self->checktag($name,$hashref,'url');
326 <        $self->addconfigitem($$hashref{'url'});
327 < }
328 <
325 >   print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
326 >   print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
327 >   print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n";
328 >   print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n";
329 >   print $fh "SCRAM_SYMLINKS=",$self->symlinks(),"\n";
330 >   print $fh "SCRAM_CONFIGCHKSUM=",$self->configchksum(),"\n";
331 >   close($fh);
332 >
333 >   # Set the default permissions (-rw-r--r--):
334 >   my $filemode = 0644;
335 >   chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
336 >   }
337 >
338 > sub _LoadEnvFile
339 >   {
340 >   my $self=shift;
341 >
342 >   my $fh;
343 >   my $envfile = $self->location()."/".$self->{admindir}."/Environment";
344 >   open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!");
345 >   while ( <$fh> )
346 >      {
347 >      chomp;
348 >      next if /^#/;
349 >      next if /^\s*$/ ;
350 >      ($name, $value)=split /=/;
351 >      eval "\$self->{ENV}{${name}}=\"$value\"";
352 >      }
353 >   close($fh);
354 >   $envfile = $self->archdir()."/Environment";
355 >   if (-f $envfile)
356 >      {
357 >      open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!");
358 >      while ( <$fh> )
359 >         {
360 >         chomp;
361 >         next if /^#/;
362 >         next if /^\s*$/ ;
363 >         ($name, $value)=split /=/;
364 >         eval "\$self->{ENV}{${name}}=\"$value\"";
365 >         }
366 >      close($fh);
367 >      }
368 >        
369 >   # -- set internal variables appropriately
370 >   if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} )
371 >      {
372 >      $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
373 >      }
374 >   if ( defined $self->{ENV}{"SCRAM_SYMLINKS"} )
375 >      {
376 >      $self->symlinks($self->{ENV}{"SCRAM_SYMLINKS"});
377 >      }
378 >   if ( defined $self->{ENV}{"SCRAM_CONFIGCHKSUM"} )
379 >      {
380 >      $self->configchksum($self->{ENV}{"SCRAM_CONFIGCHKSUM"});
381 >      }
382 >   if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} )
383 >      {
384 >      $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
385 >      }
386 >   if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} )
387 >      {
388 >      $self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"});
389 >      }
390 >   if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} )
391 >      {
392 >      $self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
393 >      }
394 >   if ( defined $self->{ENV}{"RELEASETOP"} )
395 >      {
396 >      $self->releasetop($self->{ENV}{"RELEASETOP"});
397 >      }
398 >   }
399 > 1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines