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.13.2.6 by williamc, Tue May 16 14:03:02 2000 UTC vs.
Revision 1.13.2.6.2.7.2.3 by williamc, Thu Sep 21 15:22:43 2000 UTC

#	Line 7 | Line 7
7		# -----------
8		# creates and manages a configuration area
9		#
10	<	# Options
10	>	# Notes
11		# -------
12	<	# ConfigArea_location
13	<	# ConfigArea_name
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
#	Line 22 | Line 25
25		# requirementsdoc()             : get set the requirements doc
26		# searchlocation([startdir])    : returns the location directory. search starts
27		#                                 from cwd if not specified
25	–	# defaultdirname()              : return the default directory name string
28		# scramversion()                : return the scram version associated with
29		#                                 area
30		# configurationdir()            : return the location of the project
#	Line 32 | Line 34
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
48		package Configuration::ConfigArea;
49		require 5.004;
50	+	use URL::URLcache;
51		use Utilities::AddDir;
52		use Utilities::Verbose;
53	+	use ObjectUtilities::ObjectStore;
54		use Cwd;
55		@ISA=qw(Utilities::Verbose);
56
#	Line 49 | Line 61 | sub new {
61
62		# data init
63		$self->{admindir}=".SCRAM";
64	+	$self->{cachedir}="cache";
65	+	$self->{dbdir}="ObjectDB";
66	+	undef $self->{linkarea};
67
68		return $self;
69		}
70
71	+	sub cache {
72	+	my $self=shift;
73	+
74	+	if ( @_ ) {
75	+	$self->{cache}=shift;
76	+	}
77	+	if ( ! defined $self->{cache} ) {
78	+	my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
79	+	if ( -e $loc  ) {
80	+	$self->{cache}=URL::URLcache->new($loc);
81	+	}
82	+	else {
83	+	$self->{cache}=undef;
84	+	}
85	+	}
86	+	return $self->{cache};
87	+	}
88	+
89	+	sub _newcache {
90	+	my $self=shift;
91	+	my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
92	+	$self->{cache}=URL::URLcache->new($loc);
93	+	return $self->{cache};
94	+	}
95	+
96	+	sub _newobjectstore {
97	+	my $self=shift;
98	+	my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
99	+	$self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
100	+	return $self->{dbstore};
101	+	}
102	+
103	+	sub objectstore {
104	+	my $self=shift;
105	+
106	+	if ( @_ ) {
107	+	$self->{dbstore}=shift;
108	+	}
109	+	if ( ! defined $self->{dbstore} ) {
110	+	my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
111	+	if ( -e $loc ) {
112	+	$self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
113	+	}
114	+	else {
115	+	$self->{dbstore}=undef;
116	+	}
117	+	}
118	+	return $self->{dbstore}
119	+	}
120	+
121	+	sub name {
122	+	my $self=shift;
123	+	@_?$self->{name}=shift
124	+	:$self->{name};
125	+	}
126	+
127	+	sub version {
128	+	my $self=shift;
129	+	@_?$self->{version}=shift
130	+	:$self->{version};
131	+	}
132	+
133	+	sub setup {
134	+	my $self=shift;
135	+	my $location=shift;
136	+	my $areaname;
137	+
138	+	# -- check we have a project name and version
139	+	my $name=$self->name();
140	+	my $vers=$self->version();
141	+	if ( ( ! defined $name ) && ( ! defined $version )) {
142	+	$self->error("Set ConfigArea name and version before setup");
143	+	}
144	+
145	+	# -- check arguments and set location
146	+	if ( ! defined $location ) {
147	+	$self->error("ConfigArea: Cannot setup new area without a location");
148	+	}
149	+	if ( @_ ) {
150	+	$areaname=shift;
151	+	}
152	+	if ( (! defined $areaname) || ( $areaname eq "" ) ) {
153	+	# -- make up a name from the project name and version
154	+	$vers=~s/^$name\_//;
155	+	$areaname=$name."_".$vers;
156	+	}
157	+	my $arealoc=$location."/".$areaname;
158	+	my $workloc=$arealoc."/".$self->{admindir};
159	+	$self->verbose("Building at $arealoc");
160	+	$self->location($arealoc);
161	+
162	+	# -- create top level structure and work area
163	+	AddDir::adddir($workloc);
164	+
165	+	# -- add a cache
166	+	$self->_newcache();
167	+
168	+	# -- add an Objectstore
169	+	$self->_newobjectstore();
170	+
171	+	# -- Save Environment File
172	+	$self->_SaveEnvFile();
173	+
174	+	}
175	+
176		sub configurationdir {
177		my $self=shift;
178		if ( @_ ) {
179		$self->{configurationdir}=shift;
180		}
181	<	if ( ! defined $self->{configurationdir} ) {
62	<	$self->_LoadEnvFile();
63	<	$self->{configurationdir}=$self->{ENV}{projconfigdir};
64	<	}
65	<	return $self->{configurationdir};
181	>	return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
182		}
183
184		sub toolbox {
#	Line 78 | Line 194 | sub requirementsdoc {
194		if ( @_ ) {
195		$self->{reqdoc}=shift;
196		}
197	<	if ( ! defined $self->{reqdoc} ) {
198	<	$self->_LoadEnvFile();
199	<	$self->{reqdoc}=$self->{ENV}{SCRAM_ProjReqsDoc};
197	>	if ( defined $self->{reqdoc} ) {
198	>	return $self->location()."/".$self->{reqdoc};
199	>	}
200	>	else {
201	>	return undef;
202		}
85	–	return $self->{reqdoc};
203		}
204
205		sub scramversion {
#	Line 166 | Line 283 | sub searchlocation {
283		return $rv?$thispath:undef;
284		}
285
286	+	sub archname {
287	+	my $self=shift;
288	+	if ( @_ ) {
289	+	$self->{archname}=shift;
290	+	}
291	+	return $self->{archname};
292	+	}
293	+
294	+	sub archdir {
295	+	my $self=shift;
296	+	if ( @_ ) {
297	+	$self->{archdir}=shift;
298	+	}
299	+	if ( ! defined $self->{archdir} ) {
300	+	if ( defined $self->{archname} ) {
301	+	$self->{archdir}=$self->location()."/".$self->{admindir}."/".
302	+	$self->{archname};
303	+	}
304	+	else {
305	+	$self->error("ConfigArea : cannot create arch directory - ".
306	+	"architecture name not set")
307	+	}
308	+	}
309	+	return $self->{archdir};
310	+	}
311	+
312	+	sub satellite {
313	+	my $self=shift;
314	+
315	+	# -- create the sat object
316	+	my $sat=Configuration::ConfigArea->new();
317	+	$sat->name($self->name());
318	+	$sat->version($self->version());
319	+	$sat->requirementsdoc($self->{reqdoc});
320	+	$sat->configurationdir($self->configurationdir());
321	+	$sat->setup(@_);
322	+
323	+	# -- copy across the cache and ObjectStore
324	+	# -- make sure we dont try building new caches in release areas
325	+	my $rcache=$self->cache();
326	+	if ( defined $rcache ) {
327	+	copy($rcache->location(),$sat->cache()->location());
328	+	}
329	+
330	+	# -- make sure we dont try building new objectstores in release areas
331	+	my $rostore=$self->objectstore();
332	+	if ( defined $rostore ) {
333	+	copy($rostore->location(),$sat->objectstore()->location());
334	+	}
335	+
336	+	# and make sure in reinitialises
337	+	undef ($sat->{cache});
338	+
339	+	# -- link it to this area
340	+	$sat->linkarea($self);
341	+
342	+	# -- save it
343	+	$sat->save();
344	+
345	+	return $sat;
346	+	}
347	+
348		sub copy {
349		my $self=shift;
350		my $destination=shift;
#	Line 234 | Line 413 | sub arch {
413		return $ENV{SCRAM_ARCH};
414		}
415
416	+	sub linkto {
417	+	my $self=shift;
418	+	my $location=shift;
419	+	if ( -d $location ) {
420	+	my $area=Configuration::ConfigArea->new();
421	+	$area->bootstrapfromlocation($location);
422	+	$self->linkarea($area);
423	+	}
424	+	else {
425	+	$self->error("ConfigArea : Unable to link to non existing directory ".
426	+	$location);
427	+	}
428	+	}
429	+
430	+	sub unlinkarea {
431	+	my $self=shift;
432	+	undef $self->{linkarea};
433	+	$self->{linkarea}=undef;
434	+	$self->save();
435	+	}
436	+
437	+	sub linkarea {
438	+	my $self=shift;
439	+	my $area=shift;
440	+	if ( defined $area ) {
441	+	$self->{linkarea}=$area;
442	+	}
443	+	return (defined $self->{linkarea} && $self->{linkarea} ne "")?
444	+	$self->{linkarea}:undef;
445	+	}
446	+
447	+	sub save {
448	+	my $self=shift;
449	+	$self->_SaveEnvFile();
450	+	}
451	+
452		# ---- support routines
453	+
454	+	sub _SaveEnvFile {
455	+	my $self=shift;
456	+	use FileHandle;
457	+	my $fh=FileHandle->new();
458	+	open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
459	+	"Environment" ) or
460	+	$self->error("Cannot Open Environment file to Save ("
461	+	.$self->location().")\n $!");
462	+
463	+	print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
464	+	print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
465	+	print $fh "projconfigdir=".$self->configurationdir()."\n";
466	+	print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
467	+	if ( defined $self->linkarea() ) {
468	+	my $area=$self->linkarea()->location();
469	+	if ( $area ne "" ) {
470	+	print $fh "RELEASETOP=".$area."\n";
471	+	}
472	+	}
473	+	undef $fh;
474	+	}
475	+
476	+
477		sub _LoadEnvFile {
478		my $self=shift;
479
#	Line 252 | Line 491 | sub _LoadEnvFile {
491		eval "\$self->{ENV}{${name}}=\"$value\"";
492		}
493		undef $fh;
494	+
495	+	# -- set internal variables appropriately
496	+	if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
497	+	$self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
498	+	}
499	+	if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
500	+	$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
501	+	}
502	+	if ( defined $self->{ENV}{"projconfigdir"} ) {
503	+	$self->configurationdir($self->{ENV}{projconfigdir});
504	+	}
505	+	if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
506	+	$self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
507	+	}
508	+	if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
509	+	($self->{ENV}{"RELEASETOP"} ne $self->location())) {
510	+	$self->linkto($self->{ENV}{"RELEASETOP"});
511	+	}
512	+	else {
513	+	$self->{ENV}{"RELEASETOP"}=$self->location();
514	+	}
515		}

Diff Legend

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