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.37 by muzaffar, Fri Oct 14 14:11:42 2011 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;
61 <
62 <        $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);
79 <
80 <        # data init
81 <        $self->{admindir}=".SCRAM";
82 < }
83 <
84 < 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 < }
6 > @ISA=qw(Utilities::Verbose);
7  
8 < sub freebase {
9 <        my $self=shift;
10 <        $self->config()->delete("BaseArea");
8 > sub new {
9 >        my $class=shift;
10 >        my $self={};
11 >        bless $self, $class;
12 >        $self->{admindir}=".SCRAM";
13 >        $self->{configurationdir} = "config";
14 >        $self->archname($ENV{SCRAM_ARCH});
15 >        return $self;
16 > }
17 >
18 > sub toolcachename
19 >   {
20 >   my $self=shift;
21 >   return ($self->archdir()."/ToolCache.db.gz");
22 >   }
23 >
24 > sub projectcachename
25 >   {
26 >   my $self=shift;
27 >   return ($self->archdir()."/ProjectCache.db.gz");
28 >   }
29 >
30 > sub symlinks {
31 >        my $self=shift;
32 >        if (@_) {$self->{symlinks}=shift;}
33 >        return $self->{symlinks};
34 > }
35 >
36 > sub calchksum {
37 >        my $self=shift;
38 >        my $dir=$self->location()."/".$self->configurationdir();
39 >        push @INC,$dir;
40 >        require SCRAM::Plugins::ProjectChkSum;
41 >        my $sum=&SCRAM::Plugins::ProjectChkSum::chksum($dir);
42 >        pop @INC;
43 >        return $sum;
44   }
45  
46 < sub defaultdirname {
46 > sub configchksum {
47          my $self=shift;
48 <        my $name=$self->name();
49 <        my $vers=$self->version();
107 <        $vers=~s/^$name\_//;
108 <        $name=$name."_".$vers;
109 <        return $name;
48 >        if (@_) {$self->{configchksum}=shift;}
49 >        return $self->{configchksum};
50   }
51  
52  
53 < sub setup {
114 <        my $self=shift;
115 <
116 <        # --- 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 {
53 > sub name {
54          my $self=shift;
55 <        my $vr=shift;
56 <        return $self->{structures}{$vr};
55 >        @_?$self->{name}=shift
56 >          :$self->{name};
57   }
58  
59 < sub structurelist {
59 > sub version {
60          my $self=shift;
61 <        return ( keys %{$self->{structures}} );
61 >        @_?$self->{version}=shift
62 >          :$self->{version};
63   }
64  
65 < sub _setupstore {
65 > sub setup {
66          my $self=shift;
67 <
68 <        # --- make a new ConfigStore at the location and add it to the db list
69 <        my $ad=Configuration::ConfigStore->new($self->location().
70 <                                "/".$self->{admindir}, $self->arch());
71 <
72 <        $self->parentconfig($self->config());
73 < #        $self->config(Configuration::ConfigureStore->new());
74 < #        $self->config()->db("local",$ad);
75 < #        $self->config()->db("parent",$self->parentconfig());
76 < #        $self->config()->policy("cache","local");
77 <        $self->config($ad);
78 <        $self->config()->basedoc($self->parentconfig()->basedoc());
67 >        my $location=shift;
68 >        my $areaname=shift  || undef;
69 >        my $symlinks=shift  || 0;
70 >        my $locarea = shift || undef;
71 >        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
72 >          $areaname=$self->version();
73 >        }
74 >        $self->location($location."/".$areaname);
75 >        $self->symlinks($symlinks);
76 >        if ($self->configchksum() ne "")
77 >           {
78 >           if ((!-defined $locarea) && (-f "${location}/${areaname}/".$self->admindir()."/Environment"))
79 >              {
80 >              $locarea=Configuration::ConfigArea->new();
81 >              $locarea->bootstrapfromlocation("${location}/${areaname}");
82 >              }
83 >           if ((defined $locarea) && ($locarea->configchksum() != $self->configchksum()))
84 >              {
85 >              print "ERROR: Can not setup your current working area for SCRAM_ARCH:$ENV{SCRAM_ARCH}.\n",
86 >                    "Your current development area ${location}/${areaname}\n",
87 >                    "is using a different ${areaname}/config then the one used for\n",
88 >                    $self->releasetop(),".\n";
89 >              exit 1;
90 >              }
91 >           }
92 >        Utilities::AddDir::adddir($self->archdir());
93   }
94  
95 < sub bootstrapfromlocation {
95 > sub configurationdir {
96          my $self=shift;
97 <        
98 <        if ( ! defined $self->location(@_) ) {
181 <          $self->error("Unable to locate the top of local configuration area");
97 >        if ( @_ ) {
98 >          $self->{configurationdir}=shift;
99          }
100 <        print "Found top ".$self->location()."\n";
184 <        $self->_setupstore();
185 <        $self->restore($self->location()."/".$self->{admindir}.
186 <                                                "/ConfigArea.dat");
100 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
101   }
102  
103 < sub parentconfig {
103 > sub sourcedir {
104          my $self=shift;
105 <        @_?$self->{parentconfig}=shift
106 <          :$self->{parentconfig};
105 >        if ( @_ ) {
106 >          $self->{sourcedir}=shift;
107 >        }
108 >        return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
109   }
110  
111 < sub store {
111 > sub releasetop {
112          my $self=shift;
113 <        my $location=shift;
114 <
115 <        my $fh=$self->openfile(">".$location);
116 <        $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();
113 >        if ( @_ ) {
114 >          $self->{releasetop}=shift;
115 >        }
116 >        return (defined $self->{releasetop})?$self->{releasetop}:undef;
117   }
118  
119 < sub satellite {
120 <        my $self=shift;
121 <        my $newarea=$self->copy(@_);
122 <        $newarea->_makesatellites();
123 <        return $newarea;
124 < }
119 > sub admindir()
120 >   {
121 >   my $self=shift;
122 >  
123 >   @_ ? $self->{admindir} = shift
124 >      : $self->{admindir};
125 >   }
126  
127 < sub copy {
127 > sub bootstrapfromlocation {
128          my $self=shift;
129 <        use File::Basename;
130 <        # create the area
131 <
132 <        my $destination;
222 <        if ( @_ ) {
223 <         $destination=shift;
129 >        my $location = $self->searchlocation(shift);
130 >        my $rv=0;
131 >        if ( ! defined $location) {
132 >         $rv=1;
133          }
134          else {
135 <          my($location,$name)=$self->_defaultoptions();
136 <          $destination=$location."/".$name
135 >         $self->location($location);
136 >         $self->_LoadEnvFile();
137          }
138 <        #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};
138 >        return $rv;
139   }
140  
141   sub location {
# Line 279 | Line 143 | sub location {
143  
144          if ( @_ ) {
145            $self->{location}=shift;
146 +          $self->archname($ENV{SCRAM_ARCH});
147          }
148          elsif ( ! defined $self->{location} ) {
149            # try and find the release location
150            $self->{location}=$self->searchlocation();
151 +          if (defined $self->{location})
152 +             {
153 +             $self->archname($ENV{SCRAM_ARCH});
154 +             }
155          }
156          return  $self->{location};
157   }
158  
159   sub searchlocation {
160          my $self=shift;
161 <
161 >        
162          #start search in current directory if not specified
163          my $thispath;
164 <        @_?$thispath=shift
165 <          :$thispath=cwd();
166 <
164 >        if ( @_ ) {
165 >          $thispath=shift
166 >        }
167 >        else {
168 >          $thispath=cwd();
169 >        }
170 >        
171          my $rv=0;
172  
173 +        # chop off any files - we only want dirs
174 +        if ( -f $thispath ) {
175 +          $thispath=~s/(.*)\/.*/$1/;
176 +        }
177          Sloop:{
178          do {
179 < #         print "Searching $thispath\n";
179 >          $self->verbose("Searching $thispath");
180            if ( -e "$thispath/".$self->{admindir} ) {
181 < #           print "Found\n";
181 >            $self->verbose("Found\n");
182              $rv=1;
183              last Sloop;
184            }
185          } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
186 <
186 >      
187          return $rv?$thispath:undef;
188   }
189  
190 < sub meta {
190 > sub archname {
191          my $self=shift;
192 <
193 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
194 <                $self->location;
195 < }
319 <
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()
192 >        if ( @_ ) {
193 >          if (defined $self->{location}) {
194 >             $self->archdir($self->{location}."/".$self->{admindir}."/".$ENV{SCRAM_ARCH});
195 >          }
196          }
197 +        return $ENV{SCRAM_ARCH};
198   }
199  
200 < sub _storestructures {
200 > sub archdir {
201          my $self=shift;
202 <        foreach $struct ( values %{$self->{structures}} ) {
203 <          $self->config()->store($struct, "Structures", $struct->name());
202 >        if ( @_ ) {
203 >          $self->{archdir}=shift;
204          }
205 +        return $self->{archdir};
206   }
207  
208 < sub _restorestructures {
208 > sub satellite {
209          my $self=shift;
210 <        my @strs=$self->config()->find("Structures");
211 <        foreach $struct ( @strs ) {
212 <          $struct->parent($self);
213 <          $self->{structures}{$struct->name()}=$struct;
214 <        }
210 >        my $relloc = $self->location();
211 >        my $sat=Configuration::ConfigArea->new();
212 >        $sat->name($self->name());
213 >        $sat->version($self->version());
214 >        $sat->configurationdir($self->configurationdir());
215 >        $sat->sourcedir($self->sourcedir());
216 >        $sat->releasetop($relloc);
217 >        $sat->configchksum($self->configchksum());
218 >        $sat->setup(@_);
219 >        $self->copywithskip($self->archdir(),$sat->archdir(),["InstalledTools","ProjectCache.db.gz","RuntimeCache.db.gz","DirCache.db.gz","MakeData/DirCache","MakeData/DirCache.mk","MakeData/src.mk"]);
220 >        $envfile = $sat->archdir()."/Environment";
221 >        open ( $fh, "> $envfile" ) or  $sat->error("Cannot Open \"$envfile\" file to Save\n $!");
222 >        print $fh "RELEASETOP=$relloc\n";
223 >        close($fh);
224 >        my $devconf = $sat->location()."/".$sat->configurationdir();
225 >        my $relconf = $self->location()."/".$self->configurationdir();
226 >        if (!-d $devconf)
227 >           {
228 >           $self->copywithskip($relconf,$devconf,['toolbox']);
229 >           }
230 >        $envfile = $sat->location()."/".$self->{admindir}."/Environment";
231 >        if (! -f $envfile)
232 >           {
233 >           $sat->save ();
234 >           }
235 >        Utilities::AddDir::copydir("${relconf}/toolbox/$ENV{SCRAM_ARCH}","${devconf}/toolbox/$ENV{SCRAM_ARCH}");
236 >        Utilities::AddDir::adddir ($sat->location()."/".$sat->sourcedir());
237 >        return $sat;
238 > }
239 >
240 > sub copywithskip {
241 >        my $self=shift;
242 >        my $src=shift;
243 >        my $des=shift;
244 >        my $filetoskip=shift || [];
245 >        my $rv=1;
246 >        if ( $src ne $des )
247 >           {
248 >           if ( -d $src )
249 >              {
250 >              my $fs=[];
251 >              foreach my $f (@$filetoskip) {push @$fs,"${src}/${f}";}
252 >              Utilities::AddDir::copydirwithskip($src,$des,$fs);
253 >              $rv=0;
254 >             }
255 >           }
256 >        return $rv;
257   }
258  
259 < sub _defaultoptions {
259 > sub copyenv {
260          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 {
395        my $self=shift;
396        my $name=shift;
261          my $hashref=shift;
262 <
263 <        $self->checktag($name,$hashref,'name');
264 <        $self->checktag($name,$hashref,'version');
401 <
402 <        $self->name($$hashref{'name'});
403 <        $self->version($$hashref{'version'});
404 < }
405 <
406 <
407 < sub Project_text {
408 <        my $self=shift;
409 <        my $name=shift;
410 <        my $string=shift;
411 <
412 <        print $string;
413 < }
414 <
415 < # ---- download parse
416 <
417 < sub Download_Start {
418 <        my $self=shift;
419 <        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");
262 >        
263 >        foreach $elem ( keys %{$self->{ENV}} ) {
264 >           $$hashref{$elem}=$self->{ENV}{$elem};
265          }
428        print "Downloading .... ".$$hashref{'url'}."\n";
429        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
266   }
267  
268 < sub Use_download_Start {
268 > sub arch {
269          my $self=shift;
270 <        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'});
270 >        return $ENV{SCRAM_ARCH};
271   }
272  
273 < # --- setup parse
443 <
444 < sub Structure_Start {
273 > sub save {
274          my $self=shift;
275 <        my $name=shift;
447 <        my $hashref=shift;
448 <
449 <        $self->checktag($name,$hashref,'name');
450 <        if ( !( exists $$hashref{'type'}) || ( exists $$hashref{'url'}) ) {
451 <            $self->parseerror("No url or type given in <$name> tag");
452 <        }
453 <        if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
454 <          if ( exists $$hashref{'type'}) {
455 <            # create a new object of the specified type
456 <            eval "require $$hashref{'type'} ";
457 <            if  ( $@ ) {
458 <                $self->parseerror("Unable to instantiate type=".
459 <                        $$hashref{'type'}." in <$name> .".$@);
460 <            }
461 <            $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 <        }
275 >        $self->_SaveEnvFile();
276   }
277  
278 < sub Use_Start {
480 <        my $self=shift;
481 <        my $name=shift;
482 <        my $hashref=shift;
483 <        
484 <        $self->checktag($name,$hashref,'url');
485 <        $self->addconfigitem($$hashref{'url'});
486 < }
278 > # ---- support routines
279  
280 + sub _SaveEnvFile
281 +   {
282 +   my $self=shift;
283 +  
284 +   my $fh;
285 +   my $envfile = $self->location()."/".$self->{admindir}."/Environment";
286 +   open ( $fh, "> $envfile" ) or  $self->error("Cannot Open \"$envfile\" file to Save\n $!");
287 +        
288 +   print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
289 +   print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
290 +   print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n";
291 +   print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n";
292 +   print $fh "SCRAM_SYMLINKS=",$self->symlinks(),"\n";
293 +   print $fh "SCRAM_CONFIGCHKSUM=",$self->configchksum(),"\n";
294 +   close($fh);
295 +
296 +   # Set the default permissions (-rw-r--r--):
297 +   my $filemode = 0644;
298 +   chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
299 +   }
300 +
301 + sub _LoadEnvFile
302 +   {
303 +   my $self=shift;
304 +
305 +   my $fh;
306 +   my $envfile = $self->location()."/".$self->{admindir}."/Environment";
307 +   open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!");
308 +   while ( <$fh> )
309 +      {
310 +      chomp;
311 +      next if /^#/;
312 +      next if /^\s*$/ ;
313 +      ($name, $value)=split /=/;
314 +      eval "\$self->{ENV}{${name}}=\"$value\"";
315 +      }
316 +   close($fh);
317 +   $envfile = $self->archdir()."/Environment";
318 +   if (-f $envfile)
319 +      {
320 +      open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!");
321 +      while ( <$fh> )
322 +         {
323 +         chomp;
324 +         next if /^#/;
325 +         next if /^\s*$/ ;
326 +         ($name, $value)=split /=/;
327 +         eval "\$self->{ENV}{${name}}=\"$value\"";
328 +         }
329 +      close($fh);
330 +      }
331 +        
332 +   # -- set internal variables appropriately
333 +   if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} )
334 +      {
335 +      $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
336 +      }
337 +   if ( defined $self->{ENV}{"SCRAM_SYMLINKS"} )
338 +      {
339 +      $self->symlinks($self->{ENV}{"SCRAM_SYMLINKS"});
340 +      }
341 +   if ( defined $self->{ENV}{"SCRAM_CONFIGCHKSUM"} )
342 +      {
343 +      $self->configchksum($self->{ENV}{"SCRAM_CONFIGCHKSUM"});
344 +      }
345 +   if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} )
346 +      {
347 +      $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
348 +      }
349 +   if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} )
350 +      {
351 +      $self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"});
352 +      }
353 +   if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} )
354 +      {
355 +      $self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
356 +      }
357 +   if ( defined $self->{ENV}{"RELEASETOP"} )
358 +      {
359 +      $self->releasetop($self->{ENV}{"RELEASETOP"});
360 +      }
361 +   }
362 + 1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines