ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/Configuration/ConfigArea.pm
(Generate patch)

Comparing COMP/SCRAM/src/Configuration/ConfigArea.pm (file contents):
Revision 1.8 by williamc, Thu Feb 10 10:59:44 2000 UTC vs.
Revision 1.11 by williamc, Thu Feb 24 14:24:29 2000 UTC

# Line 4 | Line 4
4   # Originally Written by Christopher Williams
5   #
6   # Description
7 + # -----------
8 + # creates and manages a configuration area
9 + #
10 + # Options
11 + # -------
12 + # ConfigArea_location
13 + # ConfigArea_name
14   #
15   # Interface
16   # ---------
# Line 19 | Line 26
26   # configitem(@keys)             : return a list of fig items that match
27   #                                 the keys - all if left blank
28   # parentstore()                 : set/return the parent ObjectStore
29 + # basearea(ConfigArea)          : Set/Get the base area
30 + # freebase()                    : Remove any link to a base area
31   # 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   # defaultdirname()              : return the default directory name string
36   # copy(location)                : make a copy of the current area at the
37 < #                                 specified location - return an object
38 < #                                 representing the area
37 > #                                 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  
49   package Configuration::ConfigArea;
50   use ActiveDoc::ActiveDoc;
# Line 34 | Line 52 | require 5.004;
52   use Utilities::AddDir;
53   use ObjectUtilities::ObjectStore;
54   use Configuration::ConfigStore;
55 + use Configuration::ActiveDoc_arch;
56   use Cwd;
57 < @ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
57 > @ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
58  
59   sub init {
60          my $self=shift;
# Line 43 | Line 62 | sub init {
62          $self->newparse("init");
63          $self->newparse("download");
64          $self->newparse("setup");
65 +        $self->newparse("setup_tools");
66 +        $self->addarchtags("setup_tools");
67 +        $self->addarchtags("setup");
68          $self->addtag("init","project",\&Project_Start,$self,
69              \&Project_text,$self,"", $self );
70          $self->addurltags("download");
71 +        $self->addtag("download","download",\&Download_Start,$self,
72 +                                                "", $self, "",$self);
73          $self->addtag("download","use",\&Use_download_Start,$self,
74                                                  "", $self, "",$self);
75          $self->addurltags("setup");
76 <        $self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);
76 >        $self->addtag("setup_tools","use",\&Use_Start,$self, "", $self, "",$self);
77 >        $self->addtag("setup","structure",\&Structure_Start,$self,
78 >                         "", $self, "",$self);
79  
80          # data init
81          $self->{admindir}=".SCRAM";
82   }
83  
84 + sub basearea {
85 +        my $self=shift;
86 +
87 +        my $area;
88 +        if ( @_ ) {
89 +          $area=shift;
90 +          $self->config()->store($area,"BaseArea");
91 +        }
92 +        else {
93 +          ($area)=$self->config()->restore("BaseArea");
94 +        }
95 +        return $area;
96 + }
97 +
98 + sub freebase {
99 +        my $self=shift;
100 +        $self->config()->delete("BaseArea");
101 + }
102  
103   sub defaultdirname {
104          my $self=shift;
105          my $name=$self->name();
106          my $vers=$self->version();
107 <        $vers=~s/^$name_//;
107 >        $vers=~s/^$name\_//;
108          $name=$name."_".$vers;
109          return $name;
66 –
110   }
111  
112 +
113   sub setup {
114          my $self=shift;
115  
116          # --- find out the location - default is cwd
117 <        my $location=$self->option("area_location");
117 >        my $location=$self->option("ConfigArea_location");
118          if ( ! defined $location ) {
119                  $location=cwd();
120          }
# Line 79 | Line 123 | sub setup {
123          }
124  
125          # --- find area directory name , default name projectname_version
126 <        my $name=$self->option("area_name");
126 >        my $name=$self->option("ConfigArea_name");
127          if ( ! defined $name ) {
128            $name=$self->defaultdirname();
129          }
# Line 89 | Line 133 | sub setup {
133          $self->_setupstore();
134  
135          # --- download everything first
92 – # FIX-ME --- cacheing is broken
136          $self->parse("download");
137          
138          # --- and parse the setup file
139          $self->parse("setup");
140 +        $self->parse("setup_tools");
141          
142          # --- store bootstrap info
143          $self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
# Line 103 | Line 147 | sub setup {
147                                                          $self->version());
148   }
149  
150 + sub structure {
151 +        my $self=shift;
152 +        my $vr=shift;
153 +        return $self->{structures}{$vr};
154 + }
155 +
156 + sub structurelist {
157 +        my $self=shift;
158 +        return ( keys %{$self->{structures}} );
159 + }
160 +
161   sub _setupstore {
162          my $self=shift;
163  
164          # --- make a new ConfigStore at the location and add it to the db list
165          my $ad=Configuration::ConfigStore->new($self->location().
166 <                                "/".$self->{admindir});
166 >                                "/".$self->{admindir}, $self->arch());
167  
168          $self->parentconfig($self->config());
169   #        $self->config(Configuration::ConfigureStore->new());
# Line 147 | Line 202 | sub store {
202          $self->savevar($fh,"name", $self->name());
203          $self->savevar($fh,"version", $self->version());
204          $fh->close();
205 +
206 +        $self->_storestructures();
207 + }
208 +
209 + sub satellite {
210 +        my $self=shift;
211 +        my $newarea=$self->copy(@_);
212 +        $newarea->_makesatellites();
213 +        return $newarea;
214   }
215  
216   sub copy {
217          my $self=shift;
154 –        my $destination=shift;
218          use File::Basename;
219          # create the area
220  
221 <        AddDir::adddir(dirname($destination));
221 >        my $destination;
222 >        if ( @_ ) {
223 >         $destination=shift;
224 >        }
225 >        else {
226 >          my($location,$name)=$self->_defaultoptions();
227 >          $destination=$location."/".$name
228 >        }
229 >        #AddDir::adddir(dirname($destination)."/".$self->{admindir});
230 >        #AddDir::adddir($destination."/".$self->{admindir});
231          
232 <        $temp=$self->location();
233 <        my @cpcmd=(qw(cp -r), "$temp", "$destination");
234 <        print "@cpcmd"."\n";
163 < #       File::Copy::copy("$self->location()", "$destination") or
164 <        system(@cpcmd) == 0 or
165 <                        $self->error("Cannot copy ".$self->location().
166 <                        " to $destination ".$!);
167 <
232 >        # copy across the admin dir
233 >        $temp=$self->location()."/".$self->{admindir};
234 >        AddDir::copydir($temp,"$destination/".$self->{admindir});
235          # create a new object based on the new area
236          my $newarea=ref($self)->new($self->parentconfig());
237          $newarea->bootstrapfromlocation($destination);
238          # save it with the new location info
239 <        $newarea->store($self->location()."/".$self->{admindir}."/ConfigArea.dat");
239 >        $newarea->store($self->location()."/".$self->{admindir}.
240 >                                                        "/ConfigArea.dat");
241 >        return $newarea;
242   }
243  
244   sub restore {
# Line 187 | Line 256 | sub restore {
256          $self->name($$varhash{"name"});
257          $self->version($$varhash{"version"});
258          $fh->close();
259 +
260 +        $self->_restorestructures();
261   }
262  
263   sub name {
# Line 211 | Line 282 | sub location {
282          }
283          elsif ( ! defined $self->{location} ) {
284            # try and find the release location
285 <          #$self->{location}=$self->searchlocation();
285 >          $self->{location}=$self->searchlocation();
286          }
287          return  $self->{location};
288   }
# Line 263 | Line 334 | sub addconfigitem {
334   #       $self->config()->storepolicy("local");
335   }
336  
337 + sub downloadtotop {
338 +        my $self=shift;
339 +        my $url=shift;
340 +        my $dir=shift;
341 +        
342 +        # only download once
343 +        if ( ! -e $self->location()."/".$dir ) {
344 +          $self->{urlhandler}->download($url,$self->location()."/".$dir);
345 +        }
346 + }
347 +
348 + sub _makesatellites {
349 +        my $self=shift;
350 +        foreach $st ( values %{$self->{structures}} ) {
351 +           $st->setupsatellite()
352 +        }
353 + }
354 +
355 + sub _storestructures {
356 +        my $self=shift;
357 +        foreach $struct ( values %{$self->{structures}} ) {
358 +          $self->config()->store($struct, "Structures", $struct->name());
359 +        }
360 + }
361 +
362 + sub _restorestructures {
363 +        my $self=shift;
364 +        my @strs=$self->config()->find("Structures");
365 +        foreach $struct ( @strs ) {
366 +          $struct->parent($self);
367 +          $self->{structures}{$struct->name()}=$struct;
368 +        }
369 + }
370 +
371 + sub _defaultoptions {
372 +        my $self=shift;
373 +        my $name;
374 +        my $location;
375 +
376 +        # --- find out the location - default is cwd
377 +        $location=$self->option("ConfigArea_location");
378 +        if ( ! defined $location ) {
379 +                $location=cwd();
380 +        }
381 +        elsif ( $location!~/^\// ) {
382 +                $location=cwd()."/".$location;
383 +        }
384 +
385 +        # --- find area directory name , default name projectname_version
386 +        $name=$self->option("ConfigArea_name");
387 +        if ( ! defined $name ) {
388 +          $name=$self->defaultdirname();
389 +        }
390 +        return ($location,$name);
391 + }
392   # -------------- Tags ---------------------------------
393   # -- init parse
394   sub Project_Start {
# Line 288 | Line 414 | sub Project_text {
414  
415   # ---- download parse
416  
417 + sub Download_Start {
418 +        my $self=shift;
419 +        my $name=shift;
420 +        my $hashref=shift;
421 +
422 +        $self->checktag($name,$hashref,'url');
423 +        $self->checktag($name,$hashref,'location');
424 +        if ( $$hashref{'location'}!~/^\w/ ) {
425 +          $self->parseerror("location must start with an".
426 +                " alphanumeric character");
427 +        }
428 +        print "Downloading .... ".$$hashref{'url'}."\n";
429 +        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
430 + }
431 +
432   sub Use_download_Start {
433          my $self=shift;
434          my $name=shift;
# Line 300 | Line 441 | sub Use_download_Start {
441  
442   # --- setup parse
443  
444 + sub Structure_Start {
445 +        my $self=shift;
446 +        my $name=shift;
447 +        my $hashref=shift;
448 +
449 +        $self->checktag($name,$hashref,'name');
450 +        if ( !(( exists $$hashref{'type'}) || ( exists $$hashref{'url'})) ) {
451 +            $self->parseerror("No url or type given in <$name> tag");
452 +        }
453 +        if ( ! exists $self->{structures}{$$hashref{'name'}} ) {
454 +          if ( exists $$hashref{'type'}) {
455 +            # create a new object of the specified type
456 +            eval "require $$hashref{'type'} ";
457 +            if  ( $@ ) {
458 +                $self->parseerror("Unable to instantiate type=".
459 +                        $$hashref{'type'}." in <$name> .".$@);
460 +            }
461 +            $self->{structures}{$$hashref{'name'}}=
462 +                $$hashref{'type'}->new($self->config());
463 +            $self->{structures}{$$hashref{'name'}}->name($$hashref{'name'});
464 +            $self->{structures}{$$hashref{'name'}}->parent($self);
465 +            $self->{structures}{$$hashref{'name'}}->vars($hashref);
466 +            $self->{structures}{$$hashref{'name'}}->arch($self->arch());
467 +          }
468 +          else { # its an activedoc
469 +                $self->{structures}{$$hashref{'name'}}=
470 +                                $self->activatedoc($$hashref{'url'});
471 +          }
472 +          $self->{structures}{$$hashref{'name'}}->setupbase();
473 +        }
474 +        else {
475 +             $self->parseerror("Multiply defined Structure - ".
476 +                                                        $$hashref{'name'});
477 +        }
478 + }
479 +
480   sub Use_Start {
481          my $self=shift;
482          my $name=shift;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines