ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/Configuration/ConfigArea.pm

Comparing COMP/SCRAM/src/Configuration/ConfigArea.pm (file contents):
Revision 1.35 by muzaffar, Thu Jan 3 09:35:45 2008 UTC vs.
Revision 1.36 by muzaffar, Fri Jan 14 17:36: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
#	Line 139 | Line 9 | sub new {
9		my $class=shift;
10		my $self={};
11		bless $self, $class;
142	–
143	–	# data init
12		$self->{admindir}=".SCRAM";
13	<	$self->{cachedir}="cache";
14	<	$self->{dbdir}="ObjectDB";
147	<	$self->{tbupdate}=0;
148	<	undef $self->{linkarea};
149	<
13	>	$self->{configurationdir} = "config";
14	>	$self->archname(shift || $ENV{SCRAM_ARCH});
15		return $self;
16		}
17
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};
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	–
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
231	–	sub symlinks {
232	–	my $self=shift;
233	–	if (@_) {$self->{symlinks}=shift;}
234	–	return $self->{symlinks};
235	–	}
52
53		sub name {
54		my $self=shift;
#	Line 249 | Line 65 | sub version {
65		sub setup {
66		my $self=shift;
67		my $location=shift;
68	<	my $areaname;
69	<	my $symlinks=0;
70	<
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	<	}
262	<
263	<	# -- check arguments and set location
264	<	if ( ! defined $location ) {
265	<	$self->error("ConfigArea: Cannot setup new area without a location");
266	<	}
267	<	if ( @_ ) {
268	<	$areaname=shift;
269	<	}
270	<	if ( @_ ) {
271	<	$symlinks=shift || 0;
272	<	}
68	>	my $areaname=shift  || undef;
69	>	my $symlinks=shift  || 0;
70	>	my $locarea = shift || undef;
71		if ( (! defined $areaname) || ( $areaname eq "" ) ) {
72	<	$areaname=$vers;
72	>	$areaname=$self->version();
73		}
74	<	my $arealoc=$location."/".$areaname;
277	<	my $workloc=$arealoc."/".$self->{admindir};
278	<	$self->verbose("Building at $arealoc");
279	<	$self->location($arealoc);
74	>	$self->location($location."/".$areaname);
75		$self->symlinks($symlinks);
76	<
77	<	# -- create top level structure and work area
78	<	AddDir::adddir($workloc);
79	<
80	<	# -- add a cache
81	<	$self->_newcache();
82	<
83	<	# -- add an Objectstore
84	<	$self->_newobjectstore();
85	<
86	<	# -- Save Environment File
87	<	$self->_SaveEnvFile();
88	<
76	>	if ($self->configchksum() ne "")
77	>	{
78	>	if ((!-defined $locarea) && (-f "${location}/${areaname}/".$self->admindir()."/Environment"))
79	>	{
80	>	$locarea=Configuration::ConfigArea->new($self->arch());
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:".$self->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 309 | Line 108 | sub sourcedir {
108		return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
109		}
110
111	<	sub toolbox {
313	<	my $self=shift;
314	<	if ( ! defined $self->{toolbox} ) {
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 {
111	>	sub releasetop {
112		my $self=shift;
113		if ( @_ ) {
114	<	$self->{reqdoc}=shift;
332	<	}
333	<	if ( defined $self->{reqdoc} ) {
334	<	return $self->location()."/".$self->{reqdoc};
335	<	}
336	<	else {
337	<	return undef;
338	<	}
339	<	}
340	<
341	<	sub scramversion {
342	<	my $self=shift;
343	<	if ( ! defined $self->{scramversion} ) {
344	<	my $filename=$self->location()."/".$self->configurationdir()."/".
345	<	"scram_version";
346	<	if ( -f $filename ) {
347	<	use FileHandle;
348	<	$fh=FileHandle->new();
349	<	open ($fh, "<".$filename);
350	<	my $version=<$fh>;
351	<	chomp $version;
352	<	$self->{scramversion}=$version;
353	<	undef $fh;
354	<	}
114	>	$self->{releasetop}=shift;
115		}
116	<	return $self->{scramversion};
116	>	return (defined $self->{releasetop})?$self->{releasetop}:undef;
117		}
118
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	–
119		sub admindir()
120		{
121		my $self=shift;
#	Line 411 | Line 126 | sub admindir()
126
127		sub bootstrapfromlocation {
128		my $self=shift;
129	<
129	>	my $location = $self->searchlocation(shift);
130		my $rv=0;
131	<
417	<	my $location;
418	<	if ( ! defined ($location=$self->searchlocation(@_)) ) {
131	>	if ( ! defined $location) {
132		$rv=1;
420	–	$self->verbose("Unable to locate the top of local configuration area");
133		}
134		else {
135		$self->location($location);
424	–	$self->verbose("Found top ".$self->location());
136		$self->_LoadEnvFile();
137		}
138		return $rv;
#	Line 432 | Line 143 | sub location {
143
144		if ( @_ ) {
145		$self->{location}=shift;
146	+	$self->archname($self->{archname});
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($self->{archname});
154	+	}
155		}
156		return  $self->{location};
157		}
#	Line 475 | Line 191 | sub archname {
191		my $self=shift;
192		if ( @_ ) {
193		$self->{archname}=shift;
194	+	if (defined $self->{location}) {
195	+	$self->archdir($self->{location}."/".$self->{admindir}."/".$self->{archname});
196	+	}
197		}
198		return $self->{archname};
199		}
#	Line 484 | Line 203 | sub archdir {
203		if ( @_ ) {
204		$self->{archdir}=shift;
205		}
487	–	if ( ! defined $self->{archdir} ) {
488	–	if ( defined $self->{archname} ) {
489	–	$self->{archdir}=$self->location()."/".$self->{admindir}."/".
490	–	$self->{archname};
491	–	}
492	–	else {
493	–	$self->error("ConfigArea : cannot create arch directory - ".
494	–	"architecture name not set")
495	–	}
496	–	}
206		return $self->{archdir};
207		}
208
209		sub satellite {
210		my $self=shift;
211	<
212	<	# -- create the sat object
504	<	my $sat=Configuration::ConfigArea->new();
211	>	my $relloc = $self->location();
212	>	my $sat=Configuration::ConfigArea->new($self->arch());
213		$sat->name($self->name());
214		$sat->version($self->version());
507	–	$sat->requirementsdoc($self->{reqdoc});
215		$sat->configurationdir($self->configurationdir());
216		$sat->sourcedir($self->sourcedir());
217	<	$sat->toolboxversion($self->toolboxversion());
217	>	$sat->releasetop($relloc);
218	>	$sat->configchksum($self->configchksum());
219		$sat->setup(@_);
220	<
221	<	# -- copy across the cache and ObjectStore
222	<	# -- make sure we dont try building new caches in release areas
223	<	my $rcache=$self->cache();
224	<	if ( defined $rcache ) {
225	<	copy($rcache->location(),$sat->cache()->location());
226	<	}
227	<
228	<	# -- make sure we dont try building new objectstores in release areas
229	<	my $rostore=$self->objectstore();
230	<	if ( defined $rostore ) {
231	<	copy($rostore->location(),$sat->objectstore()->location());
232	<	}
233	<
234	<	# and make sure in reinitialises
235	<	undef ($sat->{cache});
236	<
237	<	# -- link it to this area
530	<	$sat->linkarea($self);
531	<
532	<	# -- save it
533	<	$sat->save();
534	<
220	>	$self->copywithskip($self->archdir(),$sat->archdir(),["InstalledTools","ProjectCache.db.gz","RuntimeCache.db.gz","DirCache.db.gz","MakeData/DirCache","MakeData/DirCache.mk","MakeData/src.mk"]);
221	>	$envfile = $sat->archdir()."/Environment";
222	>	open ( $fh, "> $envfile" ) or  $sat->error("Cannot Open \"$envfile\" file to Save\n $!");
223	>	print $fh "RELEASETOP=$relloc\n";
224	>	close($fh);
225	>	my $devconf = $sat->location()."/".$sat->configurationdir();
226	>	my $relconf = $self->location()."/".$self->configurationdir();
227	>	if (!-d $devconf)
228	>	{
229	>	$self->copywithskip($relconf,$devconf,['toolbox']);
230	>	}
231	>	$envfile = $sat->location()."/".$self->{admindir}."/Environment";
232	>	if (! -f $envfile)
233	>	{
234	>	$sat->save ();
235	>	}
236	>	Utilities::AddDir::copydir("${relconf}/toolbox/".$self->arch(),"${devconf}/toolbox/".$sat->arch());
237	>	Utilities::AddDir::adddir ($sat->location()."/".$sat->sourcedir());
238		return $sat;
239		}
240
538	–	sub copy {
539	–	my $self=shift;
540	–	my $destination=shift;
541	–
542	–	# copy across the admin dir
543	–	my $temp=$self->location()."/".$self->{admindir};
544	–	AddDir::copydir($temp,"$destination/".$self->{admindir});
545	–	}
546	–
547	–	sub align {
548	–	my $self=shift;
549	–	use File::Copy;
550	–
551	–	$self->_LoadEnvFile();
552	–	my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
553	–	my $tmpEnvfile=$Envfile.".bak";
554	–	my $rel=$self->{ENV}{RELEASETOP};
555	–	my $local=$self->location();
556	–
557	–	rename( $Envfile, $tmpEnvfile );
558	–	use FileHandle;
559	–	my $fh=FileHandle->new();
560	–	my $fout=FileHandle->new();
561	–	open ( $fh, "<".$tmpEnvfile ) or
562	–	$self->error("Cannot find Environment file. Area Corrupted? ("
563	–	.$self->location().")\n $!");
564	–	open ( $fout, ">".$Envfile ) or
565	–	$self->error("Cannot find Environment file. Area Corrupted? ("
566	–	.$self->location().")\n $!");
567	–	while ( <$fh> ) {
568	–	$_=~s/\Q$rel\L/$local/g;
569	–	print $fout $_;
570	–	}
571	–	undef $fh;
572	–	undef $fout;
573	–	}
574	–
575	–	sub copysetup {
576	–	my $self=shift;
577	–	my $dest=shift;
578	–	my $rv=1;
579	–	# copy across the admin dir
580	–	my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
581	–	my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
582	–	if ( $temp ne $temp2 ) {
583	–	if ( -d $temp ) {
584	–	AddDir::copydir($temp,$temp2);
585	–	$rv=0;
586	–	}
587	–	}
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	–
241		sub copywithskip {
242		my $self=shift;
243	<	my $dest=shift;
244	<	my $filetoskip=shift || [];
243	>	my $src=shift;
244	>	my $des=shift;
245	>	my $filetoskip=shift || [];
246		my $rv=1;
247	<	# copy across the admin dir
248	<	my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
249	<	my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
250	<	if ( $temp ne $temp2 ) {
251	<	if ( -d $temp ) {
252	<	my $fs=[];
253	<	foreach my $f (@$filetoskip) {push @$fs,"${temp}/${f}";}
254	<	AddDir::copydirwithskip($temp,$temp2,$fs);
255	<	$rv=0;
256	<	}
622	<	}
247	>	if ( $src ne $des )
248	>	{
249	>	if ( -d $src )
250	>	{
251	>	my $fs=[];
252	>	foreach my $f (@$filetoskip) {push @$fs,"${src}/${f}";}
253	>	Utilities::AddDir::copydirwithskip($src,$des,$fs);
254	>	$rv=0;
255	>	}
256	>	}
257		return $rv;
258		}
259
#	Line 634 | Line 268 | sub copyenv {
268
269		sub arch {
270		my $self=shift;
271	<	return $ENV{SCRAM_ARCH};
638	<	}
639	<
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);
647	<	$self->linkarea($area);
648	<	}
649	<	else {
650	<	$self->error("ConfigArea : Unable to link to non existing directory ".
651	<	$location);
652	<	}
653	<	}
654	<
655	<	sub unlinkarea {
656	<	my $self=shift;
657	<	undef $self->{linkarea};
658	<	$self->{linkarea}=undef;
659	<	$self->save();
660	<	}
661	<
662	<	sub linkarea {
663	<	my $self=shift;
664	<	my $area=shift;
665	<	if ( defined $area ) {
666	<	$self->{linkarea}=$area;
667	<	}
668	<	return (defined $self->{linkarea} && $self->{linkarea} ne "")?
669	<	$self->{linkarea}:undef;
271	>	return $self->{archname};
272		}
273
274		sub save {
#	Line 674 | Line 276 | sub save {
276		$self->_SaveEnvFile();
277		}
278
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	–
279		# ---- support routines
280
281		sub _SaveEnvFile
282		{
283		my $self=shift;
717	–	my $filemode = 0644;
284
285	<	use FileHandle;
286	<	my $fh=FileHandle->new();
287	<	open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
722	<	"Environment" ) or
723	<	$self->error("Cannot Open Environment file to Save ("
724	<	.$self->location().")\n $!");
285	>	my $fh;
286	>	my $envfile = $self->location()."/".$self->{admindir}."/Environment";
287	>	open ( $fh, "> $envfile" ) or  $self->error("Cannot Open \"$envfile\" file to Save\n $!");
288
289		print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
290		print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
291		print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n";
292		print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n";
293	<	print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
294	<	print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n";
295	<	print $fh "SCRAM_SYMLINKS=",$self->{symlinks},"\n";
293	>	print $fh "SCRAM_SYMLINKS=",$self->symlinks(),"\n";
294	>	print $fh "SCRAM_CONFIGCHKSUM=",$self->configchksum(),"\n";
295	>	close($fh);
296
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	–
297		# Set the default permissions (-rw-r--r--):
298	+	my $filemode = 0644;
299		chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
775	–	chmod $filemode, $self->location()."/".$self->{admindir}."/Environment.xml";
300		}
301
302		sub _LoadEnvFile
303		{
304		my $self=shift;
305
306	<	use FileHandle;
307	<	my $fh=FileHandle->new();
308	<	open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
785	<	"Environment" ) or
786	<	$self->error("Cannot find Environment file. Area Corrupted? ("
787	<	.$self->location().")\n $!");
306	>	my $fh;
307	>	my $envfile = $self->location()."/".$self->{admindir}."/Environment";
308	>	open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!");
309		while ( <$fh> )
310		{
311		chomp;
#	Line 793 | Line 314 | sub _LoadEnvFile
314		($name, $value)=split /=/;
315		eval "\$self->{ENV}{${name}}=\"$value\"";
316		}
317	<	undef $fh;
317	>	close($fh);
318	>	$envfile = $self->archdir()."/Environment";
319	>	if (-f $envfile)
320	>	{
321	>	open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!");
322	>	while ( <$fh> )
323	>	{
324	>	chomp;
325	>	next if /^#/;
326	>	next if /^\s*$/ ;
327	>	($name, $value)=split /=/;
328	>	eval "\$self->{ENV}{${name}}=\"$value\"";
329	>	}
330	>	close($fh);
331	>	}
332
333		# -- set internal variables appropriately
334		if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} )
335		{
336		$self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
337		}
338	+	if ( defined $self->{ENV}{"SCRAM_SYMLINKS"} )
339	+	{
340	+	$self->symlinks($self->{ENV}{"SCRAM_SYMLINKS"});
341	+	}
342	+	if ( defined $self->{ENV}{"SCRAM_CONFIGCHKSUM"} )
343	+	{
344	+	$self->configchksum($self->{ENV}{"SCRAM_CONFIGCHKSUM"});
345	+	}
346		if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} )
347		{
348		$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
#	Line 812 | Line 355 | sub _LoadEnvFile
355		{
356		$self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
357		}
358	<	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()))
358	>	if ( defined $self->{ENV}{"RELEASETOP"} )
359		{
360	<	$self->linkto($self->{ENV}{"RELEASETOP"});
360	>	$self->releasetop($self->{ENV}{"RELEASETOP"});
361		}
362		}
363	+	1;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines