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
# linkarea(oref)                : link area with another

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 - 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()."/.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));
        
        $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()."/.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");
}

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