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

package Configuration::ConfigArea;
use ActiveDoc::ActiveDoc;
require 5.004;
use Utilities::AddDir;
use ObjectUtilities::ObjectStore;
@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 setup {
        my $self=shift;

        # --- find out the location
        my $location=$self->requestoption("area_location",
                "Please Enter the location of the directory");

        # --- find area directory name , default name projectname_version
        my $name=$self->option("area_name");
        my $vers=$self->version;
        if ( ! defined $name ) {
          $name=$self->name();
          $vers=~s/^$name_//;
          $name=$name."_".$vers;
        }
        $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");
        }
        $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 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->searchlocation();
        }
        return  $self->{location};
}

sub searchlocation {
        my $self=shift;
        use Cwd;

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

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