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]) : get/set a link from 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 |
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 |
|
|
129 |
|
package Configuration::ConfigArea; |
130 |
|
require 5.004; |
144 |
|
$self->{admindir}=".SCRAM"; |
145 |
|
$self->{cachedir}="cache"; |
146 |
|
$self->{dbdir}="ObjectDB"; |
147 |
+ |
$self->{tbupdate}=0; |
148 |
|
undef $self->{linkarea}; |
149 |
|
|
150 |
|
return $self; |
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}; |
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}; |
169 |
|
} |
170 |
|
|
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 |
+ |
|
179 |
+ |
sub toolcachename |
180 |
+ |
{ |
181 |
+ |
my $self=shift; |
182 |
+ |
return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ToolCache.db"); |
183 |
+ |
} |
184 |
+ |
|
185 |
+ |
sub projectcachename |
186 |
+ |
{ |
187 |
+ |
my $self=shift; |
188 |
+ |
return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ProjectCache.db"); |
189 |
+ |
} |
190 |
+ |
|
191 |
+ |
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 { |
200 |
< |
my $self=shift; |
201 |
< |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir}; |
202 |
< |
$self->{cache}=URL::URLcache->new($loc); |
203 |
< |
return $self->{cache}; |
200 |
> |
my $self=shift; |
201 |
> |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir}; |
202 |
> |
$self->{cache}=URL::URLcache->new($loc); |
203 |
> |
return $self->{cache}; |
204 |
|
} |
205 |
|
|
206 |
|
sub _newobjectstore { |
207 |
< |
my $self=shift; |
208 |
< |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir}; |
209 |
< |
$self->{dbstore}=ObjectUtilities::ObjectStore->new($loc); |
210 |
< |
return $self->{dbstore}; |
211 |
< |
} |
207 |
> |
my $self=shift; |
208 |
> |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir}; |
209 |
> |
$self->{dbstore}=ObjectUtilities::ObjectStore->new($loc); |
210 |
> |
return $self->{dbstore}; |
211 |
> |
} |
212 |
|
|
213 |
|
sub objectstore { |
214 |
< |
my $self=shift; |
214 |
> |
my $self=shift; |
215 |
|
|
216 |
< |
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} |
216 |
> |
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} |
229 |
> |
} |
230 |
> |
|
231 |
> |
sub symlinks { |
232 |
> |
my $self=shift; |
233 |
> |
if (@_) {$self->{symlinks}=shift;} |
234 |
> |
return $self->{symlinks}; |
235 |
|
} |
236 |
|
|
237 |
|
sub name { |
250 |
|
my $self=shift; |
251 |
|
my $location=shift; |
252 |
|
my $areaname; |
253 |
+ |
my $symlinks=0; |
254 |
|
|
255 |
|
# -- check we have a project name and version |
256 |
|
my $name=$self->name(); |
257 |
|
my $vers=$self->version(); |
258 |
+ |
|
259 |
|
if ( ( ! defined $name ) && ( ! defined $version )) { |
260 |
|
$self->error("Set ConfigArea name and version before setup"); |
261 |
|
} |
267 |
|
if ( @_ ) { |
268 |
|
$areaname=shift; |
269 |
|
} |
270 |
+ |
if ( @_ ) { |
271 |
+ |
$symlinks=shift || 0; |
272 |
+ |
} |
273 |
|
if ( (! defined $areaname) || ( $areaname eq "" ) ) { |
274 |
< |
# -- make up a name from the project name and version |
154 |
< |
$vers=~s/^$name\_//; |
155 |
< |
$areaname=$name."_".$vers; |
274 |
> |
$areaname=$vers; |
275 |
|
} |
276 |
|
my $arealoc=$location."/".$areaname; |
277 |
|
my $workloc=$arealoc."/".$self->{admindir}; |
278 |
|
$self->verbose("Building at $arealoc"); |
279 |
|
$self->location($arealoc); |
280 |
+ |
$self->symlinks($symlinks); |
281 |
|
|
282 |
|
# -- create top level structure and work area |
283 |
|
AddDir::adddir($workloc); |
285 |
|
# -- add a cache |
286 |
|
$self->_newcache(); |
287 |
|
|
288 |
< |
# -- add an Objectstore |
289 |
< |
$self->_newobjectstore(); |
288 |
> |
# -- add an Objectstore |
289 |
> |
$self->_newobjectstore(); |
290 |
|
|
291 |
|
# -- Save Environment File |
292 |
|
$self->_SaveEnvFile(); |
301 |
|
return (defined $self->{configurationdir})?$self->{configurationdir}:undef; |
302 |
|
} |
303 |
|
|
304 |
+ |
sub sourcedir { |
305 |
+ |
my $self=shift; |
306 |
+ |
if ( @_ ) { |
307 |
+ |
$self->{sourcedir}=shift; |
308 |
+ |
} |
309 |
+ |
return (defined $self->{sourcedir})?$self->{sourcedir}:undef; |
310 |
+ |
} |
311 |
+ |
|
312 |
|
sub toolbox { |
313 |
|
my $self=shift; |
314 |
|
if ( ! defined $self->{toolbox} ) { |
315 |
< |
$self->{toolbox}=BuildSystem::ToolBox->new($self); |
315 |
> |
$self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH}); |
316 |
|
} |
317 |
|
return $self->{toolbox}; |
318 |
|
} |
319 |
|
|
320 |
+ |
sub toolboxversion { |
321 |
+ |
my $self=shift; |
322 |
+ |
if ( @_ ) { |
323 |
+ |
$self->{toolboxversion}=shift; |
324 |
+ |
} |
325 |
+ |
return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef; |
326 |
+ |
} |
327 |
+ |
|
328 |
|
sub requirementsdoc { |
329 |
|
my $self=shift; |
330 |
|
if ( @_ ) { |
356 |
|
return $self->{scramversion}; |
357 |
|
} |
358 |
|
|
359 |
+ |
sub sitename |
360 |
+ |
{ |
361 |
+ |
############################################################### |
362 |
+ |
# sitename() # |
363 |
+ |
############################################################### |
364 |
+ |
# modified : Mon Dec 3 15:45:35 2001 / SFA # |
365 |
+ |
# params : # |
366 |
+ |
# : # |
367 |
+ |
# : # |
368 |
+ |
# : # |
369 |
+ |
# function : Read the site name from config/site/sitename and # |
370 |
+ |
# : export it. # |
371 |
+ |
# : # |
372 |
+ |
# : # |
373 |
+ |
############################################################### |
374 |
+ |
my $self = shift; |
375 |
+ |
my $sitefile = $self->location()."/".$self->configurationdir()."/site/sitename"; |
376 |
+ |
|
377 |
+ |
$self->{sitename} = 'CERN'; # Use CERN as the default site name |
378 |
+ |
|
379 |
+ |
use FileHandle; |
380 |
+ |
my $sitefh = FileHandle->new(); |
381 |
+ |
|
382 |
+ |
# Be verbose and print file we're going to read: |
383 |
+ |
$self->verbose(">> Going to try to get sitename from: ".$sitefile." "); |
384 |
+ |
|
385 |
+ |
# See if we can read from the file. If not, just |
386 |
+ |
# use default site name: |
387 |
+ |
open($sitefh,"<".$sitefile) || |
388 |
+ |
do |
389 |
+ |
{ |
390 |
+ |
$self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name."); |
391 |
+ |
return $self->{sitename}; |
392 |
+ |
}; |
393 |
+ |
|
394 |
+ |
$sitename = <$sitefh>; |
395 |
+ |
chomp($sitename); |
396 |
+ |
$self->{sitename} = $sitename; |
397 |
+ |
|
398 |
+ |
# Close the file (be tidy!); |
399 |
+ |
close($sitefile); |
400 |
+ |
# Return: |
401 |
+ |
return $self->{sitename}; |
402 |
+ |
} |
403 |
+ |
|
404 |
+ |
sub admindir() |
405 |
+ |
{ |
406 |
+ |
my $self=shift; |
407 |
+ |
|
408 |
+ |
@_ ? $self->{admindir} = shift |
409 |
+ |
: $self->{admindir}; |
410 |
+ |
} |
411 |
+ |
|
412 |
|
sub bootstrapfromlocation { |
413 |
|
my $self=shift; |
414 |
|
|
422 |
|
else { |
423 |
|
$self->location($location); |
424 |
|
$self->verbose("Found top ".$self->location()); |
236 |
– |
my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat"; |
425 |
|
$self->_LoadEnvFile(); |
426 |
|
} |
427 |
|
return $rv; |
442 |
|
|
443 |
|
sub searchlocation { |
444 |
|
my $self=shift; |
445 |
< |
|
445 |
> |
|
446 |
|
#start search in current directory if not specified |
447 |
|
my $thispath; |
448 |
|
if ( @_ ) { |
451 |
|
else { |
452 |
|
$thispath=cwd(); |
453 |
|
} |
454 |
< |
|
454 |
> |
|
455 |
|
my $rv=0; |
456 |
|
|
457 |
|
# chop off any files - we only want dirs |
467 |
|
last Sloop; |
468 |
|
} |
469 |
|
} while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) }; |
470 |
< |
|
470 |
> |
|
471 |
|
return $rv?$thispath:undef; |
472 |
|
} |
473 |
|
|
506 |
|
$sat->version($self->version()); |
507 |
|
$sat->requirementsdoc($self->{reqdoc}); |
508 |
|
$sat->configurationdir($self->configurationdir()); |
509 |
+ |
$sat->sourcedir($self->sourcedir()); |
510 |
+ |
$sat->toolboxversion($self->toolboxversion()); |
511 |
|
$sat->setup(@_); |
512 |
|
|
513 |
|
# -- copy across the cache and ObjectStore |
574 |
|
|
575 |
|
sub copysetup { |
576 |
|
my $self=shift; |
577 |
< |
my $dest=shift; |
388 |
< |
|
577 |
> |
my $dest=shift; |
578 |
|
my $rv=1; |
579 |
|
# copy across the admin dir |
580 |
|
my $temp=$self->location()."/".$self->{admindir}."/".$self->arch(); |
588 |
|
return $rv; |
589 |
|
} |
590 |
|
|
591 |
+ |
sub copyurlcache { |
592 |
+ |
my $self=shift; |
593 |
+ |
my $dest=shift; |
594 |
+ |
my $rv=1; |
595 |
+ |
# copy across the admin dir |
596 |
+ |
my $temp=$self->location()."/".$self->{admindir}."/cache"; |
597 |
+ |
my $temp2=$dest."/".$self->{admindir}."/cache"; |
598 |
+ |
if ( $temp ne $temp2 ) { |
599 |
+ |
if ( -d $temp ) { |
600 |
+ |
AddDir::copydir($temp,$temp2); |
601 |
+ |
$rv=0; |
602 |
+ |
} |
603 |
+ |
} |
604 |
+ |
return $rv; |
605 |
+ |
} |
606 |
+ |
|
607 |
+ |
sub copywithskip { |
608 |
+ |
my $self=shift; |
609 |
+ |
my $dest=shift; |
610 |
+ |
my $filetoskip=shift || []; |
611 |
+ |
my $rv=1; |
612 |
+ |
# copy across the admin dir |
613 |
+ |
my $temp=$self->location()."/".$self->{admindir}."/".$self->arch(); |
614 |
+ |
my $temp2=$dest."/".$self->{admindir}."/".$self->arch(); |
615 |
+ |
if ( $temp ne $temp2 ) { |
616 |
+ |
if ( -d $temp ) { |
617 |
+ |
my $fs=[]; |
618 |
+ |
foreach my $f (@$filetoskip) {push @$fs,"${temp}/${f}";} |
619 |
+ |
AddDir::copydirwithskip($temp,$temp2,$fs); |
620 |
+ |
$rv=0; |
621 |
+ |
} |
622 |
+ |
} |
623 |
+ |
return $rv; |
624 |
+ |
} |
625 |
+ |
|
626 |
|
sub copyenv { |
627 |
|
my $self=shift; |
628 |
|
my $hashref=shift; |
640 |
|
sub linkto { |
641 |
|
my $self=shift; |
642 |
|
my $location=shift; |
643 |
+ |
|
644 |
|
if ( -d $location ) { |
645 |
|
my $area=Configuration::ConfigArea->new(); |
646 |
|
$area->bootstrapfromlocation($location); |
674 |
|
$self->_SaveEnvFile(); |
675 |
|
} |
676 |
|
|
677 |
+ |
sub reqdoc() |
678 |
+ |
{ |
679 |
+ |
my $self=shift; |
680 |
+ |
my ($path)=@_; |
681 |
+ |
return $path."/".$self->{reqdoc}; |
682 |
+ |
} |
683 |
+ |
|
684 |
+ |
sub creationtime() |
685 |
+ |
{ |
686 |
+ |
my $self=shift; |
687 |
+ |
my ($location)= @_; |
688 |
+ |
$location||=$self->location(); |
689 |
+ |
my $requirementsdoc = $self->reqdoc($location); |
690 |
+ |
my ($mode, $time) = (stat($requirementsdoc))[2, 9]; |
691 |
+ |
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time); |
692 |
+ |
|
693 |
+ |
($sec < 10) ? ($sec = "0".$sec) : $sec; |
694 |
+ |
($min < 10) ? ($min = "0".$min) : $min; |
695 |
+ |
|
696 |
+ |
$year += 1900; |
697 |
+ |
my $months = |
698 |
+ |
{ |
699 |
+ |
0 => "Jan", 1 => "Feb", |
700 |
+ |
2 => "Mar", 3 => "Apr", |
701 |
+ |
4 => "May", 5 => "Jun", |
702 |
+ |
6 => "Jul", 7 => "Aug", |
703 |
+ |
8 => "Sept", 9 => "Oct", |
704 |
+ |
10 => "Nov", 11 => "Dec" }; |
705 |
+ |
|
706 |
+ |
my $days = { 1 => "Mon", 2 => "Tue", 3 => "Wed", 4 => "Thu", 5 => "Fri", 6 => "Sat", 7 => "Sun"}; |
707 |
+ |
|
708 |
+ |
# Return the timestamp (as string) of the requirementsdoc: |
709 |
+ |
return $days->{$wday}."-".$mday."-".$months->{$mon}."-".$year." ".$hour.":".$min.":".$sec; |
710 |
+ |
} |
711 |
+ |
|
712 |
|
# ---- support routines |
713 |
|
|
714 |
< |
sub _SaveEnvFile { |
715 |
< |
my $self=shift; |
716 |
< |
use FileHandle; |
717 |
< |
my $fh=FileHandle->new(); |
718 |
< |
open ( $fh, ">".$self->location()."/".$self->{admindir}."/". |
719 |
< |
"Environment" ) or |
720 |
< |
$self->error("Cannot Open Environment file to Save (" |
721 |
< |
.$self->location().")\n $!"); |
714 |
> |
sub _SaveEnvFile |
715 |
> |
{ |
716 |
> |
my $self=shift; |
717 |
> |
my $filemode = 0644; |
718 |
> |
|
719 |
> |
use FileHandle; |
720 |
> |
my $fh=FileHandle->new(); |
721 |
> |
open ( $fh, ">".$self->location()."/".$self->{admindir}."/". |
722 |
> |
"Environment" ) or |
723 |
> |
$self->error("Cannot Open Environment file to Save (" |
724 |
> |
.$self->location().")\n $!"); |
725 |
|
|
726 |
< |
print $fh "SCRAM_PROJECTNAME=".$self->name()."\n"; |
727 |
< |
print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n"; |
728 |
< |
print $fh "projconfigdir=".$self->configurationdir()."\n"; |
729 |
< |
print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n"; |
730 |
< |
if ( defined $self->linkarea() ) { |
731 |
< |
my $area=$self->linkarea()->location(); |
732 |
< |
if ( $area ne "" ) { |
733 |
< |
print $fh "RELEASETOP=".$area."\n"; |
734 |
< |
} |
735 |
< |
} |
736 |
< |
undef $fh; |
737 |
< |
} |
738 |
< |
|
739 |
< |
|
740 |
< |
sub _LoadEnvFile { |
741 |
< |
my $self=shift; |
742 |
< |
|
743 |
< |
use FileHandle; |
744 |
< |
my $fh=FileHandle->new(); |
745 |
< |
open ( $fh, "<".$self->location()."/".$self->{admindir}."/". |
746 |
< |
"Environment" ) or |
747 |
< |
$self->error("Cannot find Environment file. Area Corrupted? (" |
748 |
< |
.$self->location().")\n $!"); |
749 |
< |
while ( <$fh> ) { |
750 |
< |
chomp; |
751 |
< |
next if /^#/; |
752 |
< |
next if /^\s*$/ ; |
753 |
< |
($name, $value)=split /=/; |
754 |
< |
eval "\$self->{ENV}{${name}}=\"$value\""; |
755 |
< |
} |
756 |
< |
undef $fh; |
726 |
> |
print $fh "SCRAM_PROJECTNAME=".$self->name()."\n"; |
727 |
> |
print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n"; |
728 |
> |
print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n"; |
729 |
> |
print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n"; |
730 |
> |
print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n"; |
731 |
> |
print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n"; |
732 |
> |
print $fh "SCRAM_SYMLINKS=",$self->{symlinks},"\n"; |
733 |
> |
|
734 |
> |
if ( defined $self->linkarea() ) |
735 |
> |
{ |
736 |
> |
my $area=$self->linkarea()->location(); |
737 |
> |
if ( $area ne "" ) |
738 |
> |
{ |
739 |
> |
print $fh "RELEASETOP=".$area."\n"; |
740 |
> |
} |
741 |
> |
} |
742 |
> |
|
743 |
> |
undef $fh; |
744 |
> |
|
745 |
> |
# Repeat the exercise to save as XML: |
746 |
> |
my $fh=FileHandle->new(); |
747 |
> |
open ( $fh, ">".$self->location()."/".$self->{admindir}."/". |
748 |
> |
"Environment.xml" ) or |
749 |
> |
$self->error("Cannot Open Environment.xml file to Save (" |
750 |
> |
.$self->location().")\n $!"); |
751 |
> |
print $fh "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"; |
752 |
> |
print $fh "<doc type=\"Configuration::ProjectEnvironment\" version=\"1.0\">\n"; |
753 |
> |
print $fh " <environment SCRAM_PROJECTNAME=\"".$self->name()."\"/>\n"; |
754 |
> |
print $fh " <environment SCRAM_PROJECTVERSION=\"".$self->version()."\"/>\n"; |
755 |
> |
print $fh " <environment SCRAM_CONFIGDIR=\"".$self->configurationdir()."\"/>\n"; |
756 |
> |
print $fh " <environment SCRAM_SOURCEDIR=\"".$self->sourcedir()."\"/>\n"; |
757 |
> |
print $fh " <environment SCRAM_ProjReqsDoc=\"".$self->{reqdoc}."\"/>\n"; |
758 |
> |
print $fh " <environment SCRAM_TOOLBOXVERSION=\"".$self->{toolboxversion}."\"/>\n"; |
759 |
> |
print $fh "<environment SCRAM_SYMLINKS=\"",$self->{symlinks},"\"/>\n"; |
760 |
> |
|
761 |
> |
if ( defined $self->linkarea() ) |
762 |
> |
{ |
763 |
> |
my $area=$self->linkarea()->location(); |
764 |
> |
if ( $area ne "" ) |
765 |
> |
{ |
766 |
> |
print $fh " <environment RELEASETOP=\"".$area."\"/>\n"; |
767 |
> |
} |
768 |
> |
} |
769 |
> |
|
770 |
> |
print $fh "</doc>\n"; |
771 |
> |
undef $fh; |
772 |
> |
|
773 |
> |
# Set the default permissions (-rw-r--r--): |
774 |
> |
chmod $filemode, $self->location()."/".$self->{admindir}."/Environment"; |
775 |
> |
chmod $filemode, $self->location()."/".$self->{admindir}."/Environment.xml"; |
776 |
> |
} |
777 |
> |
|
778 |
> |
sub _LoadEnvFile |
779 |
> |
{ |
780 |
> |
my $self=shift; |
781 |
> |
|
782 |
> |
use FileHandle; |
783 |
> |
my $fh=FileHandle->new(); |
784 |
> |
open ( $fh, "<".$self->location()."/".$self->{admindir}."/". |
785 |
> |
"Environment" ) or |
786 |
> |
$self->error("Cannot find Environment file. Area Corrupted? (" |
787 |
> |
.$self->location().")\n $!"); |
788 |
> |
while ( <$fh> ) |
789 |
> |
{ |
790 |
> |
chomp; |
791 |
> |
next if /^#/; |
792 |
> |
next if /^\s*$/ ; |
793 |
> |
($name, $value)=split /=/; |
794 |
> |
eval "\$self->{ENV}{${name}}=\"$value\""; |
795 |
> |
} |
796 |
> |
undef $fh; |
797 |
|
|
798 |
< |
# -- set internal variables appropriately |
799 |
< |
if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) { |
800 |
< |
$self->name($self->{ENV}{"SCRAM_PROJECTNAME"}); |
801 |
< |
} |
802 |
< |
if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) { |
803 |
< |
$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"}); |
804 |
< |
} |
805 |
< |
if ( defined $self->{ENV}{"projconfigdir"} ) { |
806 |
< |
$self->configurationdir($self->{ENV}{projconfigdir}); |
807 |
< |
} |
808 |
< |
if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) { |
809 |
< |
$self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc}); |
810 |
< |
} |
811 |
< |
if ( ( defined $self->{ENV}{"RELEASETOP"} ) && |
812 |
< |
($self->{ENV}{"RELEASETOP"} ne $self->location())) { |
813 |
< |
$self->linkto($self->{ENV}{"RELEASETOP"}); |
814 |
< |
} |
815 |
< |
else { |
816 |
< |
$self->{ENV}{"RELEASETOP"}=$self->location(); |
817 |
< |
} |
818 |
< |
} |
798 |
> |
# -- set internal variables appropriately |
799 |
> |
if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) |
800 |
> |
{ |
801 |
> |
$self->name($self->{ENV}{"SCRAM_PROJECTNAME"}); |
802 |
> |
} |
803 |
> |
if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) |
804 |
> |
{ |
805 |
> |
$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"}); |
806 |
> |
} |
807 |
> |
if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} ) |
808 |
> |
{ |
809 |
> |
$self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"}); |
810 |
> |
} |
811 |
> |
if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} ) |
812 |
> |
{ |
813 |
> |
$self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"}); |
814 |
> |
} |
815 |
> |
if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) |
816 |
> |
{ |
817 |
> |
$self->requirementsdoc($self->{ENV}{"SCRAM_ProjReqsDoc"}); |
818 |
> |
} |
819 |
> |
if ( defined $self->{ENV}{"SCRAM_TOOLBOXVERSION"} ) |
820 |
> |
{ |
821 |
> |
if ($self->{ENV}{"SCRAM_TOOLBOXVERSION"} eq '') |
822 |
> |
{ |
823 |
> |
$self->toolboxversion("STANDALONE"); |
824 |
> |
} |
825 |
> |
else |
826 |
> |
{ |
827 |
> |
$self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"}); |
828 |
> |
} |
829 |
> |
} |
830 |
> |
|
831 |
> |
if ( ( defined $self->{ENV}{"RELEASETOP"} ) && |
832 |
> |
($self->{ENV}{"RELEASETOP"} ne $self->location())) |
833 |
> |
{ |
834 |
> |
$self->linkto($self->{ENV}{"RELEASETOP"}); |
835 |
> |
} |
836 |
> |
} |