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.4 by williamc, Fri Jan 21 11:56:38 2000 UTC vs.
Revision 1.10 by williamc, Thu Feb 24 09:55:13 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 - 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;
51   require 5.004;
52   use Utilities::AddDir;
53   use ObjectUtilities::ObjectStore;
54 < @ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
54 > use Configuration::ConfigStore;
55 > use Configuration::ActiveDoc_arch;
56 > use Cwd;
57 > @ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
58  
59   sub init {
60          my $self=shift;
61 +
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 );
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\_//;
108 +        $name=$name."_".$vers;
109 +        return $name;
110 + }
111 +
112 +
113   sub setup {
114          my $self=shift;
115  
116 <        # --- find out the location
117 <        my $location=$self->requestoption("area_location",
118 <                "Please Enter the location of the directory");
116 >        # --- find out the location - default is cwd
117 >        my $location=$self->option("ConfigArea_location");
118 >        if ( ! defined $location ) {
119 >                $location=cwd();
120 >        }
121 >        elsif ( $location!~/^\// ) {
122 >                $location=cwd()."/".$location;
123 >        }
124  
125          # --- find area directory name , default name projectname_version
126 <        my $name=$self->option("area_name");
53 <        my $vers=$self->version;
126 >        my $name=$self->option("ConfigArea_name");
127          if ( ! defined $name ) {
128 <          $name=$self->name();
56 <          $vers=~s/^$name_//;
57 <          $name=$name."_".$vers;
128 >          $name=$self->defaultdirname();
129          }
130          $self->location($location."/".$name);
131  
# Line 62 | Line 133 | sub setup {
133          $self->_setupstore();
134  
135          # --- download everything first
65 – # 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");
144 +
145          # --- store self in original database
146          $self->parentconfig()->store($self,"ConfigArea",$self->name(),
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 ActiveStore at the location and add it to the db list
165 <        my $ad=ActiveDoc::ActiveConfig->new($self->location()."/\.SCRAM");
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}, $self->arch());
167  
168          $self->parentconfig($self->config());
169   #        $self->config(Configuration::ConfigureStore->new());
# Line 88 | Line 174 | sub _setupstore {
174          $self->config()->basedoc($self->parentconfig()->basedoc());
175   }
176  
177 + sub bootstrapfromlocation {
178 +        my $self=shift;
179 +        
180 +        if ( ! defined $self->location(@_) ) {
181 +          $self->error("Unable to locate the top of local configuration area");
182 +        }
183 +        print "Found top ".$self->location()."\n";
184 +        $self->_setupstore();
185 +        $self->restore($self->location()."/".$self->{admindir}.
186 +                                                "/ConfigArea.dat");
187 + }
188 +
189   sub parentconfig {
190          my $self=shift;
191          @_?$self->{parentconfig}=shift
# Line 104 | 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;
218 +        use File::Basename;
219 +        # create the area
220 +
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 +        # 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}.
240 +                                                        "/ConfigArea.dat");
241 +        return $newarea;
242   }
243  
244   sub restore {
# Line 113 | Line 248 | sub restore {
248          my $fh=$self->openfile("<".$location);
249          my $varhash={};
250          $self->restorevars($fh,$varhash);
251 <        $self->location($$varhash{"location"});
251 >        if ( ! defined $self->location() ) {
252 >          $self->location($$varhash{"location"});
253 >        }
254          $self->_setupstore();
255          $self->url($$varhash{"url"});
256          $self->name($$varhash{"name"});
257          $self->version($$varhash{"version"});
258          $fh->close();
259 +
260 +        $self->_restorestructures();
261   }
262  
263   sub name {
# Line 138 | Line 277 | sub version {
277   sub location {
278          my $self=shift;
279  
280 <        @_?$self->{location}=shift
281 <          :$self->{location};
280 >        if ( @_ ) {
281 >          $self->{location}=shift;
282 >        }
283 >        elsif ( ! defined $self->{location} ) {
284 >          # try and find the release location
285 >          $self->{location}=$self->searchlocation();
286 >        }
287 >        return  $self->{location};
288 > }
289 >
290 > sub searchlocation {
291 >        my $self=shift;
292 >
293 >        #start search in current directory if not specified
294 >        my $thispath;
295 >        @_?$thispath=shift
296 >          :$thispath=cwd();
297 >
298 >        my $rv=0;
299 >
300 >        Sloop:{
301 >        do {
302 > #         print "Searching $thispath\n";
303 >          if ( -e "$thispath/".$self->{admindir} ) {
304 > #           print "Found\n";
305 >            $rv=1;
306 >            last Sloop;
307 >          }
308 >        } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
309 >
310 >        return $rv?$thispath:undef;
311   }
312  
313   sub meta {
# Line 151 | Line 319 | sub meta {
319  
320   sub configitem {
321          my $self=shift;
154 –        my $location=shift;
322          
323 <        $self->config()->find("ConfigItem",@_);
323 >        return ($self->config()->find("ConfigItem",@_));
324   }
325  
326   sub addconfigitem {
# Line 163 | Line 330 | sub addconfigitem {
330          my $docref=$self->activatedoc($url);
331          # Set up the document
332          $docref->setup();
333 +        $docref->save();
334   #       $self->config()->storepolicy("local");
167 –        $docref->save();
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 192 | 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 204 | 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 +          }
467 +          else { # its an activedoc
468 +                $self->{structures}{$$hashref{'name'}}=
469 +                                $self->activatedoc($$hashref{'url'});
470 +          }
471 +          $self->{structures}{$$hashref{'name'}}->setupbase();
472 +        }
473 +        else {
474 +             $self->parseerror("Multiply defined Structure - ".
475 +                                                        $$hashref{'name'});
476 +        }
477 + }
478 +
479   sub Use_Start {
480          my $self=shift;
481          my $name=shift;

Diff Legend

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