1 |
– |
# |
2 |
– |
# ConfigArea.pm |
3 |
– |
# |
4 |
– |
# Written by Christopher Williams |
5 |
– |
# |
6 |
– |
# Description |
7 |
– |
# ----------- |
8 |
– |
# creates and manages a configuration area |
9 |
– |
# |
10 |
– |
# Notes |
11 |
– |
# ------- |
12 |
– |
# Persistency - remember to call the save method to make changes persistent |
13 |
– |
# |
14 |
– |
# Interface |
15 |
– |
# --------- |
16 |
– |
# new() : A new ConfigArea object |
17 |
– |
# name() : get/set project name |
18 |
– |
# setup(dir[,areaname]) : setup a fresh area in dir |
19 |
– |
# satellite(dir[,areaname]) : setup a satellite area in dir |
20 |
– |
# version() : get/set project version |
21 |
– |
# location([dir]) : set/return the location of the work area |
22 |
– |
# bootstrapfromlocation([location]) : bootstrap the object based on location. |
23 |
– |
# no location specified - cwd used |
24 |
– |
# return 0 if succesful 1 otherwise |
25 |
– |
# requirementsdoc() : get set the requirements doc |
26 |
– |
# searchlocation([startdir]) : returns the location directory. search starts |
27 |
– |
# from cwd if not specified |
28 |
– |
# scramversion() : return the scram version associated with |
29 |
– |
# area |
30 |
– |
# configurationdir() : return the location of the project |
31 |
– |
# configuration directory |
32 |
– |
# copy(location) : copy a configuration |
33 |
– |
# copysetup(location) : copy the architecture specific tool setup |
34 |
– |
# returns 0 if successful, 1 otherwise |
35 |
– |
# copyenv($ref) : copy the areas environment into the hashref |
36 |
– |
# toolbox() : return the areas toolbox object |
37 |
– |
# save() : save changes permanently |
38 |
– |
# linkto(location) : link the current area to that at location |
39 |
– |
# unlinkarea() : destroy link (autosave) |
40 |
– |
# linkarea([ConfigArea]) : link the current area to the apec Area Object |
41 |
– |
# archname() : get/set a string to indicate architecture |
42 |
– |
# archdir() : return the location of the administration arch dep |
43 |
– |
# directory |
44 |
– |
# objectstore() : return the objectStore object of the area |
45 |
– |
# - temporary |
46 |
– |
# align() : adjust hard paths to suit local loaction |
47 |
– |
|
1 |
|
package Configuration::ConfigArea; |
2 |
|
require 5.004; |
50 |
– |
use URL::URLcache; |
3 |
|
use Utilities::AddDir; |
4 |
|
use Utilities::Verbose; |
53 |
– |
use ObjectUtilities::ObjectStore; |
5 |
|
use Cwd; |
6 |
|
@ISA=qw(Utilities::Verbose); |
7 |
|
|
9 |
|
my $class=shift; |
10 |
|
my $self={}; |
11 |
|
bless $self, $class; |
12 |
< |
|
13 |
< |
# data init |
14 |
< |
$self->{admindir}=".SCRAM"; |
15 |
< |
$self->{cachedir}="cache"; |
65 |
< |
$self->{dbdir}="ObjectDB"; |
66 |
< |
$self->{tbupdate}=0; |
67 |
< |
undef $self->{linkarea}; |
68 |
< |
|
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 |
|
|
72 |
– |
sub cache { |
73 |
– |
my $self=shift; |
74 |
– |
|
75 |
– |
if ( @_ ) { |
76 |
– |
$self->{cache}=shift; |
77 |
– |
} |
78 |
– |
if ( ! defined $self->{cache} ) { |
79 |
– |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir}; |
80 |
– |
if ( -e $loc ) { |
81 |
– |
$self->{cache}=URL::URLcache->new($loc); |
82 |
– |
} |
83 |
– |
else { |
84 |
– |
$self->{cache}=undef; |
85 |
– |
} |
86 |
– |
} |
87 |
– |
return $self->{cache}; |
88 |
– |
} |
89 |
– |
|
90 |
– |
# Tool and project cache info: |
91 |
– |
sub cacheinfo |
92 |
– |
{ |
93 |
– |
my $self=shift; |
94 |
– |
print "\n","<ConfigArea> cacheinfo: ToolCache = ",$self->{toolcachefile}, |
95 |
– |
", ProjectCache = ",$self->{projectcachefile},"\n"; |
96 |
– |
} |
97 |
– |
|
19 |
|
sub toolcachename |
20 |
|
{ |
21 |
|
my $self=shift; |
22 |
< |
return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ToolCache.db"); |
22 |
> |
return ($self->archdir()."/ToolCache.db.gz"); |
23 |
|
} |
24 |
|
|
25 |
|
sub projectcachename |
26 |
|
{ |
27 |
|
my $self=shift; |
28 |
< |
return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ProjectCache.db"); |
28 |
> |
return ($self->archdir()."/ProjectCache.db.gz"); |
29 |
|
} |
30 |
|
|
31 |
< |
sub _tbupdate |
111 |
< |
{ |
112 |
< |
# Update toolbox relative to new RequirementsDoc: |
113 |
< |
my $self=shift; |
114 |
< |
@_?$self->{tbupdate}=shift |
115 |
< |
:$self->{tbupdate}; |
116 |
< |
} |
117 |
< |
|
118 |
< |
sub _newcache { |
31 |
> |
sub symlinks { |
32 |
|
my $self=shift; |
33 |
< |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir}; |
34 |
< |
$self->{cache}=URL::URLcache->new($loc); |
122 |
< |
return $self->{cache}; |
33 |
> |
if (@_) {$self->{symlinks}=shift;} |
34 |
> |
return $self->{symlinks}; |
35 |
|
} |
36 |
|
|
37 |
< |
sub _newobjectstore { |
38 |
< |
my $self=shift; |
39 |
< |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir}; |
40 |
< |
$self->{dbstore}=ObjectUtilities::ObjectStore->new($loc); |
41 |
< |
return $self->{dbstore}; |
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 objectstore { |
59 |
> |
sub configchksum { |
60 |
|
my $self=shift; |
61 |
< |
|
62 |
< |
if ( @_ ) { |
136 |
< |
$self->{dbstore}=shift; |
137 |
< |
} |
138 |
< |
if ( ! defined $self->{dbstore} ) { |
139 |
< |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir}; |
140 |
< |
if ( -e $loc ) { |
141 |
< |
$self->{dbstore}=ObjectUtilities::ObjectStore->new($loc); |
142 |
< |
} |
143 |
< |
else { |
144 |
< |
$self->{dbstore}=undef; |
145 |
< |
} |
146 |
< |
} |
147 |
< |
return $self->{dbstore} |
61 |
> |
if (@_) {$self->{configchksum}=shift;} |
62 |
> |
return $self->{configchksum}; |
63 |
|
} |
64 |
|
|
65 |
+ |
|
66 |
|
sub name { |
67 |
|
my $self=shift; |
68 |
|
@_?$self->{name}=shift |
78 |
|
sub setup { |
79 |
|
my $self=shift; |
80 |
|
my $location=shift; |
81 |
< |
my $areaname; |
82 |
< |
|
83 |
< |
# -- check we have a project name and version |
168 |
< |
my $name=$self->name(); |
169 |
< |
my $vers=$self->version(); |
170 |
< |
|
171 |
< |
if ( ( ! defined $name ) && ( ! defined $version )) { |
172 |
< |
$self->error("Set ConfigArea name and version before setup"); |
173 |
< |
} |
174 |
< |
|
175 |
< |
# -- check arguments and set location |
176 |
< |
if ( ! defined $location ) { |
177 |
< |
$self->error("ConfigArea: Cannot setup new area without a location"); |
178 |
< |
} |
179 |
< |
if ( @_ ) { |
180 |
< |
$areaname=shift; |
181 |
< |
} |
81 |
> |
my $areaname=shift || undef; |
82 |
> |
my $symlinks=shift || 0; |
83 |
> |
my $locarea = shift || undef; |
84 |
|
if ( (! defined $areaname) || ( $areaname eq "" ) ) { |
85 |
< |
# -- make up a name from the project name and version |
184 |
< |
$vers=~s/^$name\_//; |
185 |
< |
$areaname=$name."_".$vers; |
85 |
> |
$areaname=$self->version(); |
86 |
|
} |
87 |
< |
my $arealoc=$location."/".$areaname; |
88 |
< |
my $workloc=$arealoc."/".$self->{admindir}; |
89 |
< |
$self->verbose("Building at $arealoc"); |
90 |
< |
$self->location($arealoc); |
91 |
< |
|
92 |
< |
# -- create top level structure and work area |
93 |
< |
AddDir::adddir($workloc); |
94 |
< |
|
95 |
< |
# -- add a cache |
96 |
< |
$self->_newcache(); |
97 |
< |
|
98 |
< |
# -- add an Objectstore |
99 |
< |
$self->_newobjectstore(); |
100 |
< |
|
101 |
< |
# -- Save Environment File |
102 |
< |
$self->_SaveEnvFile(); |
103 |
< |
|
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 configurationdir { |
121 |
|
return (defined $self->{sourcedir})?$self->{sourcedir}:undef; |
122 |
|
} |
123 |
|
|
124 |
< |
sub toolbox { |
223 |
< |
my $self=shift; |
224 |
< |
if ( ! defined $self->{toolbox} ) { |
225 |
< |
$self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH}); |
226 |
< |
} |
227 |
< |
return $self->{toolbox}; |
228 |
< |
} |
229 |
< |
|
230 |
< |
sub toolboxversion { |
231 |
< |
my $self=shift; |
232 |
< |
if ( @_ ) { |
233 |
< |
$self->{toolboxversion}=shift; |
234 |
< |
} |
235 |
< |
return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef; |
236 |
< |
} |
237 |
< |
|
238 |
< |
sub requirementsdoc { |
124 |
> |
sub releasetop { |
125 |
|
my $self=shift; |
126 |
|
if ( @_ ) { |
127 |
< |
$self->{reqdoc}=shift; |
242 |
< |
} |
243 |
< |
if ( defined $self->{reqdoc} ) { |
244 |
< |
return $self->location()."/".$self->{reqdoc}; |
245 |
< |
} |
246 |
< |
else { |
247 |
< |
return undef; |
127 |
> |
$self->{releasetop}=shift; |
128 |
|
} |
129 |
+ |
return (defined $self->{releasetop})?$self->{releasetop}:undef; |
130 |
|
} |
131 |
|
|
132 |
< |
sub scramversion { |
252 |
< |
my $self=shift; |
253 |
< |
if ( ! defined $self->{scramversion} ) { |
254 |
< |
my $filename=$self->location()."/".$self->configurationdir()."/". |
255 |
< |
"scram_version"; |
256 |
< |
if ( -f $filename ) { |
257 |
< |
use FileHandle; |
258 |
< |
$fh=FileHandle->new(); |
259 |
< |
open ($fh, "<".$filename); |
260 |
< |
my $version=<$fh>; |
261 |
< |
chomp $version; |
262 |
< |
$self->{scramversion}=$version; |
263 |
< |
undef $fh; |
264 |
< |
} |
265 |
< |
} |
266 |
< |
return $self->{scramversion}; |
267 |
< |
} |
268 |
< |
|
269 |
< |
sub sitename |
132 |
> |
sub admindir() |
133 |
|
{ |
134 |
< |
############################################################### |
272 |
< |
# sitename() # |
273 |
< |
############################################################### |
274 |
< |
# modified : Mon Dec 3 15:45:35 2001 / SFA # |
275 |
< |
# params : # |
276 |
< |
# : # |
277 |
< |
# : # |
278 |
< |
# : # |
279 |
< |
# function : Read the site name from config/site/sitename and # |
280 |
< |
# : export it. # |
281 |
< |
# : # |
282 |
< |
# : # |
283 |
< |
############################################################### |
284 |
< |
my $self = shift; |
285 |
< |
my $sitefile = $self->location()."/".$self->configurationdir()."/site/sitename"; |
286 |
< |
|
287 |
< |
$self->{sitename} = 'CERN'; # Use CERN as the default site name |
288 |
< |
|
289 |
< |
use FileHandle; |
290 |
< |
my $sitefh = FileHandle->new(); |
291 |
< |
|
292 |
< |
# Be verbose and print file we're going to read: |
293 |
< |
$self->verbose(">> Going to try to get sitename from: ".$sitefile." "); |
294 |
< |
|
295 |
< |
# See if we can read from the file. If not, just |
296 |
< |
# use default site name: |
297 |
< |
open($sitefh,"<".$sitefile) || |
298 |
< |
do |
299 |
< |
{ |
300 |
< |
$self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name."); |
301 |
< |
return $self->{sitename}; |
302 |
< |
}; |
303 |
< |
|
304 |
< |
$sitename = <$sitefh>; |
305 |
< |
chomp($sitename); |
306 |
< |
$self->{sitename} = $sitename; |
134 |
> |
my $self=shift; |
135 |
|
|
136 |
< |
# Close the file (be tidy!); |
137 |
< |
close($sitefile); |
310 |
< |
# Return: |
311 |
< |
return $self->{sitename}; |
136 |
> |
@_ ? $self->{admindir} = shift |
137 |
> |
: $self->{admindir}; |
138 |
|
} |
139 |
|
|
314 |
– |
|
140 |
|
sub bootstrapfromlocation { |
141 |
|
my $self=shift; |
142 |
< |
|
142 |
> |
my $location = $self->searchlocation(shift); |
143 |
|
my $rv=0; |
144 |
< |
|
320 |
< |
my $location; |
321 |
< |
if ( ! defined ($location=$self->searchlocation(@_)) ) { |
144 |
> |
if ( ! defined $location) { |
145 |
|
$rv=1; |
323 |
– |
$self->verbose("Unable to locate the top of local configuration area"); |
146 |
|
} |
147 |
|
else { |
148 |
|
$self->location($location); |
327 |
– |
$self->verbose("Found top ".$self->location()); |
149 |
|
$self->_LoadEnvFile(); |
150 |
|
} |
151 |
|
return $rv; |
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 |
|
} |
204 |
|
sub archname { |
205 |
|
my $self=shift; |
206 |
|
if ( @_ ) { |
207 |
< |
$self->{archname}=shift; |
207 |
> |
$self->{arch} = shift; |
208 |
> |
if (defined $self->{location}) { |
209 |
> |
$self->archdir($self->{location}."/".$self->{admindir}."/".$self->{arch}); |
210 |
> |
} |
211 |
|
} |
212 |
< |
return $self->{archname}; |
212 |
> |
return $self->{arch}; |
213 |
|
} |
214 |
|
|
215 |
|
sub archdir { |
217 |
|
if ( @_ ) { |
218 |
|
$self->{archdir}=shift; |
219 |
|
} |
390 |
– |
if ( ! defined $self->{archdir} ) { |
391 |
– |
if ( defined $self->{archname} ) { |
392 |
– |
$self->{archdir}=$self->location()."/".$self->{admindir}."/". |
393 |
– |
$self->{archname}; |
394 |
– |
} |
395 |
– |
else { |
396 |
– |
$self->error("ConfigArea : cannot create arch directory - ". |
397 |
– |
"architecture name not set") |
398 |
– |
} |
399 |
– |
} |
220 |
|
return $self->{archdir}; |
221 |
|
} |
222 |
|
|
223 |
|
sub satellite { |
224 |
|
my $self=shift; |
225 |
< |
|
226 |
< |
# -- create the sat object |
407 |
< |
my $sat=Configuration::ConfigArea->new(); |
225 |
> |
my $relloc = $self->location(); |
226 |
> |
my $sat=Configuration::ConfigArea->new($ENV{SCRAM_ARCH}); |
227 |
|
$sat->name($self->name()); |
228 |
|
$sat->version($self->version()); |
410 |
– |
$sat->requirementsdoc($self->{reqdoc}); |
229 |
|
$sat->configurationdir($self->configurationdir()); |
230 |
|
$sat->sourcedir($self->sourcedir()); |
231 |
< |
$sat->toolboxversion($self->toolboxversion()); |
231 |
> |
$sat->releasetop($relloc); |
232 |
> |
$sat->configchksum($self->configchksum()); |
233 |
|
$sat->setup(@_); |
234 |
< |
|
235 |
< |
# -- copy across the cache and ObjectStore |
236 |
< |
# -- make sure we dont try building new caches in release areas |
237 |
< |
my $rcache=$self->cache(); |
238 |
< |
if ( defined $rcache ) { |
239 |
< |
copy($rcache->location(),$sat->cache()->location()); |
240 |
< |
} |
241 |
< |
|
242 |
< |
# -- make sure we dont try building new objectstores in release areas |
243 |
< |
my $rostore=$self->objectstore(); |
244 |
< |
if ( defined $rostore ) { |
245 |
< |
copy($rostore->location(),$sat->objectstore()->location()); |
246 |
< |
} |
247 |
< |
|
248 |
< |
# and make sure in reinitialises |
249 |
< |
undef ($sat->{cache}); |
250 |
< |
|
251 |
< |
# -- link it to this area |
433 |
< |
$sat->linkarea($self); |
434 |
< |
|
435 |
< |
# -- save it |
436 |
< |
$sat->save(); |
437 |
< |
|
234 |
> |
$self->copywithskip($self->archdir(),$sat->archdir(),["InstalledTools","ProjectCache.db.gz","RuntimeCache.db.gz","DirCache.db.gz","MakeData/DirCache","MakeData/DirCache.mk","MakeData/src.mk"]); |
235 |
> |
$envfile = $sat->archdir()."/Environment"; |
236 |
> |
open ( $fh, "> $envfile" ) or $sat->error("Cannot Open \"$envfile\" file to Save\n $!"); |
237 |
> |
print $fh "RELEASETOP=$relloc\n"; |
238 |
> |
close($fh); |
239 |
> |
my $devconf = $sat->location()."/".$sat->configurationdir(); |
240 |
> |
my $relconf = $self->location()."/".$self->configurationdir(); |
241 |
> |
if (!-d $devconf) |
242 |
> |
{ |
243 |
> |
$self->copywithskip($relconf,$devconf,['toolbox']); |
244 |
> |
} |
245 |
> |
$envfile = $sat->location()."/".$self->{admindir}."/Environment"; |
246 |
> |
if (! -f $envfile) |
247 |
> |
{ |
248 |
> |
$sat->save (); |
249 |
> |
} |
250 |
> |
Utilities::AddDir::copydir("${relconf}/toolbox/".$self->{arch},"${devconf}/toolbox/".$self->{arch}); |
251 |
> |
Utilities::AddDir::adddir ($sat->location()."/".$sat->sourcedir()); |
252 |
|
return $sat; |
253 |
|
} |
254 |
|
|
441 |
– |
sub copy { |
442 |
– |
my $self=shift; |
443 |
– |
my $destination=shift; |
444 |
– |
|
445 |
– |
# copy across the admin dir |
446 |
– |
my $temp=$self->location()."/".$self->{admindir}; |
447 |
– |
AddDir::copydir($temp,"$destination/".$self->{admindir}); |
448 |
– |
} |
449 |
– |
|
450 |
– |
sub align { |
451 |
– |
my $self=shift; |
452 |
– |
use File::Copy; |
453 |
– |
|
454 |
– |
$self->_LoadEnvFile(); |
455 |
– |
my $Envfile=$self->location()."/".$self->{admindir}."/Environment"; |
456 |
– |
my $tmpEnvfile=$Envfile.".bak"; |
457 |
– |
my $rel=$self->{ENV}{RELEASETOP}; |
458 |
– |
my $local=$self->location(); |
459 |
– |
|
460 |
– |
rename( $Envfile, $tmpEnvfile ); |
461 |
– |
use FileHandle; |
462 |
– |
my $fh=FileHandle->new(); |
463 |
– |
my $fout=FileHandle->new(); |
464 |
– |
open ( $fh, "<".$tmpEnvfile ) or |
465 |
– |
$self->error("Cannot find Environment file. Area Corrupted? (" |
466 |
– |
.$self->location().")\n $!"); |
467 |
– |
open ( $fout, ">".$Envfile ) or |
468 |
– |
$self->error("Cannot find Environment file. Area Corrupted? (" |
469 |
– |
.$self->location().")\n $!"); |
470 |
– |
while ( <$fh> ) { |
471 |
– |
$_=~s/\Q$rel\L/$local/g; |
472 |
– |
print $fout $_; |
473 |
– |
} |
474 |
– |
undef $fh; |
475 |
– |
undef $fout; |
476 |
– |
} |
477 |
– |
|
478 |
– |
sub copysetup { |
479 |
– |
my $self=shift; |
480 |
– |
my $dest=shift; |
481 |
– |
my $rv=1; |
482 |
– |
# copy across the admin dir |
483 |
– |
my $temp=$self->location()."/".$self->{admindir}."/".$self->arch(); |
484 |
– |
my $temp2=$dest."/".$self->{admindir}."/".$self->arch(); |
485 |
– |
if ( $temp ne $temp2 ) { |
486 |
– |
if ( -d $temp ) { |
487 |
– |
AddDir::copydir($temp,$temp2); |
488 |
– |
$rv=0; |
489 |
– |
} |
490 |
– |
} |
491 |
– |
return $rv; |
492 |
– |
} |
493 |
– |
|
494 |
– |
sub copyurlcache { |
495 |
– |
my $self=shift; |
496 |
– |
my $dest=shift; |
497 |
– |
my $rv=1; |
498 |
– |
# copy across the admin dir |
499 |
– |
my $temp=$self->location()."/".$self->{admindir}."/cache"; |
500 |
– |
my $temp2=$dest."/".$self->{admindir}."/cache"; |
501 |
– |
if ( $temp ne $temp2 ) { |
502 |
– |
if ( -d $temp ) { |
503 |
– |
AddDir::copydir($temp,$temp2); |
504 |
– |
$rv=0; |
505 |
– |
} |
506 |
– |
} |
507 |
– |
return $rv; |
508 |
– |
} |
509 |
– |
|
255 |
|
sub copywithskip { |
256 |
|
my $self=shift; |
257 |
< |
my $dest=shift; |
258 |
< |
my ($filetoskip)=@_; |
257 |
> |
my $src=shift; |
258 |
> |
my $des=shift; |
259 |
> |
my $filetoskip=shift || []; |
260 |
|
my $rv=1; |
261 |
< |
# copy across the admin dir |
262 |
< |
my $temp=$self->location()."/".$self->{admindir}."/".$self->arch(); |
263 |
< |
my $temp2=$dest."/".$self->{admindir}."/".$self->arch(); |
264 |
< |
if ( $temp ne $temp2 ) { |
265 |
< |
if ( -d $temp ) { |
266 |
< |
AddDir::copydirwithskip($temp,$temp2,$filetoskip); |
267 |
< |
$rv=0; |
268 |
< |
} |
269 |
< |
} |
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 |
|
|
282 |
|
|
283 |
|
sub arch { |
284 |
|
my $self=shift; |
285 |
< |
return $ENV{SCRAM_ARCH}; |
539 |
< |
} |
540 |
< |
|
541 |
< |
sub linkto { |
542 |
< |
my $self=shift; |
543 |
< |
my $location=shift; |
544 |
< |
|
545 |
< |
if ( -d $location ) { |
546 |
< |
my $area=Configuration::ConfigArea->new(); |
547 |
< |
$area->bootstrapfromlocation($location); |
548 |
< |
$self->linkarea($area); |
549 |
< |
} |
550 |
< |
else { |
551 |
< |
$self->error("ConfigArea : Unable to link to non existing directory ". |
552 |
< |
$location); |
553 |
< |
} |
554 |
< |
} |
555 |
< |
|
556 |
< |
sub unlinkarea { |
557 |
< |
my $self=shift; |
558 |
< |
undef $self->{linkarea}; |
559 |
< |
$self->{linkarea}=undef; |
560 |
< |
$self->save(); |
561 |
< |
} |
562 |
< |
|
563 |
< |
sub linkarea { |
564 |
< |
my $self=shift; |
565 |
< |
my $area=shift; |
566 |
< |
if ( defined $area ) { |
567 |
< |
$self->{linkarea}=$area; |
568 |
< |
} |
569 |
< |
return (defined $self->{linkarea} && $self->{linkarea} ne "")? |
570 |
< |
$self->{linkarea}:undef; |
285 |
> |
return $self->{arch}; |
286 |
|
} |
287 |
|
|
288 |
|
sub save { |
292 |
|
|
293 |
|
# ---- support routines |
294 |
|
|
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 _SaveEnvFile |
318 |
|
{ |
319 |
|
my $self=shift; |
583 |
– |
my $filemode = 0644; |
320 |
|
|
321 |
< |
use FileHandle; |
322 |
< |
my $fh=FileHandle->new(); |
323 |
< |
open ( $fh, ">".$self->location()."/".$self->{admindir}."/". |
588 |
< |
"Environment" ) or |
589 |
< |
$self->error("Cannot Open Environment file to Save (" |
590 |
< |
.$self->location().")\n $!"); |
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 |
|
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_ProjReqsDoc=".$self->{reqdoc}."\n"; |
330 |
< |
print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n"; |
329 |
> |
print $fh "SCRAM_SYMLINKS=",$self->symlinks(),"\n"; |
330 |
> |
print $fh "SCRAM_CONFIGCHKSUM=",$self->configchksum(),"\n"; |
331 |
> |
close($fh); |
332 |
|
|
599 |
– |
if ( defined $self->linkarea() ) |
600 |
– |
{ |
601 |
– |
my $area=$self->linkarea()->location(); |
602 |
– |
if ( $area ne "" ) |
603 |
– |
{ |
604 |
– |
print $fh "RELEASETOP=".$area."\n"; |
605 |
– |
} |
606 |
– |
} |
607 |
– |
|
608 |
– |
undef $fh; |
609 |
– |
|
333 |
|
# Set the default permissions (-rw-r--r--): |
334 |
+ |
my $filemode = 0644; |
335 |
|
chmod $filemode, $self->location()."/".$self->{admindir}."/Environment"; |
336 |
|
} |
337 |
|
|
339 |
|
{ |
340 |
|
my $self=shift; |
341 |
|
|
342 |
< |
use FileHandle; |
343 |
< |
my $fh=FileHandle->new(); |
344 |
< |
open ( $fh, "<".$self->location()."/".$self->{admindir}."/". |
621 |
< |
"Environment" ) or |
622 |
< |
$self->error("Cannot find Environment file. Area Corrupted? (" |
623 |
< |
.$self->location().")\n $!"); |
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; |
350 |
|
($name, $value)=split /=/; |
351 |
|
eval "\$self->{ENV}{${name}}=\"$value\""; |
352 |
|
} |
353 |
< |
undef $fh; |
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"}); |
391 |
|
{ |
392 |
|
$self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"}); |
393 |
|
} |
394 |
< |
if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) |
652 |
< |
{ |
653 |
< |
$self->requirementsdoc($self->{ENV}{"SCRAM_ProjReqsDoc"}); |
654 |
< |
} |
655 |
< |
if ( defined $self->{ENV}{"SCRAM_TOOLBOXVERSION"} ) |
656 |
< |
{ |
657 |
< |
$self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"}); |
658 |
< |
} |
659 |
< |
|
660 |
< |
if ( ( defined $self->{ENV}{"RELEASETOP"} ) && |
661 |
< |
($self->{ENV}{"RELEASETOP"} ne $self->location())) |
394 |
> |
if ( defined $self->{ENV}{"RELEASETOP"} ) |
395 |
|
{ |
396 |
< |
$self->linkto($self->{ENV}{"RELEASETOP"}); |
396 |
> |
$self->releasetop($self->{ENV}{"RELEASETOP"}); |
397 |
|
} |
398 |
|
} |
399 |
+ |
1; |