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.32 by sashby, Tue Feb 27 12:46:01 2007 UTC vs.
Revision 1.37 by muzaffar, Fri Oct 14 14:11:42 2011 UTC

# Line 1 | Line 1
1 =head1 NAME
2
3 Configuration::ConfigArea - Creates and manages a configuration area (i.e. a project area).
4
5 =head1 SYNOPSIS
6
7        my $obj = Configuration::ConfigArea->new();
8
9 =head1 DESCRIPTION
10
11 Create and manage SCRAM project configuration areas.
12
13 =head1 METHODS
14
15 =over
16
17 =cut
18
19 =item C<new()>
20
21 Create a new Configuration::ConfigArea object.
22
23 =item C<name()>
24
25 Get/set project name.
26
27 =item C<setup($dir[,$areaname])>
28
29 Set up a fresh area in $dir.
30
31 =item C<satellite($dir[,$areaname])>
32
33 Set up a satellite area in $dir.
34
35 =item C<version()>
36
37 Get/set project version.
38
39 =item C<location([$dir])>
40
41 Set/return the location of the work area.
42
43 =item C<bootstrapfromlocation([$location])>
44
45 Bootstrap the object based on location.
46 No location specified - current directory used
47 Return 0 if succesful, 1 otherwise.
48
49 =item C<requirementsdoc()>
50
51 Get or set the requirements document.
52
53 =item C<searchlocation([$startdir])>
54
55 Returns the location directory. search starts
56 from current directory if not specified.
57
58 =item C<scramversion()>
59
60 Return the scram version associated with the area.
61
62 =item C<configurationdir()>
63
64 Return the location of the project configuration directory.
65
66 =item C<copy($location)>
67
68 Copy a configuration from $location.
69
70 =item C<copysetup($location)>
71
72 Copy the architecture-specific tool setup.
73 Returns 0 if successful, 1 otherwise.
74
75 =item C<copyenv($ref)>
76
77 Copy the area environment into the hashref $ref.
78
79 =item C<toolbox()>
80
81 Return the area toolbox object.
82
83 =item C<save()>
84
85 Save changes permanently.
86
87 =item C<linkto($location)>
88
89 Link the current area to that at location.
90
91 =item C<unlinkarea()>
92
93 Destroy link ($autosave).
94
95 =item C<linkarea([Configuration::ConfigArea])>
96
97 Link the current area to the specified area object.
98
99 =item C<archname()>
100
101 Get/set a string to indicate architecture.
102
103 =item C<archdir()>
104
105 Return the location of the administration
106 architecture-dependent directory.
107
108 =item C<objectstore()>
109
110 Return the B<objectStore> object of the area temporary.
111
112 =item C<align()>
113
114 Adjust hard paths to suit local location.
115
116
117 =back
118
119 =head1 AUTHOR
120
121 Originally written by Christopher Williams.
122  
123 =head1 MAINTAINER
124
125 Shaun ASHBY
126
127 =cut
128
1   package Configuration::ConfigArea;
2   require 5.004;
131 use URL::URLcache;
3   use Utilities::AddDir;
4   use Utilities::Verbose;
134 use ObjectUtilities::ObjectStore;
5   use Cwd;
6   @ISA=qw(Utilities::Verbose);
7  
8   sub new {
9 <    my $class=shift;
10 <    my $self={};
11 <    bless $self, $class;
12 <    
13 <    # data init
14 <    $self->{admindir}=".SCRAM";
15 <    $self->{cachedir}="cache";
146 <    $self->{dbdir}="ObjectDB";
147 <    $self->{tbupdate}=0;
148 <    undef $self->{linkarea};
149 <    
150 <    return $self;
151 < }
152 <
153 < sub cache {
154 <    my $self=shift;
155 <    
156 <    if ( @_ ) {
157 <        $self->{cache}=shift;
158 <    }
159 <    if ( ! defined $self->{cache} ) {
160 <        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
161 <        if ( -e $loc  ) {
162 <            $self->{cache}=URL::URLcache->new($loc);
163 <        }
164 <        else {
165 <            $self->{cache}=undef;
166 <        }
167 <    }
168 <    return $self->{cache};
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  
171 # Tool and project cache info:
172 sub cacheinfo
173   {
174   my $self=shift;
175   print "\n","<ConfigArea> cacheinfo: ToolCache = ",$self->{toolcachefile},
176   ", ProjectCache = ",$self->{projectcachefile},"\n";
177   }
178
18   sub toolcachename
19     {
20     my $self=shift;
21 <   return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ToolCache.db");
21 >   return ($self->archdir()."/ToolCache.db.gz");
22     }
23  
24   sub projectcachename
25     {
26     my $self=shift;
27 <   return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ProjectCache.db");
27 >   return ($self->archdir()."/ProjectCache.db.gz");
28     }
29  
30 < sub _tbupdate
192 <   {
193 <   # Update toolbox relative to new RequirementsDoc:
194 <   my $self=shift;
195 <   @_?$self->{tbupdate}=shift
196 <      :$self->{tbupdate};
197 <   }
198 <
199 < sub _newcache {
30 > sub symlinks {
31          my $self=shift;
32 <        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
33 <        $self->{cache}=URL::URLcache->new($loc);
203 <        return $self->{cache};
32 >        if (@_) {$self->{symlinks}=shift;}
33 >        return $self->{symlinks};
34   }
35  
36 < sub _newobjectstore {
37 <        my $self=shift;
38 <        my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
39 <        $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
40 <        return $self->{dbstore};
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 objectstore {
46 > sub configchksum {
47          my $self=shift;
48 <
49 <        if ( @_ ) {
217 <            $self->{dbstore}=shift;
218 <        }
219 <        if ( ! defined $self->{dbstore} ) {
220 <          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
221 <          if ( -e $loc ) {
222 <            $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
223 <          }
224 <          else {
225 <            $self->{dbstore}=undef;
226 <          }
227 <        }
228 <        return $self->{dbstore}
48 >        if (@_) {$self->{configchksum}=shift;}
49 >        return $self->{configchksum};
50   }
51  
52 +
53   sub name {
54          my $self=shift;
55          @_?$self->{name}=shift
# Line 243 | Line 65 | sub version {
65   sub setup {
66          my $self=shift;
67          my $location=shift;
68 <        my $areaname;
69 <
70 <        # -- check we have a project name and version
249 <        my $name=$self->name();
250 <        my $vers=$self->version();
251 <        
252 <        if ( ( ! defined $name ) && ( ! defined $version )) {
253 <          $self->error("Set ConfigArea name and version before setup");
254 <        }
255 <
256 <        # -- check arguments and set location
257 <        if ( ! defined $location ) {
258 <          $self->error("ConfigArea: Cannot setup new area without a location");
259 <        }
260 <        if ( @_ ) {
261 <          $areaname=shift;
262 <        }
68 >        my $areaname=shift  || undef;
69 >        my $symlinks=shift  || 0;
70 >        my $locarea = shift || undef;
71          if ( (! defined $areaname) || ( $areaname eq "" ) ) {
72 <          # -- make up a name from the project name and version
265 <          $vers=~s/^$name\_//;
266 <          $areaname=$name."_".$vers;
72 >          $areaname=$self->version();
73          }
74 <        my $arealoc=$location."/".$areaname;
75 <        my $workloc=$arealoc."/".$self->{admindir};
76 <        $self->verbose("Building at $arealoc");
77 <        $self->location($arealoc);
78 <
79 <        # -- create top level structure and work area
80 <        AddDir::adddir($workloc);
81 <
82 <        # -- add a cache
83 <        $self->_newcache();
84 <
85 <        # -- add an Objectstore
86 <        $self->_newobjectstore();
87 <
88 <        # -- Save Environment File
89 <        $self->_SaveEnvFile();
90 <
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 configurationdir {
# Line 300 | Line 108 | sub sourcedir {
108          return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
109   }
110  
111 < sub toolbox {
304 <        my $self=shift;
305 <        if ( ! defined $self->{toolbox} ) {
306 <          $self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH});
307 <        }
308 <        return $self->{toolbox};
309 < }
310 <
311 < sub toolboxversion {
111 > sub releasetop {
112          my $self=shift;
113          if ( @_ ) {
114 <          $self->{toolboxversion}=shift;
114 >          $self->{releasetop}=shift;
115          }
116 <        return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef;
116 >        return (defined $self->{releasetop})?$self->{releasetop}:undef;
117   }
118  
319 sub requirementsdoc {
320        my $self=shift;
321        if ( @_ ) {
322          $self->{reqdoc}=shift;
323        }
324        if ( defined $self->{reqdoc} ) {
325          return $self->location()."/".$self->{reqdoc};
326        }
327        else {
328          return undef;
329        }
330 }
331
332 sub scramversion {
333        my $self=shift;
334        if ( ! defined $self->{scramversion} ) {
335          my $filename=$self->location()."/".$self->configurationdir()."/".
336                                                        "scram_version";
337          if ( -f $filename ) {
338            use FileHandle;
339            $fh=FileHandle->new();
340            open ($fh, "<".$filename);
341            my $version=<$fh>;
342            chomp $version;
343            $self->{scramversion}=$version;
344            undef $fh;
345          }
346        }
347        return $self->{scramversion};
348 }
349
350 sub sitename
351   {
352   ###############################################################
353   # sitename()                                                  #
354   ###############################################################
355   # modified : Mon Dec  3 15:45:35 2001 / SFA                   #
356   # params   :                                                  #
357   #          :                                                  #
358   #          :                                                  #
359   #          :                                                  #
360   # function : Read the site name from config/site/sitename and #
361   #          : export it.                                       #
362   #          :                                                  #
363   #          :                                                  #
364   ###############################################################
365   my $self = shift;
366   my $sitefile = $self->location()."/".$self->configurationdir()."/site/sitename";
367
368   $self->{sitename} = 'CERN'; # Use CERN as the default site name
369
370   use FileHandle;
371   my $sitefh = FileHandle->new();
372
373   # Be verbose and print file we're going to read:
374   $self->verbose(">> Going to try to get sitename from: ".$sitefile." ");
375  
376   # See if we can read from the file. If not, just
377   # use default site name:
378   open($sitefh,"<".$sitefile) ||
379      do
380         {
381         $self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name.");
382         return $self->{sitename};
383         };
384  
385   $sitename = <$sitefh>;
386   chomp($sitename);
387   $self->{sitename} = $sitename;
388  
389   # Close the file (be tidy!);
390   close($sitefile);
391   # Return:
392   return $self->{sitename};
393   }
394
119   sub admindir()
120     {
121     my $self=shift;
# Line 402 | Line 126 | sub admindir()
126  
127   sub bootstrapfromlocation {
128          my $self=shift;
129 <
129 >        my $location = $self->searchlocation(shift);
130          my $rv=0;
131 <        
408 <        my $location;
409 <        if ( ! defined ($location=$self->searchlocation(@_)) ) {
131 >        if ( ! defined $location) {
132           $rv=1;
411         $self->verbose("Unable to locate the top of local configuration area");
133          }
134          else {
135           $self->location($location);
415         $self->verbose("Found top ".$self->location());
136           $self->_LoadEnvFile();
137          }
138          return $rv;
# Line 423 | 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   }
# Line 465 | Line 190 | sub searchlocation {
190   sub archname {
191          my $self=shift;
192          if ( @_ ) {
193 <          $self->{archname}=shift;
193 >          if (defined $self->{location}) {
194 >             $self->archdir($self->{location}."/".$self->{admindir}."/".$ENV{SCRAM_ARCH});
195 >          }
196          }
197 <        return $self->{archname};
197 >        return $ENV{SCRAM_ARCH};
198   }
199  
200   sub archdir {
# Line 475 | Line 202 | sub archdir {
202          if ( @_ ) {
203            $self->{archdir}=shift;
204          }
478        if ( ! defined $self->{archdir} ) {
479         if ( defined $self->{archname} ) {
480          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
481                                                        $self->{archname};
482         }
483         else {
484          $self->error("ConfigArea : cannot create arch directory - ".
485                                                "architecture name not set")
486         }
487        }
205          return $self->{archdir};
206   }
207  
208   sub satellite {
209          my $self=shift;
210 <
494 <        # -- create the sat object
210 >        my $relloc = $self->location();
211          my $sat=Configuration::ConfigArea->new();
212          $sat->name($self->name());
213          $sat->version($self->version());
498        $sat->requirementsdoc($self->{reqdoc});
214          $sat->configurationdir($self->configurationdir());
215          $sat->sourcedir($self->sourcedir());
216 <        $sat->toolboxversion($self->toolboxversion());
216 >        $sat->releasetop($relloc);
217 >        $sat->configchksum($self->configchksum());
218          $sat->setup(@_);
219 <
220 <        # -- copy across the cache and ObjectStore
221 <        # -- make sure we dont try building new caches in release areas
222 <        my $rcache=$self->cache();
223 <        if ( defined $rcache ) {
224 <          copy($rcache->location(),$sat->cache()->location());
225 <        }
226 <
227 <        # -- make sure we dont try building new objectstores in release areas
228 <        my $rostore=$self->objectstore();
229 <        if ( defined $rostore ) {
230 <          copy($rostore->location(),$sat->objectstore()->location());
231 <        }
232 <
233 <        # and make sure in reinitialises
234 <        undef ($sat->{cache});
235 <
236 <        # -- link it to this area
521 <        $sat->linkarea($self);
522 <        
523 <        # -- save it
524 <        $sat->save();
525 <
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  
529 sub copy {
530        my $self=shift;
531        my $destination=shift;
532
533        # copy across the admin dir
534        my $temp=$self->location()."/".$self->{admindir};
535        AddDir::copydir($temp,"$destination/".$self->{admindir});
536 }
537
538 sub align {
539        my $self=shift;
540        use File::Copy;
541
542        $self->_LoadEnvFile();
543        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
544        my $tmpEnvfile=$Envfile.".bak";
545        my $rel=$self->{ENV}{RELEASETOP};
546        my $local=$self->location();
547
548        rename( $Envfile, $tmpEnvfile );
549        use FileHandle;
550        my $fh=FileHandle->new();
551        my $fout=FileHandle->new();
552        open ( $fh, "<".$tmpEnvfile ) or
553                $self->error("Cannot find Environment file. Area Corrupted? ("
554                                .$self->location().")\n $!");
555        open ( $fout, ">".$Envfile ) or
556                $self->error("Cannot find Environment file. Area Corrupted? ("
557                                .$self->location().")\n $!");
558        while ( <$fh> ) {
559          $_=~s/\Q$rel\L/$local/g;
560          print $fout $_;
561        }
562        undef $fh;
563        undef $fout;
564 }
565
566 sub copysetup {
567        my $self=shift;
568        my $dest=shift;
569        my $rv=1;
570        # copy across the admin dir
571        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
572        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
573        if ( $temp ne $temp2 ) {
574         if ( -d $temp ) {
575          AddDir::copydir($temp,$temp2);
576          $rv=0;
577         }
578        }
579        return $rv;
580 }
581
582 sub copyurlcache {
583        my $self=shift;
584        my $dest=shift;
585        my $rv=1;
586        # copy across the admin dir
587        my $temp=$self->location()."/".$self->{admindir}."/cache";
588        my $temp2=$dest."/".$self->{admindir}."/cache";
589        if ( $temp ne $temp2 ) {
590         if ( -d $temp ) {
591          AddDir::copydir($temp,$temp2);
592          $rv=0;
593         }
594        }
595        return $rv;
596 }
597
240   sub copywithskip {
241          my $self=shift;
242 <        my $dest=shift;
243 <        my ($filetoskip)=@_;            
242 >        my $src=shift;
243 >        my $des=shift;
244 >        my $filetoskip=shift || [];
245          my $rv=1;
246 <        # copy across the admin dir
247 <        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
248 <        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
249 <        if ( $temp ne $temp2 ) {
250 <         if ( -d $temp ) {
251 <          AddDir::copydirwithskip($temp,$temp2,$filetoskip);
252 <          $rv=0;
253 <         }
254 <        }
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  
# Line 626 | Line 270 | sub arch {
270          return $ENV{SCRAM_ARCH};
271   }
272  
629 sub linkto {
630        my $self=shift;
631        my $location=shift;
632
633        if ( -d $location ) {
634        my $area=Configuration::ConfigArea->new();
635        $area->bootstrapfromlocation($location);
636        $self->linkarea($area);
637        }
638        else {
639          $self->error("ConfigArea : Unable to link to non existing directory ".
640                         $location);
641        }
642 }
643
644 sub unlinkarea {
645        my $self=shift;
646        undef $self->{linkarea};
647        $self->{linkarea}=undef;
648        $self->save();
649 }
650
651 sub linkarea {
652        my $self=shift;
653        my $area=shift;
654        if ( defined $area ) {
655          $self->{linkarea}=$area;
656        }
657        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
658                        $self->{linkarea}:undef;
659 }
660
273   sub save {
274          my $self=shift;
275          $self->_SaveEnvFile();
276   }
277  
666 sub reqdoc()
667   {
668   my $self=shift;
669   my ($path)=@_;
670   return $path."/".$self->{reqdoc};
671   }
672
673 sub creationtime()
674   {
675   my $self=shift;
676   my ($location)= @_;
677   $location||=$self->location();
678   my $requirementsdoc = $self->reqdoc($location);
679   my ($mode, $time) = (stat($requirementsdoc))[2, 9];
680   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
681
682   ($sec < 10) ? ($sec = "0".$sec) : $sec;
683   ($min < 10) ? ($min = "0".$min) : $min;
684
685   $year += 1900;
686   my $months =
687      {
688      0 => "Jan", 1 => "Feb",
689      2 => "Mar", 3 => "Apr",
690      4 => "May", 5 => "Jun",
691      6 => "Jul", 7 => "Aug",
692      8 => "Sept", 9 => "Oct",
693      10 => "Nov", 11 => "Dec" };
694  
695   my $days = { 1 => "Mon", 2 => "Tue", 3 => "Wed", 4 => "Thu", 5 => "Fri", 6 => "Sat", 7 => "Sun"};
696  
697   # Return the timestamp (as string) of the requirementsdoc:
698   return $days->{$wday}."-".$mday."-".$months->{$mon}."-".$year." ".$hour.":".$min.":".$sec;
699   }
700
278   # ---- support routines
279  
280   sub _SaveEnvFile
281     {
282     my $self=shift;
706   my $filemode = 0644;
283    
284 <   use FileHandle;
285 <   my $fh=FileHandle->new();
286 <   open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
711 <          "Environment" ) or
712 <          $self->error("Cannot Open Environment file to Save ("
713 <                       .$self->location().")\n $!");
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_ProjReqsDoc=".$self->{reqdoc}."\n";
293 <   print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n";
292 >   print $fh "SCRAM_SYMLINKS=",$self->symlinks(),"\n";
293 >   print $fh "SCRAM_CONFIGCHKSUM=",$self->configchksum(),"\n";
294 >   close($fh);
295  
722   if ( defined $self->linkarea() )
723      {
724      my $area=$self->linkarea()->location();
725      if ( $area ne "" )
726         {
727         print $fh "RELEASETOP=".$area."\n";
728         }
729      }
730  
731   undef $fh;
732  
733   # Repeat the exercise to save as XML:
734   my $fh=FileHandle->new();
735   open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
736          "Environment.xml" ) or
737          $self->error("Cannot Open Environment.xml file to Save ("
738                       .$self->location().")\n $!");
739   print $fh "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n";
740   print $fh "<doc type=\"Configuration::ProjectEnvironment\" version=\"1.0\">\n";
741   print $fh " <environment SCRAM_PROJECTNAME=\"".$self->name()."\"/>\n";
742   print $fh " <environment SCRAM_PROJECTVERSION=\"".$self->version()."\"/>\n";
743   print $fh " <environment SCRAM_CONFIGDIR=\"".$self->configurationdir()."\"/>\n";
744   print $fh " <environment SCRAM_SOURCEDIR=\"".$self->sourcedir()."\"/>\n";
745   print $fh " <environment SCRAM_ProjReqsDoc=\"".$self->{reqdoc}."\"/>\n";
746   print $fh " <environment SCRAM_TOOLBOXVERSION=\"".$self->{toolboxversion}."\"/>\n";
747
748   if ( defined $self->linkarea() )
749      {
750      my $area=$self->linkarea()->location();
751      if ( $area ne "" )
752         {
753         print $fh " <environment RELEASETOP=\"".$area."\"/>\n";
754         }
755      }
756  
757   print $fh "</doc>\n";
758   undef $fh;
759  
296     # Set the default permissions (-rw-r--r--):
297 +   my $filemode = 0644;
298     chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
762   chmod $filemode, $self->location()."/".$self->{admindir}."/Environment.xml";
299     }
300  
301   sub _LoadEnvFile
302     {
303     my $self=shift;
304  
305 <   use FileHandle;
306 <   my $fh=FileHandle->new();
307 <   open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
772 <          "Environment" ) or
773 <          $self->error("Cannot find Environment file. Area Corrupted? ("
774 <                       .$self->location().")\n $!");
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;
# Line 780 | Line 313 | sub _LoadEnvFile
313        ($name, $value)=split /=/;
314        eval "\$self->{ENV}{${name}}=\"$value\"";
315        }
316 <   undef $fh;
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"});
# Line 799 | Line 354 | sub _LoadEnvFile
354        {
355        $self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
356        }
357 <   if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} )
803 <      {
804 <      $self->requirementsdoc($self->{ENV}{"SCRAM_ProjReqsDoc"});
805 <      }
806 <   if ( defined $self->{ENV}{"SCRAM_TOOLBOXVERSION"} )
807 <      {
808 <      if ($self->{ENV}{"SCRAM_TOOLBOXVERSION"} eq '')
809 <         {
810 <         $self->toolboxversion("STANDALONE");
811 <         }
812 <      else
813 <         {
814 <         $self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"});
815 <         }
816 <      }
817 <  
818 <   if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
819 <        ($self->{ENV}{"RELEASETOP"} ne $self->location()))
357 >   if ( defined $self->{ENV}{"RELEASETOP"} )
358        {
359 <      $self->linkto($self->{ENV}{"RELEASETOP"});
359 >      $self->releasetop($self->{ENV}{"RELEASETOP"});
360        }
361     }
362 + 1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines