src/Configuration/ConfigArea.pm

#
# ConfigArea.pm
#
# Originally Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new(ActiveConfig)             : A new ConfigArea object
# setup()                       : setup the configuration area
# location([dir])               : set/return the location of the area
# version([version])            : set/return the version of the area
# name([name])                  : set/return the name of the area
# store(location)               : store data in file location
# restore(location)             : restore data from file location
# meta()                        : return a description string of the area
# addconfigitem(url)            : add a new item to the area
# configitem(@keys)             : return a list of fig items that match
#                                 the keys - all if left blank
# parentstore()                 : set/return the parent ObjectStore
# bootstrapfromlocation([location]): bootstrap the object based on location.
#                                 no location specified - cwd used
# searchlocation([startdir])    : returns the location directory. search starts
#                                 from cwd if not specified
# defaultdirname()              : return the default directory name string
# copy(location)                : make a copy of the current area at the 
#                                 specified location - return an object
#                                 representing the area

package Configuration::ConfigArea;
use ActiveDoc::ActiveDoc;
require 5.004;
use Utilities::AddDir;
use ObjectUtilities::ObjectStore;
use Configuration::ConfigStore;
use Cwd;
@ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);

sub init {
        my $self=shift;

        $self->newparse("init");
        $self->newparse("download");
        $self->newparse("setup");
        $self->addtag("init","project",\&Project_Start,$self,
            \&Project_text,$self,"", $self );
        $self->addurltags("download");
        $self->addtag("download","use",\&Use_download_Start,$self, 
                                                "", $self, "",$self);
        $self->addurltags("setup");
        $self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);

        # data init
        $self->{admindir}=".SCRAM";
}


sub defaultdirname {
        my $self=shift;
        my $name=$self->name();
        my $vers=$self->version();
        $vers=~s/^$name_//;
        $name=$name."_".$vers;
        return $name;

}

sub setup {
        my $self=shift;

        # --- find out the location - default is cwd
        my $location=$self->option("area_location");
        if ( ! defined $location ) {
                $location=cwd();
        }
        elsif ( $location!~/^\// ) {
                $location=cwd()."/".$location;
        }

        # --- find area directory name , default name projectname_version
        my $name=$self->option("area_name");
        if ( ! defined $name ) {
          $name=$self->defaultdirname();
        }
        $self->location($location."/".$name);

        # make a new store handler
        $self->_setupstore();

        # --- download everything first
# FIX-ME --- cacheing is broken
        $self->parse("download");
        
        # --- and parse the setup file
        $self->parse("setup");
        
        # --- store bootstrap info 
        $self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");

        # --- store self in original database
        $self->parentconfig()->store($self,"ConfigArea",$self->name(),
                                                        $self->version());
}

sub _setupstore {
        my $self=shift;

        # --- make a new ConfigStore at the location and add it to the db list
        my $ad=Configuration::ConfigStore->new($self->location().
                                "/".$self->{admindir});

        $self->parentconfig($self->config());
#        $self->config(Configuration::ConfigureStore->new());
#        $self->config()->db("local",$ad);
#        $self->config()->db("parent",$self->parentconfig());
#        $self->config()->policy("cache","local");
        $self->config($ad);
        $self->config()->basedoc($self->parentconfig()->basedoc());
}

sub bootstrapfromlocation {
        my $self=shift;
        
        if ( ! defined $self->location(@_) ) {
          $self->error("Unable to locate the top of local configuration area");
        }
        print "Found top ".$self->location()."\n";
        $self->_setupstore();
        $self->restore($self->location()."/".$self->{admindir}.
                                                "/ConfigArea.dat");
}

sub parentconfig {
        my $self=shift;
        @_?$self->{parentconfig}=shift
          :$self->{parentconfig};
}

sub store {
        my $self=shift;
        my $location=shift;

        my $fh=$self->openfile(">".$location);
        $self->savevar($fh,"location", $self->location());
        $self->savevar($fh,"url", $self->url());
        $self->savevar($fh,"name", $self->name());
        $self->savevar($fh,"version", $self->version());
        $fh->close();
}

