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
#	Content
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	# parentstore() : set/return the parent ObjectStore
22	# 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	# 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	# linkarea(oref) : link area with another
31
32	package Configuration::ConfigArea;
33	use ActiveDoc::ActiveDoc;
34	require 5.004;
35	use Utilities::AddDir;
36	use ObjectUtilities::ObjectStore;
37	use Cwd;
38	@ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
39
40	sub init {
41	my $self=shift;
42
43	$self->newparse("init");
44	$self->newparse("download");
45	$self->newparse("setup");
46	$self->addtag("init","project",\&Project_Start,$self,
47	\&Project_text,$self,"", $self );
48	$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
56	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	sub setup {
67	my $self=shift;
68
69	# --- 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	$location=cwd()."/".$location;
76	}
77
78	# --- find area directory name , default name projectname_version
79	my $name=$self->option("area_name");
80	if ( ! defined $name ) {
81	$name=$self->defaultdirname();
82	}
83	$self->location($location."/".$name);
84
85	# make a new store handler
86	$self->_setupstore();
87
88	# --- download everything first
89	# FIX-ME --- cacheing is broken
90	$self->parse("download");
91
92	# --- and parse the setup file
93	$self->parse("setup");
94
95	# --- store bootstrap info
96	$self->store($self->location()."/.SCRAM/ConfigArea.dat");
97
98	# --- store self in original database
99	$self->parentconfig()->store($self,"ConfigArea",$self->name(),
100	$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	$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	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	print "Found top ".$self->location()."\n";
125	$self->_setupstore();
126	$self->restore($self->location()."/.SCRAM/ConfigArea.dat");
127	}
128
129	sub parentconfig {
130	my $self=shift;
131	@_?$self->{parentconfig}=shift
132	:$self->{parentconfig};
133	}
134
135	sub store {
136	my $self=shift;
137	my $location=shift;
138
139	my $fh=$self->openfile(">".$location);
140	$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	$fh->close();
145	}
146
147	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	$temp=$self->location();
156	my @cpcmd=(qw(cp -r), "$temp", "$destination");
157	print "@cpcmd"."\n";
158	# File::Copy::copy("$self->location()", "$destination") or
159	system(@cpcmd) == 0 or
160	$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	sub restore {
171	my $self=shift;
172	my $location=shift;
173
174	my $fh=$self->openfile("<".$location);
175	my $varhash={};
176	$self->restorevars($fh,$varhash);
177	if ( ! defined $self->location() ) {
178	$self->location($$varhash{"location"});
179	}
180	$self->_setupstore();
181	$self->url($$varhash{"url"});
182	$self->name($$varhash{"name"});
183	$self->version($$varhash{"version"});
184	$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	if ( @_ ) {
205	$self->{location}=shift;
206	}
207	elsif ( ! defined $self->{location} ) {
208	# try and find the release location
209	$self->{location}=$self->searchlocation();
210	}
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	:$thispath=cwd();
221
222	my $rv=0;
223
224	Sloop:{
225	do {
226	# print "Searching $thispath\n";
227	if ( -e "$thispath/.SCRAM" ) {
228	# print "Found\n";
229	$rv=1;
230	last Sloop;
231	}
232	} while ( ($thispath=~s/(.)\/./$1/)=~/./ ) };
233
234	return $rv?$thispath:undef;
235	}
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	return ($self->config()->find("ConfigItem",@_));
248	}
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	# $self->config()->storepolicy("local");
258	}
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