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 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);
}

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
        my $location=$self->requestoption("area_location",
                "Please Enter the location of the directory");
        if ( $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()."/.SCRAM/ConfigArea.dat");

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

sub _setupstore {
        my $self=shift;

        # --- make a new ActiveStore at the location and add it to the db list
        my $ad=ActiveDoc::ActiveConfig->new($self->location()."/\.SCRAM");

        $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()."/.SCRAM/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));
        
        my @cpcmd=(qw(cp -r), "$self->location()", "$destination");
        print "@cpcmd";
#       File::Copy::copy("$self->location()", "$destination") or 
        system(@cpcmd) 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()."/.SCRAM/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/.SCRAM" ) {
#           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();
#       $self->config()->storepolicy("local");
        $docref->save();
}

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