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.5 by williamc, Mon Jan 24 17:22:45 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;
#	Line 37 | Line 64 | sub init {
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");
58	<	my $vers=$self->version;
129	>	my $name=$self->option("ConfigArea_name");
130		if ( ! defined $name ) {
131	<	$name=$self->name();
61	<	$vers=~s/^$name_//;
62	<	$name=$name."_".$vers;
131	>	$name=$self->defaultdirname();
132		}
133		$self->location($location."/".$name);
134
#	Line 67 | Line 136 | sub setup {
136		$self->_setupstore();
137
138		# --- download everything first
70	–	# FIX-ME --- cacheing is broken
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()."/.SCRAM/ConfigArea.dat");
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 ActiveStore at the location and add it to the db list
168	<	my $ad=ActiveDoc::ActiveConfig->new($self->location()."/\.SCRAM");
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());
#	Line 102 | Line 183 | sub bootstrapfromlocation {
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	<	$self->restore($self->location()."/.SCRAM/ConfigArea.dat");
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 {
#	Line 122 | Line 210 | sub store {
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 {
#	Line 139 | Line 264 | sub restore {
264		$self->name($$varhash{"name"});
265		$self->version($$varhash{"version"});
266		$fh->close();
267	+
268	+	$self->_restorestructures();
269		}
270
271		sub name {
#	Line 159 | Line 286 | sub location {
286		my $self=shift;
287
288		if ( @_ ) {
289	<	$self->{location}=shift
289	>	$self->{location}=shift;
290		}
291		elsif ( ! defined $self->{location} ) {
292		# try and find the release location
293	<	$self->searchlocation();
293	>	$self->{location}=$self->searchlocation();
294		}
295		return  $self->{location};
296		}
297
298		sub searchlocation {
299		my $self=shift;
173	–	use Cwd;
300
301		#start search in current directory if not specified
302		my $thispath;
303		@_?$thispath=shift
304	<	:$thispath=cwd;
304	>	:$thispath=cwd();
305
306		my $rv=0;
307
308	<	do {
309	<	if ( -e "$thispath/.SCRAM" ) {
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/ )=~/./  );
316	>	} while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
317
318		return $rv?$thispath:undef;
319		}
#	Line 208 | Line 338 | sub addconfigitem {
338		my $docref=$self->activatedoc($url);
339		# Set up the document
340		$docref->setup();
341	+	$docref->save();
342		#       $self->config()->storepolicy("local");
212	–	$docref->save();
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 237 | 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 249 | 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