src/Configuration/ConfigArea.pm

#
# ConfigArea.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# creates and manages a configuration area
#
# Options
# -------
# ConfigArea_location
# ConfigArea_name
#
# 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
# basearea(ConfigArea)          : Set/Get the base area
# freebase()                    : Remove any link to a base area
# 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 - defaults to cwd/default
#                                 if not specified . ConfigArea_name, 
#                                 ConfigArea_location also override .
#                                 Return an object representing the area
# satellite()                   : make a satellite area based on $self
# arch([archobj])               : Set/get the architecture object
# structure(name)               : return the object corresponding to the
#                                 structure name
# structurelist()               : return list of structure objectS
# downloadtotop(dir,url)        : download the url to a dir in the config area
#                                 

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

sub init {
        my $self=shift;

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

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

sub basearea {
        my $self=shift;

        my $area;
        if ( @_ ) {
          $area=shift;
          $self->config()->store($area,"BaseArea");
        }
        else {
          ($area)=$self->config()->find("BaseArea");
        }
        return $area;
}

sub freebase {
        my $self=shift;
        $self->config()->delete("BaseArea");
}

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("ConfigArea_location");
        if ( ! defined $location ) {
                $location=cwd();
        }
        elsif ( $location!~/^\// ) {
                $location=cwd()."/".$location;
        }

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

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

        # --- download everything first
        $self->parse("download");
        
        # --- and parse the setup file
        $self->parse("setup");
        $self->parse("setup_tools");
        
        # --- 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 structure {
        my $self=shift;
        my $vr=shift;
        return $self->{structures}{$vr};
}

sub structurelist {
        my $self=shift;
        return ( keys %{$self->{structures}} );
}

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->arch());

        $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->verbose("Found top ".$self->location());
        $self->_setupstore();
        my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
        if ( -e $infofile ) {
             $self->restore($infofile);
        }
        else {
             $self->error("Area corrupted - cannot find $infofile");
        }
}

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

        $self->_storestructures();
}

sub satellite {
        my $self=shift;
        my $newarea=$self->copy(@_);
        $newarea->_makesatellites();
        return $newarea;
}

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

        my $destination;
        if ( @_ ) {
         $destination=shift;
        }
        else {
          my($location,$name)=$self->_defaultoptions();
          $destination=$location."/".$name
        }
        #AddDir::adddir(dirname($destination)."/".$self->{admindir});
        #AddDir::adddir($destination."/".$self->{admindir});
        
        # copy across the admin dir
        $temp=$self->location()."/".$self->{admindir};
        AddDir::copydir($temp,"$destination/".$self->{admindir});
        # 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");
        return $newarea;
}

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

        $self->_restorestructures();
}

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

sub downloadtotop {
        my $self=shift;
        my $url=shift;
        my $dir=shift;
        
        # only download once
        if ( ! -e $self->location()."/".$dir ) { 
          $self->{urlhandler}->download($url,$self->location()."/".$dir);
        }
}

sub _makesatellites {
        my $self=shift;
        foreach $st ( values %{$self->{structures}} ) {
           $st->setupsatellite()
        }
}

sub _storestructures {
        my $self=shift;
        foreach $struct ( values %{$self->{structures}} ) {
          $self->config()->store($struct, "Structures", $struct->name());
        }
}

sub _restorestructures {
        my $self=shift;
        my @strs=$self->config()->find("Structures");
        foreach $struct ( @strs ) {
          $struct->parent($self);
          $self->{structures}{$struct->name()}=$struct;
        }
}

sub _defaultoptions {
        my $self=shift;
        my $name;
        my $location;

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

        # --- find area directory name , default name projectname_version
        $name=$self->option("ConfigArea_name");
        if ( ! defined $name ) {
          $name=$self->defaultdirname();
        }
        return ($location,$name);
}
# -------------- 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 Download_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->checktag($name,$hashref,'url');
        $self->checktag($name,$hashref,'location');
        if ( $$hashref{'location'}!~/^\w/ ) {
          $self->parseerror("location must start with an".
                " alphanumeric character");
        }
        print "Downloading .... ".$$hashref{'url'}."\n";
        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
}

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 Structure_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->checktag($name,$hashref,'name');
        if ( !(( exists $$hashref{'type'}) || ( exists $$hashref{'url'})) ) {
            $self->parseerror("No url or type given in <$name> tag");
        }
        if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
          if ( exists $$hashref{'type'}) {
            # create a new object of the specified type
            eval "require $$hashref{'type'} ";
            if  ( $@ ) {
                $self->parseerror("Unable to instantiate type=".
                        $$hashref{'type'}." in <$name> .".$@);
            }
            $self->{structures}{$$hashref{'name'}}=
                $$hashref{'type'}->new($self->config());
            $self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
            $self->{structures}{$$hashref{'name'}}->parent($self);
            $self->{structures}{$$hashref{'name'}}->vars($hashref);
            $self->{structures}{$$hashref{'name'}}->arch($self->arch());
          }
          else { # its an activedoc
                $self->{structures}{$$hashref{'name'}}=
                                $self->activatedoc($$hashref{'url'});
          }
          $self->{structures}{$$hashref{'name'}}->setupbase();
        }
        else {
             $self->parseerror("Multiply defined Structure - ".
                                                        $$hashref{'name'});
        }
}

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