sub copy {
        my $self=shift;
        my $destination=shift;
        use File::Basename;
        # create the area

        AddDir::adddir(dirname($destination));
        
        $temp=$self->location();
        my @cpcmd=(qw(cp -r), "$temp", "$destination");
        print "@cpcmd"."\n";
#       File::Copy::copy("$self->location()", "$destination") or 
        system(@cpcmd) == 0 or
                        $self->error("Cannot copy ".$self->location().
                        " to $destination ".$!);

        # create a new object based on the new area
        my $newarea=ref($self)->new($self->parentconfig());
        $newarea->bootstrapfromlocation($destination);
        # save it with the new location info
        $newarea->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
}

sub restore {
        my $self=shift;
        my $location=shift;

        my $fh=$self->openfile("<".$location);
        my $varhash={};
        $self->restorevars($fh,$varhash);
        if ( ! defined $self->location() ) {
          $self->location($$varhash{"location"});
        }
        $self->_setupstore();
        $self->url($$varhash{"url"});
        $self->name($$varhash{"name"});
        $self->version($$varhash{"version"});
        $fh->close();
}

sub name {
        my $self=shift;

        @_?$self->{name}=shift
          :$self->{name};
}

sub version {
        my $self=shift;

        @_?$self->{version}=shift
          :$self->{version};
}

sub location {
        my $self=shift;

        if ( @_ ) {
          $self->{location}=shift;
        }
        elsif ( ! defined $self->{location} ) {
          # try and find the release location
          #$self->{location}=$self->searchlocation();
        }
        return  $self->{location};
}

sub searchlocation {
        my $self=shift;

        #start search in current directory if not specified
        my $thispath;
        @_?$thispath=shift
          :$thispath=cwd();
 
        my $rv=0;

        Sloop:{
        do {
#         print "Searching $thispath\n";
          if ( -e "$thispath/".$self->{admindir} ) {
#           print "Found\n";
            $rv=1;
            last Sloop;
          }
        } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };

        return $rv?$thispath:undef;
}

sub meta {
        my $self=shift;

        my $string=$self->name()." ".$self->version()." located at :\n  ".
                $self->location;
}

sub configitem {
        my $self=shift;
        
        return ($self->config()->find("ConfigItem",@_));
}

sub addconfigitem {
        my $self=shift;
        my $url=shift;

        my $docref=$self->activatedoc($url);
        # Set up the document
        $docref->setup();
        $docref->save();
#       $self->config()->storepolicy("local");
}

# -------------- Tags ---------------------------------
# -- init parse
sub Project_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->checktag($name,$hashref,'name');
        $self->checktag($name,$hashref,'version');

        $self->name($$hashref{'name'});
        $self->version($$hashref{'version'});
}


sub Project_text {
        my $self=shift;
        my $name=shift;
        my $string=shift;

        print $string;
}

# ---- download parse

sub Use_download_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->checktag($name,$hashref,'url');
        print "Downloading .... ".$$hashref{'url'}."\n";
        $self->getfile($$hashref{'url'});
}

# --- setup parse

sub Use_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;
        
        $self->checktag($name,$hashref,'url');
        $self->addconfigitem($$hashref{'url'});
}

