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 |
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 { |
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; |
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; |
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 |
|
} |
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 { |
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 |
|
|
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; |
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"}); |
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; |