Revision:	1.12
Committed:	Thu Mar 2 16:02:41 2000 UTC (25 years, 2 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.11:	+10 -4 lines
Log Message:	updates
#	User	Rev	Content
1	williamc	1.1	#
2			# ConfigArea.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7	williamc	1.9	# -----------
8			# creates and manages a configuration area
9			#
10			# Options
11			# -------
12			# ConfigArea_location
13			# ConfigArea_name
14	williamc	1.1	#
15			# Interface
16			# ---------
17			# new(ActiveConfig) : A new ConfigArea object
18			# setup() : setup the configuration area
19			# location([dir]) : set/return the location of the area
20			# version([version]) : set/return the version of the area
21			# name([name]) : set/return the name of the area
22			# store(location) : store data in file location
23			# restore(location) : restore data from file location
24			# meta() : return a description string of the area
25			# addconfigitem(url) : add a new item to the area
26			# configitem(@keys) : return a list of fig items that match
27			# the keys - all if left blank
28	williamc	1.4	# parentstore() : set/return the parent ObjectStore
29	williamc	1.9	# basearea(ConfigArea) : Set/Get the base area
30			# freebase() : Remove any link to a base area
31	williamc	1.5	# bootstrapfromlocation([location]): bootstrap the object based on location.
32			# no location specified - cwd used
33			# searchlocation([startdir]) : returns the location directory. search starts
34			# from cwd if not specified
35	williamc	1.6	# defaultdirname() : return the default directory name string
36			# copy(location) : make a copy of the current area at the
37	williamc	1.9	# specified location - defaults to cwd/default
38			# if not specified . ConfigArea_name,
39			# ConfigArea_location also override .
40			# Return an object representing the area
41			# satellite() : make a satellite area based on $self
42			# arch([archobj]) : Set/get the architecture object
43			# structure(name) : return the object corresponding to the
44			# structure name
45			# structurelist() : return list of structure objectS
46			# downloadtotop(dir,url) : download the url to a dir in the config area
47			#
48	williamc	1.1
49			package Configuration::ConfigArea;
50			use ActiveDoc::ActiveDoc;
51			require 5.004;
52			use Utilities::AddDir;
53			use ObjectUtilities::ObjectStore;
54	williamc	1.8	use Configuration::ConfigStore;
55	williamc	1.9	use Configuration::ActiveDoc_arch;
56	williamc	1.6	use Cwd;
57	williamc	1.9	@ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
58	williamc	1.1
59			sub init {
60			my $self=shift;
61	williamc	1.5
62	williamc	1.1	$self->newparse("init");
63			$self->newparse("download");
64			$self->newparse("setup");
65	williamc	1.10	$self->newparse("setup_tools");
66			$self->addarchtags("setup_tools");
67			$self->addarchtags("setup");
68	williamc	1.1	$self->addtag("init","project",\&Project_Start,$self,
69	williamc	1.7	\&Project_text,$self,"", $self );
70	williamc	1.1	$self->addurltags("download");
71	williamc	1.9	$self->addtag("download","download",\&Download_Start,$self,
72			"", $self, "",$self);
73	williamc	1.1	$self->addtag("download","use",\&Use_download_Start,$self,
74			"", $self, "",$self);
75			$self->addurltags("setup");
76	williamc	1.12	$self->addurltags("setup_tools");
77	williamc	1.10	$self->addtag("setup_tools","use",\&Use_Start,$self, "", $self, "",$self);
78	williamc	1.9	$self->addtag("setup","structure",\&Structure_Start,$self,
79			"", $self, "",$self);
80	williamc	1.8
81			# data init
82			$self->{admindir}=".SCRAM";
83	williamc	1.1	}
84
85	williamc	1.9	sub basearea {
86			my $self=shift;
87
88			my $area;
89			if ( @_ ) {
90			$area=shift;
91			$self->config()->store($area,"BaseArea");
92			}
93			else {
94	williamc	1.12	($area)=$self->config()->find("BaseArea");
95	williamc	1.9	}
96			return $area;
97			}
98
99			sub freebase {
100			my $self=shift;
101			$self->config()->delete("BaseArea");
102			}
103	williamc	1.7
104	williamc	1.6	sub defaultdirname {
105			my $self=shift;
106	williamc	1.8	my $name=$self->name();
107			my $vers=$self->version();
108	williamc	1.9	$vers=~s/^$name\_//;
109	williamc	1.8	$name=$name."_".$vers;
110			return $name;
111	williamc	1.9	}
112	williamc	1.8
113	williamc	1.6
114	williamc	1.1	sub setup {
115			my $self=shift;
116
117	williamc	1.7	# --- find out the location - default is cwd
118	williamc	1.9	my $location=$self->option("ConfigArea_location");
119	williamc	1.7	if ( ! defined $location ) {
120			$location=cwd();
121			}
122			elsif ( $location!~/^\// ) {
123	williamc	1.6	$location=cwd()."/".$location;
124			}
125	williamc	1.1
126			# --- find area directory name , default name projectname_version
127	williamc	1.9	my $name=$self->option("ConfigArea_name");
128	williamc	1.1	if ( ! defined $name ) {
129	williamc	1.6	$name=$self->defaultdirname();
130	williamc	1.1	}
131			$self->location($location."/".$name);
132
133			# make a new store handler
134	williamc	1.4	$self->_setupstore();
135	williamc	1.1
136			# --- download everything first
137	williamc	1.2	$self->parse("download");
138	williamc	1.1
139			# --- and parse the setup file
140			$self->parse("setup");
141	williamc	1.10	$self->parse("setup_tools");
142	williamc	1.3
143	williamc	1.5	# --- store bootstrap info
144	williamc	1.8	$self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
145	williamc	1.5
146	williamc	1.3	# --- store self in original database
147	williamc	1.4	$self->parentconfig()->store($self,"ConfigArea",$self->name(),
148	williamc	1.3	$self->version());
149			}
150
151	williamc	1.9	sub structure {
152			my $self=shift;
153			my $vr=shift;
154			return $self->{structures}{$vr};
155			}
156
157			sub structurelist {
158			my $self=shift;
159			return ( keys %{$self->{structures}} );
160			}
161
162	williamc	1.3	sub _setupstore {
163			my $self=shift;
164
165	williamc	1.8	# --- make a new ConfigStore at the location and add it to the db list
166			my $ad=Configuration::ConfigStore->new($self->location().
167	williamc	1.9	"/".$self->{admindir}, $self->arch());
168	williamc	1.3
169	williamc	1.4	$self->parentconfig($self->config());
170			# $self->config(Configuration::ConfigureStore->new());
171			# $self->config()->db("local",$ad);
172			# $self->config()->db("parent",$self->parentconfig());
173			# $self->config()->policy("cache","local");
174			$self->config($ad);
175			$self->config()->basedoc($self->parentconfig()->basedoc());
176			}
177
178	williamc	1.5	sub bootstrapfromlocation {
179			my $self=shift;
180
181			if ( ! defined $self->location(@_) ) {
182			$self->error("Unable to locate the top of local configuration area");
183			}
184	williamc	1.12	$self->verbose("Found top ".$self->location());
185	williamc	1.5	$self->_setupstore();
186	williamc	1.12	my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
187			if ( -e $infofile ) {
188			$self->restore($infofile);
189			}
190			else {
191			$self->error("Area corrupted - cannot find $infofile");
192			}
193	williamc	1.5	}
194
195	williamc	1.4	sub parentconfig {
196			my $self=shift;
197			@_?$self->{parentconfig}=shift
198			:$self->{parentconfig};
199	williamc	1.1	}
200
201			sub store {
202			my $self=shift;
203			my $location=shift;
204
205			my $fh=$self->openfile(">".$location);
206	williamc	1.4	$self->savevar($fh,"location", $self->location());
207			$self->savevar($fh,"url", $self->url());
208			$self->savevar($fh,"name", $self->name());
209			$self->savevar($fh,"version", $self->version());
210	williamc	1.1	$fh->close();
211	williamc	1.9
212			$self->_storestructures();
213			}
214
215			sub satellite {
216			my $self=shift;
217			my $newarea=$self->copy(@_);
218			$newarea->_makesatellites();
219			return $newarea;
220	williamc	1.1	}
221
222	williamc	1.6	sub copy {
223			my $self=shift;
224			use File::Basename;
225			# create the area
226
227	williamc	1.9	my $destination;
228			if ( @_ ) {
229			$destination=shift;
230			}
231			else {
232			my($location,$name)=$self->_defaultoptions();
233			$destination=$location."/".$name
234			}
235			#AddDir::adddir(dirname($destination)."/".$self->{admindir});
236			#AddDir::adddir($destination."/".$self->{admindir});
237	williamc	1.6
238	williamc	1.9	# copy across the admin dir
239			$temp=$self->location()."/".$self->{admindir};
240			AddDir::copydir($temp,"$destination/".$self->{admindir});
241	williamc	1.6	# create a new object based on the new area
242			my $newarea=ref($self)->new($self->parentconfig());
243			$newarea->bootstrapfromlocation($destination);
244			# save it with the new location info
245	williamc	1.9	$newarea->store($self->location()."/".$self->{admindir}.
246			"/ConfigArea.dat");
247			return $newarea;
248	williamc	1.6	}
249
250	williamc	1.1	sub restore {
251			my $self=shift;
252	williamc	1.4	my $location=shift;
253	williamc	1.1
254			my $fh=$self->openfile("<".$location);
255	williamc	1.4	my $varhash={};
256			$self->restorevars($fh,$varhash);
257	williamc	1.5	if ( ! defined $self->location() ) {
258			$self->location($$varhash{"location"});
259			}
260	williamc	1.4	$self->_setupstore();
261			$self->url($$varhash{"url"});
262			$self->name($$varhash{"name"});
263			$self->version($$varhash{"version"});
264	williamc	1.1	$fh->close();
265	williamc	1.9
266			$self->_restorestructures();
267	williamc	1.1	}
268
269			sub name {
270			my $self=shift;
271
272			@_?$self->{name}=shift
273			:$self->{name};
274			}
275
276			sub version {
277			my $self=shift;
278
279			@_?$self->{version}=shift
280			:$self->{version};
281			}
282
283			sub location {
284			my $self=shift;
285
286	williamc	1.5	if ( @_ ) {
287	williamc	1.6	$self->{location}=shift;
288	williamc	1.5	}
289			elsif ( ! defined $self->{location} ) {
290			# try and find the release location
291	williamc	1.9	$self->{location}=$self->searchlocation();
292	williamc	1.5	}
293			return $self->{location};
294			}
295
296			sub searchlocation {
297			my $self=shift;
298
299			#start search in current directory if not specified
300			my $thispath;
301			@_?$thispath=shift
302	williamc	1.6	:$thispath=cwd();
303	williamc	1.5
304			my $rv=0;
305
306	williamc	1.6	Sloop:{
307			do {
308			# print "Searching $thispath\n";
309	williamc	1.8	if ( -e "$thispath/".$self->{admindir} ) {
310	williamc	1.6	# print "Found\n";
311	williamc	1.5	$rv=1;
312	williamc	1.6	last Sloop;
313	williamc	1.5	}
314	williamc	1.6	} while ( ($thispath=~s/(.)\/./$1/)=~/./ ) };
315	williamc	1.5
316			return $rv?$thispath:undef;
317	williamc	1.1	}
318
319			sub meta {
320			my $self=shift;
321
322			my $string=$self->name()." ".$self->version()." located at :\n ".
323			$self->location;
324			}
325
326			sub configitem {
327			my $self=shift;
328
329	williamc	1.5	return ($self->config()->find("ConfigItem",@_));
330	williamc	1.1	}
331
332			sub addconfigitem {
333			my $self=shift;
334			my $url=shift;
335
336			my $docref=$self->activatedoc($url);
337			# Set up the document
338			$docref->setup();
339	williamc	1.8	$docref->save();
340	williamc	1.4	# $self->config()->storepolicy("local");
341	williamc	1.1	}
342
343	williamc	1.9	sub downloadtotop {
344			my $self=shift;
345			my $url=shift;
346			my $dir=shift;
347
348			# only download once
349			if ( ! -e $self->location()."/".$dir ) {
350			$self->{urlhandler}->download($url,$self->location()."/".$dir);
351			}
352			}
353
354			sub _makesatellites {
355			my $self=shift;
356			foreach $st ( values %{$self->{structures}} ) {
357			$st->setupsatellite()
358			}
359			}
360
361			sub _storestructures {
362			my $self=shift;
363			foreach $struct ( values %{$self->{structures}} ) {
364			$self->config()->store($struct, "Structures", $struct->name());
365			}
366			}
367
368			sub _restorestructures {
369			my $self=shift;
370			my @strs=$self->config()->find("Structures");
371			foreach $struct ( @strs ) {
372			$struct->parent($self);
373			$self->{structures}{$struct->name()}=$struct;
374			}
375			}
376
377			sub _defaultoptions {
378			my $self=shift;
379			my $name;
380			my $location;
381
382			# --- find out the location - default is cwd
383			$location=$self->option("ConfigArea_location");
384			if ( ! defined $location ) {
385			$location=cwd();
386			}
387			elsif ( $location!~/^\// ) {
388			$location=cwd()."/".$location;
389			}
390
391			# --- find area directory name , default name projectname_version
392			$name=$self->option("ConfigArea_name");
393			if ( ! defined $name ) {
394			$name=$self->defaultdirname();
395			}
396			return ($location,$name);
397			}
398	williamc	1.1	# -------------- Tags ---------------------------------
399			# -- init parse
400			sub Project_Start {
401			my $self=shift;
402			my $name=shift;
403			my $hashref=shift;
404
405			$self->checktag($name,$hashref,'name');
406			$self->checktag($name,$hashref,'version');
407
408			$self->name($$hashref{'name'});
409			$self->version($$hashref{'version'});
410			}
411
412
413			sub Project_text {
414			my $self=shift;
415			my $name=shift;
416			my $string=shift;
417
418			print $string;
419			}
420
421			# ---- download parse
422
423	williamc	1.9	sub Download_Start {
424			my $self=shift;
425			my $name=shift;
426			my $hashref=shift;
427
428			$self->checktag($name,$hashref,'url');
429			$self->checktag($name,$hashref,'location');
430			if ( $$hashref{'location'}!~/^\w/ ) {
431			$self->parseerror("location must start with an".
432			" alphanumeric character");
433			}
434			print "Downloading .... ".$$hashref{'url'}."\n";
435			$self->downloadtotop($$hashref{'url'},$$hashref{'location'});
436			}
437
438	williamc	1.1	sub Use_download_Start {
439			my $self=shift;
440			my $name=shift;
441			my $hashref=shift;
442
443			$self->checktag($name,$hashref,'url');
444			print "Downloading .... ".$$hashref{'url'}."\n";
445			$self->getfile($$hashref{'url'});
446			}
447
448			# --- setup parse
449	williamc	1.9
450			sub Structure_Start {
451			my $self=shift;
452			my $name=shift;
453			my $hashref=shift;
454
455			$self->checktag($name,$hashref,'name');
456	williamc	1.11	if ( !(( exists $$hashref{'type'}) \|\| ( exists $$hashref{'url'})) ) {
457	williamc	1.9	$self->parseerror("No url or type given in <$name> tag");
458			}
459			if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
460			if ( exists $$hashref{'type'}) {
461			# create a new object of the specified type
462			eval "require $$hashref{'type'} ";
463			if ( $@ ) {
464			$self->parseerror("Unable to instantiate type=".
465			$$hashref{'type'}." in <$name> .".$@);
466			}
467			$self->{structures}{$$hashref{'name'}}=
468			$$hashref{'type'}->new($self->config());
469			$self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
470			$self->{structures}{$$hashref{'name'}}->parent($self);
471			$self->{structures}{$$hashref{'name'}}->vars($hashref);
472	williamc	1.11	$self->{structures}{$$hashref{'name'}}->arch($self->arch());
473	williamc	1.9	}
474			else { # its an activedoc
475			$self->{structures}{$$hashref{'name'}}=
476			$self->activatedoc($$hashref{'url'});
477			}
478			$self->{structures}{$$hashref{'name'}}->setupbase();
479			}
480			else {
481			$self->parseerror("Multiply defined Structure - ".
482			$$hashref{'name'});
483			}
484			}
485	williamc	1.1
486			sub Use_Start {
487			my $self=shift;
488			my $name=shift;
489			my $hashref=shift;
490
491			$self->checktag($name,$hashref,'url');
492			$self->addconfigitem($$hashref{'url'});
493			}
494