Revision:	1.8
Committed:	Thu Feb 10 10:59:44 2000 UTC (25 years, 3 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.7:	+20 -14 lines
Log Message:	Add architecture specifics
#	User	Rev	Content
1	williamc	1.1	#
2			# ConfigArea.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			#
8			# Interface
9			# ---------
10			# new(ActiveConfig) : A new ConfigArea object
11			# setup() : setup the configuration area
12			# location([dir]) : set/return the location of the area
13			# version([version]) : set/return the version of the area
14			# name([name]) : set/return the name of the area
15			# store(location) : store data in file location
16			# restore(location) : restore data from file location
17			# meta() : return a description string of the area
18			# addconfigitem(url) : add a new item to the area
19			# configitem(@keys) : return a list of fig items that match
20			# the keys - all if left blank
21	williamc	1.4	# parentstore() : set/return the parent ObjectStore
22	williamc	1.5	# bootstrapfromlocation([location]): bootstrap the object based on location.
23			# no location specified - cwd used
24			# searchlocation([startdir]) : returns the location directory. search starts
25			# from cwd if not specified
26	williamc	1.6	# defaultdirname() : return the default directory name string
27			# copy(location) : make a copy of the current area at the
28			# specified location - return an object
29			# representing the area
30	williamc	1.1
31			package Configuration::ConfigArea;
32			use ActiveDoc::ActiveDoc;
33			require 5.004;
34			use Utilities::AddDir;
35			use ObjectUtilities::ObjectStore;
36	williamc	1.8	use Configuration::ConfigStore;
37	williamc	1.6	use Cwd;
38	williamc	1.1	@ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
39
40			sub init {
41			my $self=shift;
42	williamc	1.5
43	williamc	1.1	$self->newparse("init");
44			$self->newparse("download");
45			$self->newparse("setup");
46			$self->addtag("init","project",\&Project_Start,$self,
47	williamc	1.7	\&Project_text,$self,"", $self );
48	williamc	1.1	$self->addurltags("download");
49			$self->addtag("download","use",\&Use_download_Start,$self,
50			"", $self, "",$self);
51			$self->addurltags("setup");
52			$self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);
53	williamc	1.8
54			# data init
55			$self->{admindir}=".SCRAM";
56	williamc	1.1	}
57
58	williamc	1.7
59	williamc	1.6	sub defaultdirname {
60			my $self=shift;
61	williamc	1.8	my $name=$self->name();
62			my $vers=$self->version();
63			$vers=~s/^$name_//;
64			$name=$name."_".$vers;
65			return $name;
66
67	williamc	1.6	}
68
69	williamc	1.1	sub setup {
70			my $self=shift;
71
72	williamc	1.7	# --- find out the location - default is cwd
73			my $location=$self->option("area_location");
74			if ( ! defined $location ) {
75			$location=cwd();
76			}
77			elsif ( $location!~/^\// ) {
78	williamc	1.6	$location=cwd()."/".$location;
79			}
80	williamc	1.1
81			# --- find area directory name , default name projectname_version
82			my $name=$self->option("area_name");
83			if ( ! defined $name ) {
84	williamc	1.6	$name=$self->defaultdirname();
85	williamc	1.1	}
86			$self->location($location."/".$name);
87
88			# make a new store handler
89	williamc	1.4	$self->_setupstore();
90	williamc	1.1
91			# --- download everything first
92			# FIX-ME --- cacheing is broken
93	williamc	1.2	$self->parse("download");
94	williamc	1.1
95			# --- and parse the setup file
96			$self->parse("setup");
97	williamc	1.3
98	williamc	1.5	# --- store bootstrap info
99	williamc	1.8	$self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
100	williamc	1.5
101	williamc	1.3	# --- store self in original database
102	williamc	1.4	$self->parentconfig()->store($self,"ConfigArea",$self->name(),
103	williamc	1.3	$self->version());
104			}
105
106			sub _setupstore {
107			my $self=shift;
108
109	williamc	1.8	# --- make a new ConfigStore at the location and add it to the db list
110			my $ad=Configuration::ConfigStore->new($self->location().
111			"/".$self->{admindir});
112	williamc	1.3
113	williamc	1.4	$self->parentconfig($self->config());
114			# $self->config(Configuration::ConfigureStore->new());
115			# $self->config()->db("local",$ad);
116			# $self->config()->db("parent",$self->parentconfig());
117			# $self->config()->policy("cache","local");
118			$self->config($ad);
119			$self->config()->basedoc($self->parentconfig()->basedoc());
120			}
121
122	williamc	1.5	sub bootstrapfromlocation {
123			my $self=shift;
124
125			if ( ! defined $self->location(@_) ) {
126			$self->error("Unable to locate the top of local configuration area");
127			}
128	williamc	1.6	print "Found top ".$self->location()."\n";
129	williamc	1.5	$self->_setupstore();
130	williamc	1.8	$self->restore($self->location()."/".$self->{admindir}.
131			"/ConfigArea.dat");
132	williamc	1.5	}
133
134	williamc	1.4	sub parentconfig {
135			my $self=shift;
136			@_?$self->{parentconfig}=shift
137			:$self->{parentconfig};
138	williamc	1.1	}
139
140			sub store {
141			my $self=shift;
142			my $location=shift;
143
144			my $fh=$self->openfile(">".$location);
145	williamc	1.4	$self->savevar($fh,"location", $self->location());
146			$self->savevar($fh,"url", $self->url());
147			$self->savevar($fh,"name", $self->name());
148			$self->savevar($fh,"version", $self->version());
149	williamc	1.1	$fh->close();
150			}
151
152	williamc	1.6	sub copy {
153			my $self=shift;
154			my $destination=shift;
155			use File::Basename;
156			# create the area
157
158			AddDir::adddir(dirname($destination));
159
160	williamc	1.7	$temp=$self->location();
161			my @cpcmd=(qw(cp -r), "$temp", "$destination");
162			print "@cpcmd"."\n";
163	williamc	1.6	# File::Copy::copy("$self->location()", "$destination") or
164	williamc	1.7	system(@cpcmd) == 0 or
165	williamc	1.6	$self->error("Cannot copy ".$self->location().
166			" to $destination ".$!);
167
168			# create a new object based on the new area
169			my $newarea=ref($self)->new($self->parentconfig());
170			$newarea->bootstrapfromlocation($destination);
171			# save it with the new location info
172	williamc	1.8	$newarea->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
173	williamc	1.6	}
174
175	williamc	1.1	sub restore {
176			my $self=shift;
177	williamc	1.4	my $location=shift;
178	williamc	1.1
179			my $fh=$self->openfile("<".$location);
180	williamc	1.4	my $varhash={};
181			$self->restorevars($fh,$varhash);
182	williamc	1.5	if ( ! defined $self->location() ) {
183			$self->location($$varhash{"location"});
184			}
185	williamc	1.4	$self->_setupstore();
186			$self->url($$varhash{"url"});
187			$self->name($$varhash{"name"});
188			$self->version($$varhash{"version"});
189	williamc	1.1	$fh->close();
190			}
191
192			sub name {
193			my $self=shift;
194
195			@_?$self->{name}=shift
196			:$self->{name};
197			}
198
199			sub version {
200			my $self=shift;
201
202			@_?$self->{version}=shift
203			:$self->{version};
204			}
205
206			sub location {
207			my $self=shift;
208
209	williamc	1.5	if ( @_ ) {
210	williamc	1.6	$self->{location}=shift;
211	williamc	1.5	}
212			elsif ( ! defined $self->{location} ) {
213			# try and find the release location
214	williamc	1.8	#$self->{location}=$self->searchlocation();
215	williamc	1.5	}
216			return $self->{location};
217			}
218
219			sub searchlocation {
220			my $self=shift;
221
222			#start search in current directory if not specified
223			my $thispath;
224			@_?$thispath=shift
225	williamc	1.6	:$thispath=cwd();
226	williamc	1.5
227			my $rv=0;
228
229	williamc	1.6	Sloop:{
230			do {
231			# print "Searching $thispath\n";
232	williamc	1.8	if ( -e "$thispath/".$self->{admindir} ) {
233	williamc	1.6	# print "Found\n";
234	williamc	1.5	$rv=1;
235	williamc	1.6	last Sloop;
236	williamc	1.5	}
237	williamc	1.6	} while ( ($thispath=~s/(.)\/./$1/)=~/./ ) };
238	williamc	1.5
239			return $rv?$thispath:undef;
240	williamc	1.1	}
241
242			sub meta {
243			my $self=shift;
244
245			my $string=$self->name()." ".$self->version()." located at :\n ".
246			$self->location;
247			}
248
249			sub configitem {
250			my $self=shift;
251
252	williamc	1.5	return ($self->config()->find("ConfigItem",@_));
253	williamc	1.1	}
254
255			sub addconfigitem {
256			my $self=shift;
257			my $url=shift;
258
259			my $docref=$self->activatedoc($url);
260			# Set up the document
261			$docref->setup();
262	williamc	1.8	$docref->save();
263	williamc	1.4	# $self->config()->storepolicy("local");
264	williamc	1.1	}
265
266			# -------------- Tags ---------------------------------
267			# -- init parse
268			sub Project_Start {
269			my $self=shift;
270			my $name=shift;
271			my $hashref=shift;
272
273			$self->checktag($name,$hashref,'name');
274			$self->checktag($name,$hashref,'version');
275
276			$self->name($$hashref{'name'});
277			$self->version($$hashref{'version'});
278			}
279
280
281			sub Project_text {
282			my $self=shift;
283			my $name=shift;
284			my $string=shift;
285
286			print $string;
287			}
288
289			# ---- download parse
290
291			sub Use_download_Start {
292			my $self=shift;
293			my $name=shift;
294			my $hashref=shift;
295
296			$self->checktag($name,$hashref,'url');
297			print "Downloading .... ".$$hashref{'url'}."\n";
298			$self->getfile($$hashref{'url'});
299			}
300
301			# --- setup parse
302
303			sub Use_Start {
304			my $self=shift;
305			my $name=shift;
306			my $hashref=shift;
307
308			$self->checktag($name,$hashref,'url');
309			$self->addconfigitem($$hashref{'url'});
310			}
311