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.1 by williamc, Thu Jan 20 18:21:54 2000 UTC vs.
Revision 1.13 by williamc, Mon Mar 13 10:23:19 2000 UTC

#	Line 4 | Line 4
4		# Originally Written by Christopher Williams
5		#
6		# Description
7	+	# -----------
8	+	# creates and manages a configuration area
9	+	#
10	+	# Options
11	+	# -------
12	+	# ConfigArea_location
13	+	# ConfigArea_name
14		#
15		# Interface
16		# ---------
#	Line 16 | Line 23
23		# restore(location)             : restore data from file location
24		# meta()                        : return a description string of the area
25		# addconfigitem(url)            : add a new item to the area
26	+	# storeconfigobject(confiItemobj) : store a ready made ConfigItem in the local
27	+	#                                       area
28		# configitem(@keys)             : return a list of fig items that match
29		#                                 the keys - all if left blank
30	+	# parentstore()                 : set/return the parent ObjectStore
31	+	# basearea(ConfigArea)          : Set/Get the base area
32	+	# freebase()                    : Remove any link to a base area
33	+	# bootstrapfromlocation([location]): bootstrap the object based on location.
34	+	#                                 no location specified - cwd used
35	+	# searchlocation([startdir])    : returns the location directory. search starts
36	+	#                                 from cwd if not specified
37	+	# defaultdirname()              : return the default directory name string
38	+	# copy(location)                : make a copy of the current area at the
39	+	#                                 specified location - defaults to cwd/default
40	+	#                                 if not specified . ConfigArea_name,
41	+	#                                 ConfigArea_location also override .
42	+	#                                 Return an object representing the area
43	+	# satellite()                   : make a satellite area based on $self
44	+	# arch([archobj])               : Set/get the architecture object
45	+	# structure(name)               : return the object corresponding to the
46	+	#                                 structure name
47	+	# structurelist()               : return list of structure objectS
48	+	# downloadtotop(dir,url)        : download the url to a dir in the config area
49	+	#
50
51		package Configuration::ConfigArea;
52		use ActiveDoc::ActiveDoc;
53		require 5.004;
54		use Utilities::AddDir;
55		use ObjectUtilities::ObjectStore;
56	<	@ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
56	>	use Configuration::ConfigStore;
57	>	use Configuration::ActiveDoc_arch;
58	>	use Cwd;
59	>	@ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
60
61		sub init {
62		my $self=shift;
63	+
64		$self->newparse("init");
65		$self->newparse("download");
66		$self->newparse("setup");
67	+	$self->newparse("setup_tools");
68	+	$self->addarchtags("setup_tools");
69	+	$self->addarchtags("setup");
70		$self->addtag("init","project",\&Project_Start,$self,
71	<	\&Project_text,$self,"", $self );
71	>	\&Project_text,$self,"", $self );
72		$self->addurltags("download");
73	+	$self->addtag("download","download",\&Download_Start,$self,
74	+	"", $self, "",$self);
75		$self->addtag("download","use",\&Use_download_Start,$self,
76		"", $self, "",$self);
77		$self->addurltags("setup");
78	<	$self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);
78	>	$self->addurltags("setup_tools");
79	>	$self->addtag("setup_tools","use",\&Use_Start,$self, "", $self, "",$self);
80	>	$self->addtag("setup","structure",\&Structure_Start,$self,
81	>	"", $self, "",$self);
82	>
83	>	# data init
84	>	$self->{admindir}=".SCRAM";
85	>	}
86	>
87	>	sub basearea {
88	>	my $self=shift;
89	>
90	>	my $area;
91	>	if ( @_ ) {
92	>	$area=shift;
93	>	$self->config()->store($area,"BaseArea");
94	>	}
95	>	else {
96	>	($area)=$self->config()->find("BaseArea");
97	>	}
98	>	return $area;
99		}
100
101	+	sub freebase {
102	+	my $self=shift;
103	+	$self->config()->delete("BaseArea");
104	+	}
105	+
106	+	sub defaultdirname {
107	+	my $self=shift;
108	+	my $name=$self->name();
109	+	my $vers=$self->version();
110	+	$vers=~s/^$name\_//;
111	+	$name=$name."_".$vers;
112	+	return $name;
113	+	}
114	+
115	+
116		sub setup {
117		my $self=shift;
118
119	<	# --- find out the location
120	<	my $location=$self->requestoption("area_location",
121	<	"Please Enter the location of the directory");
119	>	# --- find out the location - default is cwd
120	>	my $location=$self->option("ConfigArea_location");
121	>	if ( ! defined $location ) {
122	>	$location=cwd();
123	>	}
124	>	elsif ( $location!~/^\// ) {
125	>	$location=cwd()."/".$location;
126	>	}
127
128		# --- find area directory name , default name projectname_version
129	<	my $name=$self->option("area_name");
52	<	my $vers=$self->version;
129	>	my $name=$self->option("ConfigArea_name");
130		if ( ! defined $name ) {
131	<	$name=$self->name();
55	<	$vers=~s/^$name_//;
56	<	$name=$name."_".$vers;
131	>	$name=$self->defaultdirname();
132		}
133		$self->location($location."/".$name);
134
60	–	# --- make a new ActiveStore at the location and add it to the db list
61	–	my $ad=ActiveDoc::ActiveConfig->new($self->location()."/\.SCRAM");
62	–
135		# make a new store handler
136	<	my $parentconfig=$self->config;
65	<	$self->config(Configuration::ConfigureStore);
66	<	$self->config()->db("local",$ad);
67	<	$self->config()->db("parent",$parentconfig);
68	<	$self->config()->policy("cache","local");
69	<	$self->config()->basedoc($parentconfig->basedoc());
136	>	$self->_setupstore();
137
138		# --- download everything first
139	<	# FIX-ME --- cacheing is broken
73	<	#       $self->parse("download");
139	>	$self->parse("download");
140
141		# --- and parse the setup file
142		$self->parse("setup");
143	+	$self->parse("setup_tools");
144	+
145	+	# --- store bootstrap info
146	+	$self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
147	+
148	+	# --- store self in original database
149	+	$self->parentconfig()->store($self,"ConfigArea",$self->name(),
150	+	$self->version());
151	+	}
152	+
153	+	sub structure {
154	+	my $self=shift;
155	+	my $vr=shift;
156	+	return $self->{structures}{$vr};
157	+	}
158	+
159	+	sub structurelist {
160	+	my $self=shift;
161	+	return ( keys %{$self->{structures}} );
162	+	}
163	+
164	+	sub _setupstore {
165	+	my $self=shift;
166	+
167	+	# --- make a new ConfigStore at the location and add it to the db list
168	+	my $ad=Configuration::ConfigStore->new($self->location().
169	+	"/".$self->{admindir}, $self->arch());
170	+
171	+	$self->parentconfig($self->config());
172	+	#        $self->config(Configuration::ConfigureStore->new());
173	+	#        $self->config()->db("local",$ad);
174	+	#        $self->config()->db("parent",$self->parentconfig());
175	+	#        $self->config()->policy("cache","local");
176	+	$self->config($ad);
177	+	$self->config()->basedoc($self->parentconfig()->basedoc());
178	+	}
179	+
180	+	sub bootstrapfromlocation {
181	+	my $self=shift;
182	+
183	+	if ( ! defined $self->location(@_) ) {
184	+	$self->error("Unable to locate the top of local configuration area");
185	+	}
186	+	$self->verbose("Found top ".$self->location());
187	+	$self->_setupstore();
188	+	my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
189	+	if ( -e $infofile ) {
190	+	$self->restore($infofile);
191	+	}
192	+	else {
193	+	$self->error("Area corrupted - cannot find $infofile");
194	+	}
195	+	}
196	+
197	+	sub parentconfig {
198	+	my $self=shift;
199	+	@_?$self->{parentconfig}=shift
200	+	:$self->{parentconfig};
201		}
202
203		sub store {
#	Line 81 | Line 205 | sub store {
205		my $location=shift;
206
207		my $fh=$self->openfile(">".$location);
208	<	print $fh $self->location()."\n";
208	>	$self->savevar($fh,"location", $self->location());
209	>	$self->savevar($fh,"url", $self->url());
210	>	$self->savevar($fh,"name", $self->name());
211	>	$self->savevar($fh,"version", $self->version());
212		$fh->close();
213	+
214	+	$self->_storestructures();
215	+	}
216	+
217	+	sub satellite {
218	+	my $self=shift;
219	+	my $newarea=$self->copy(@_);
220	+	$newarea->_makesatellites();
221	+	return $newarea;
222	+	}
223	+
224	+	sub copy {
225	+	my $self=shift;
226	+	use File::Basename;
227	+	# create the area
228	+
229	+	my $destination;
230	+	if ( @_ ) {
231	+	$destination=shift;
232	+	}
233	+	else {
234	+	my($location,$name)=$self->_defaultoptions();
235	+	$destination=$location."/".$name
236	+	}
237	+	#AddDir::adddir(dirname($destination)."/".$self->{admindir});
238	+	#AddDir::adddir($destination."/".$self->{admindir});
239	+
240	+	# copy across the admin dir
241	+	$temp=$self->location()."/".$self->{admindir};
242	+	AddDir::copydir($temp,"$destination/".$self->{admindir});
243	+	# create a new object based on the new area
244	+	my $newarea=ref($self)->new($self->parentconfig());
245	+	$newarea->bootstrapfromlocation($destination);
246	+	# save it with the new location info
247	+	$newarea->store($self->location()."/".$self->{admindir}.
248	+	"/ConfigArea.dat");
249	+	return $newarea;
250		}
251
252		sub restore {
253		my $self=shift;
254	+	my $location=shift;
255
256		my $fh=$self->openfile("<".$location);
257	<	$self->{location}=<$fh>;
258	<	chomp $self->{location};
257	>	my $varhash={};
258	>	$self->restorevars($fh,$varhash);
259	>	if ( ! defined $self->location() ) {
260	>	$self->location($$varhash{"location"});
261	>	}
262	>	$self->_setupstore();
263	>	$self->url($$varhash{"url"});
264	>	$self->name($$varhash{"name"});
265	>	$self->version($$varhash{"version"});
266		$fh->close();
267
268	+	$self->_restorestructures();
269		}
270
271		sub name {
#	Line 112 | Line 285 | sub version {
285		sub location {
286		my $self=shift;
287
288	<	@_?$self->{location}=shift
289	<	:$self->{location};
288	>	if ( @_ ) {
289	>	$self->{location}=shift;
290	>	}
291	>	elsif ( ! defined $self->{location} ) {
292	>	# try and find the release location
293	>	$self->{location}=$self->searchlocation();
294	>	}
295	>	return  $self->{location};
296	>	}
297	>
298	>	sub searchlocation {
299	>	my $self=shift;
300	>
301	>	#start search in current directory if not specified
302	>	my $thispath;
303	>	@_?$thispath=shift
304	>	:$thispath=cwd();
305	>
306	>	my $rv=0;
307	>
308	>	Sloop:{
309	>	do {
310	>	#         print "Searching $thispath\n";
311	>	if ( -e "$thispath/".$self->{admindir} ) {
312	>	#           print "Found\n";
313	>	$rv=1;
314	>	last Sloop;
315	>	}
316	>	} while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
317	>
318	>	return $rv?$thispath:undef;
319		}
320
321		sub meta {
#	Line 125 | Line 327 | sub meta {
327
328		sub configitem {
329		my $self=shift;
128	–	my $location=shift;
330
331	<	$self->config()->find("ConfigItem",@_);
331	>	return ($self->config()->find("ConfigItem",@_));
332		}
333
334		sub addconfigitem {
#	Line 137 | Line 338 | sub addconfigitem {
338		my $docref=$self->activatedoc($url);
339		# Set up the document
340		$docref->setup();
341	<	$self->config()->savepolicy("local");
342	<	$docref->save();
341	>	$docref->save();
342	>	#       $self->config()->storepolicy("local");
343	>	}
344	>
345	>	sub storeconfigobject {
346	>	my $self=shift;
347	>	my $obj=shift;
348	>	$obj->save($self->config());
349	>	}
350	>
351	>	sub downloadtotop {
352	>	my $self=shift;
353	>	my $url=shift;
354	>	my $dir=shift;
355	>
356	>	# only download once
357	>	if ( ! -e $self->location()."/".$dir ) {
358	>	$self->{urlhandler}->download($url,$self->location()."/".$dir);
359	>	}
360	>	}
361	>
362	>	sub _makesatellites {
363	>	my $self=shift;
364	>	foreach $st ( values %{$self->{structures}} ) {
365	>	$st->setupsatellite()
366	>	}
367	>	}
368	>
369	>	sub _storestructures {
370	>	my $self=shift;
371	>	foreach $struct ( values %{$self->{structures}} ) {
372	>	$self->config()->store($struct, "Structures", $struct->name());
373	>	}
374		}
375
376	+	sub _restorestructures {
377	+	my $self=shift;
378	+	my @strs=$self->config()->find("Structures");
379	+	foreach $struct ( @strs ) {
380	+	$struct->parent($self);
381	+	$self->{structures}{$struct->name()}=$struct;
382	+	}
383	+	}
384	+
385	+	sub _defaultoptions {
386	+	my $self=shift;
387	+	my $name;
388	+	my $location;
389	+
390	+	# --- find out the location - default is cwd
391	+	$location=$self->option("ConfigArea_location");
392	+	if ( ! defined $location ) {
393	+	$location=cwd();
394	+	}
395	+	elsif ( $location!~/^\// ) {
396	+	$location=cwd()."/".$location;
397	+	}
398	+
399	+	# --- find area directory name , default name projectname_version
400	+	$name=$self->option("ConfigArea_name");
401	+	if ( ! defined $name ) {
402	+	$name=$self->defaultdirname();
403	+	}
404	+	return ($location,$name);
405	+	}
406		# -------------- Tags ---------------------------------
407		# -- init parse
408		sub Project_Start {
#	Line 166 | Line 428 | sub Project_text {
428
429		# ---- download parse
430
431	+	sub Download_Start {
432	+	my $self=shift;
433	+	my $name=shift;
434	+	my $hashref=shift;
435	+
436	+	$self->checktag($name,$hashref,'url');
437	+	$self->checktag($name,$hashref,'location');
438	+	if ( $$hashref{'location'}!~/^\w/ ) {
439	+	$self->parseerror("location must start with an".
440	+	" alphanumeric character");
441	+	}
442	+	print "Downloading .... ".$$hashref{'url'}."\n";
443	+	$self->downloadtotop($$hashref{'url'},$$hashref{'location'});
444	+	}
445	+
446		sub Use_download_Start {
447		my $self=shift;
448		my $name=shift;
#	Line 178 | Line 455 | sub Use_download_Start {
455
456		# --- setup parse
457
458	+	sub Structure_Start {
459	+	my $self=shift;
460	+	my $name=shift;
461	+	my $hashref=shift;
462	+
463	+	$self->checktag($name,$hashref,'name');
464	+	if ( !(( exists $$hashref{'type'}) || ( exists $$hashref{'url'})) ) {
465	+	$self->parseerror("No url or type given in <$name> tag");
466	+	}
467	+	if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
468	+	if ( exists $$hashref{'type'}) {
469	+	# create a new object of the specified type
470	+	eval "require $$hashref{'type'} ";
471	+	if  ( $@ ) {
472	+	$self->parseerror("Unable to instantiate type=".
473	+	$$hashref{'type'}." in <$name> .".$@);
474	+	}
475	+	$self->{structures}{$$hashref{'name'}}=
476	+	$$hashref{'type'}->new($self->config());
477	+	$self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
478	+	$self->{structures}{$$hashref{'name'}}->parent($self);
479	+	$self->{structures}{$$hashref{'name'}}->vars($hashref);
480	+	$self->{structures}{$$hashref{'name'}}->arch($self->arch());
481	+	}
482	+	else { # its an activedoc
483	+	$self->{structures}{$$hashref{'name'}}=
484	+	$self->activatedoc($$hashref{'url'});
485	+	}
486	+	$self->{structures}{$$hashref{'name'}}->setupbase();
487	+	}
488	+	else {
489	+	$self->parseerror("Multiply defined Structure - ".
490	+	$$hashref{'name'});
491	+	}
492	+	}
493	+
494		sub Use_Start {
495		my $self=shift;
496		my $name=shift;

Diff Legend

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