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.10 by williamc, Thu Feb 24 09:55:13 2000 UTC vs.
Revision 1.41 by muzaffar, Wed Mar 13 13:20:48 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->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);
79 <
80 <        # 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 {
85 <        my $self=shift;
86 <
87 <        my $area;
88 <        if ( @_ ) {
89 <          $area=shift;
90 <          $self->config()->store($area,"BaseArea");
91 <        }
92 <        else {
93 <          ($area)=$self->config()->restore("BaseArea");
94 <        }
95 <        return $area;
96 < }
97 <
98 < 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  
103 sub defaultdirname {
104        my $self=shift;
105        my $name=$self->name();
106        my $vers=$self->version();
107        $vers=~s/^$name\_//;
108        $name=$name."_".$vers;
109        return $name;
110 }
111
112
113 sub setup {
114        my $self=shift;
65  
66 <        # --- find out the location - default is cwd
117 <        my $location=$self->option("ConfigArea_location");
118 <        if ( ! defined $location ) {
119 <                $location=cwd();
120 <        }
121 <        elsif ( $location!~/^\// ) {
122 <                $location=cwd()."/".$location;
123 <        }
124 <
125 <        # --- find area directory name , default name projectname_version
126 <        my $name=$self->option("ConfigArea_name");
127 <        if ( ! defined $name ) {
128 <          $name=$self->defaultdirname();
129 <        }
130 <        $self->location($location."/".$name);
131 <
132 <        # make a new store handler
133 <        $self->_setupstore();
134 <
135 <        # --- download everything first
136 <        $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 < }
149 <
150 < 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(@_) ) {
181 <          $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";
184 <        $self->_setupstore();
185 <        $self->restore($self->location()."/".$self->{admindir}.
186 <                                                "/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());
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();
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;
222 <        if ( @_ ) {
223 <         $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});
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};
151 >        return $rv;
152   }
153  
154   sub location {
# Line 279 | 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 <
320 < sub configitem {
321 <        my $self=shift;
322 <        
323 <        return ($self->config()->find("ConfigItem",@_));
324 < }
325 <
326 < sub addconfigitem {
327 <        my $self=shift;
328 <        my $url=shift;
329 <
330 <        my $docref=$self->activatedoc($url);
331 <        # Set up the document
332 <        $docref->setup();
333 <        $docref->save();
334 < #       $self->config()->storepolicy("local");
335 < }
336 <
337 < sub downloadtotop {
338 <        my $self=shift;
339 <        my $url=shift;
340 <        my $dir=shift;
341 <        
342 <        # only download once
343 <        if ( ! -e $self->location()."/".$dir ) {
344 <          $self->{urlhandler}->download($url,$self->location()."/".$dir);
345 <        }
346 < }
347 <
348 < sub _makesatellites {
349 <        my $self=shift;
350 <        foreach $st ( values %{$self->{structures}} ) {
351 <           $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 >        my $devconf = $sat->location()."/".$sat->configurationdir();
235 >        my $relconf = $self->location()."/".$self->configurationdir();
236 >        if (!-d $devconf)
237 >           {
238 >           $self->copywithskip($relconf,$devconf,['toolbox']);
239 >           }
240 >        Utilities::AddDir::copydir("${relconf}/toolbox/".$self->{arch},"${devconf}/toolbox/".$self->{arch});
241 >        Utilities::AddDir::adddir ($sat->location()."/".$sat->sourcedir());
242 >        $self->copywithskip($self->archdir(),$sat->archdir(),["InstalledTools","ProjectCache.db.gz","RuntimeCache.db.gz","DirCache.db.gz","MakeData/DirCache","MakeData/DirCache.mk","MakeData/src.mk"]);
243 >        my $envfile = $sat->archdir()."/Environment";
244 >        open ( $fh, "> $envfile" ) or  $sat->error("Cannot Open \"$envfile\" file to Save\n $!");
245 >        print $fh "RELEASETOP=$relloc\n";
246 >        close($fh);
247 >        $envfile = $sat->location()."/".$self->{admindir}."/Environment";
248 >        if (! -f $envfile)
249 >           {
250 >           $sat->save ();
251 >           }
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 {
372 <        my $self=shift;
373 <        my $name;
374 <        my $location;
375 <
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);
391 < }
392 < # -------------- Tags ---------------------------------
393 < # -- init parse
394 < sub Project_Start {
274 > sub copyenv {
275          my $self=shift;
396        my $name=shift;
276          my $hashref=shift;
277 <
278 <        $self->checktag($name,$hashref,'name');
279 <        $self->checktag($name,$hashref,'version');
280 <
402 <        $self->name($$hashref{'name'});
403 <        $self->version($$hashref{'version'});
277 >        
278 >        foreach $elem ( keys %{$self->{ENV}} ) {
279 >           $$hashref{$elem}=$self->{ENV}{$elem};
280 >        }
281   }
282  
283 <
407 < sub Project_text {
283 > sub arch {
284          my $self=shift;
285 <        my $name=shift;
410 <        my $string=shift;
411 <
412 <        print $string;
285 >        return $self->{arch};
286   }
287  
288 < # ---- download parse
416 <
417 < sub Download_Start {
288 > sub save {
289          my $self=shift;
290 <        my $name=shift;
420 <        my $hashref=shift;
421 <
422 <        $self->checktag($name,$hashref,'url');
423 <        $self->checktag($name,$hashref,'location');
424 <        if ( $$hashref{'location'}!~/^\w/ ) {
425 <          $self->parseerror("location must start with an".
426 <                " alphanumeric character");
427 <        }
428 <        print "Downloading .... ".$$hashref{'url'}."\n";
429 <        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
290 >        $self->_SaveEnvFile();
291   }
292  
293 < 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'});
440 < }
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'}}=
462 <                $$hashref{'type'}->new($self->config());
463 <            $self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
464 <            $self->{structures}{$$hashref{'name'}}->parent($self);
465 <            $self->{structures}{$$hashref{'name'}}->vars($hashref);
466 <          }
467 <          else { # its an activedoc
468 <                $self->{structures}{$$hashref{'name'}}=
469 <                                $self->activatedoc($$hashref{'url'});
470 <          }
471 <          $self->{structures}{$$hashref{'name'}}->setupbase();
472 <        }
473 <        else {
474 <             $self->parseerror("Multiply defined Structure - ".
475 <                                                        $$hashref{'name'});
476 <        }
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