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.6 by williamc, Thu Jan 27 17:50:55 2000 UTC vs.
Revision 1.17 by williamc, Thu Sep 21 14:25:06 2000 UTC

# Line 1 | Line 1
1   #
2   # ConfigArea.pm
3   #
4 < # Originally Written by Christopher Williams
4 > # Written by Christopher Williams
5   #
6   # Description
7 + # -----------
8 + # creates and manages a configuration area
9 + #
10 + # Notes
11 + # -------
12 + # Persistency - remember to call the save method to make changes persistent
13   #
14   # Interface
15   # ---------
16 < # new(ActiveConfig)             : A new ConfigArea object
17 < # setup()                       : setup the configuration area
18 < # location([dir])               : set/return the location of the area
19 < # version([version])            : set/return the version of the area
20 < # name([name])                  : set/return the name of the area
21 < # store(location)               : store data in file location
22 < # restore(location)             : restore data from file location
23 < # meta()                        : return a description string of the area
24 < # addconfigitem(url)            : add a new item to the area
25 < # 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
16 > # new()                         : A new ConfigArea object
17 > # name()                        : get/set project name
18 > # setup(dir[,areaname])         : setup a fresh area in dir
19 > # satellite(dir[,areaname])     : setup a satellite area in dir
20 > # version()                     : get/set project version
21 > # location([dir])               : set/return the location of the work area
22 > # bootstrapfromlocation([location]) : bootstrap the object based on location.
23 > #                                     no location specified - cwd used
24 > #                                     return 0 if succesful 1 otherwise
25 > # requirementsdoc()             : get set the requirements doc
26   # searchlocation([startdir])    : returns the location directory. search starts
27   #                                 from cwd if not specified
28 < # defaultdirname()              : return the default directory name string
29 < # copy(location)                : make a copy of the current area at the
30 < #                                 specified location - return an object
31 < #                                 representing the area
28 > # scramversion()                : return the scram version associated with
29 > #                                 area
30 > # configurationdir()            : return the location of the project
31 > #                                 configuration directory
32 > # copy(location)                : copy a configuration
33 > # copysetup(location)           : copy the architecture specific tool setup
34 > #                                 returns 0 if successful, 1 otherwise
35 > # copyenv($ref)                 : copy the areas environment into the hashref
36 > # toolbox()                     : return the areas toolbox object
37 > # save()                        : save changes permanently
38 > # linkto(location)              : link the current area to that at location
39 > # unlinkarea()                  : destroy link (autosave)
40 > # linkarea([ConfigArea])        : get/set a link from the current area to the apec Area Object
41 > # archname()            : get/set a string to indicate architecture
42 > # archdir()             : return the location of the administration arch dep
43 > #                         directory
44 > # objectstore(["<"])            : return the objectStore object of the area
45 > #                                 if called with temp - will set as undef
46 > #                                 if it dosnt already exist - otherwise will
47 > #                                 attempt to create it.
48 > # - temporary
49 > # align()                       : adjust hard paths to suit local loaction
50  
51   package Configuration::ConfigArea;
32 use ActiveDoc::ActiveDoc;
52   require 5.004;
53 + use URL::URLcache;
54   use Utilities::AddDir;
55 + use Utilities::Verbose;
56   use ObjectUtilities::ObjectStore;
57   use Cwd;
58 < @ISA=qw(ActiveDoc::ActiveDoc ObjectUtilities::StorableObject);
58 > @ISA=qw(Utilities::Verbose);
59  
60 < sub init {
61 <        my $self=shift;
60 > sub new {
61 >        my $class=shift;
62 >        my $self={};
63 >        bless $self, $class;
64  
65 <        $self->newparse("init");
66 <        $self->newparse("download");
67 <        $self->newparse("setup");
68 <        $self->addtag("init","project",\&Project_Start,$self,
69 <        \&Project_text,$self,"", $self );
47 <        $self->addurltags("download");
48 <        $self->addtag("download","use",\&Use_download_Start,$self,
49 <                                                "", $self, "",$self);
50 <        $self->addurltags("setup");
51 <        $self->addtag("setup","use",\&Use_Start,$self, "", $self, "",$self);
52 < }
65 >        # data init
66 >        $self->{admindir}=".SCRAM";
67 >        $self->{cachedir}="cache";
68 >        $self->{dbdir}="ObjectDB";
69 >        undef $self->{linkarea};
70  
71 < sub defaultdirname {
55 <        my $self=shift;
56 <        my $name=$self->name();
57 <        my $vers=$self->version();
58 <        $vers=~s/^$name_//;
59 <        $name=$name."_".$vers;
60 <        return $name;
61 <        
71 >        return $self;
72   }
73  
74 < sub setup {
74 > sub cache {
75          my $self=shift;
76  
77 <        # --- find out the location
78 <        my $location=$self->requestoption("area_location",
79 <                "Please Enter the location of the directory");
80 <        if ( $location!~/^\// ) {
81 <                $location=cwd()."/".$location;
82 <        }
83 <
84 <        # --- find area directory name , default name projectname_version
85 <        my $name=$self->option("area_name");
86 <        if ( ! defined $name ) {
87 <          $name=$self->defaultdirname();
88 <        }
89 <        $self->location($location."/".$name);
90 <
91 <        # make a new store handler
92 <        $self->_setupstore();
93 <
94 <        # --- download everything first
85 < # FIX-ME --- cacheing is broken
86 <        $self->parse("download");
87 <        
88 <        # --- and parse the setup file
89 <        $self->parse("setup");
90 <        
91 <        # --- store bootstrap info
92 <        $self->store($self->location()."/.SCRAM/ConfigArea.dat");
93 <
94 <        # --- store self in original database
95 <        $self->parentconfig()->store($self,"ConfigArea",$self->name(),
96 <                                                        $self->version());
77 >        my $exist=0;
78 >        if ( @_ ) {
79 >          my $cache=shift;
80 >          if ( $cache!~/^</ ) {
81 >            $self->{cache}=$cache;
82 >          }
83 >          $exist=1;
84 >        }
85 >        if ( ! defined $self->{cache} ) {
86 >          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
87 >          if (  !$exist || ( -e $loc ) ) {
88 >            $self->{cache}=URL::URLcache->new($loc);
89 >          }
90 >          else {
91 >            $self->{cache}=undef;
92 >          }
93 >        }
94 >        return $self->{cache};
95   }
96  
97 < sub _setupstore {
97 > sub objectstore {
98          my $self=shift;
99  
100 <        # --- make a new ActiveStore at the location and add it to the db list
101 <        my $ad=ActiveDoc::ActiveConfig->new($self->location()."/\.SCRAM");
102 <
103 <        $self->parentconfig($self->config());
104 < #        $self->config(Configuration::ConfigureStore->new());
105 < #        $self->config()->db("local",$ad);
106 < #        $self->config()->db("parent",$self->parentconfig());
107 < #        $self->config()->policy("cache","local");
108 <        $self->config($ad);
109 <        $self->config()->basedoc($self->parentconfig()->basedoc());
100 >        my $exist="";
101 >        if ( @_ ) {
102 >          my $db=shift;
103 >          if ( $db!~/^</ ) {
104 >            $self->{dbstore}=cache;
105 >          }
106 >          $exist="<";
107 >        }
108 >        if ( ! defined $self->{dbstore} ) {
109 >          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
110 >          $self->{dbstore}=ObjectUtilities::ObjectStore->new($exist.$loc);
111 >        }
112 >        return $self->{dbstore}
113   }
114  
115 < sub bootstrapfromlocation {
115 > sub name {
116          my $self=shift;
117 <        
118 <        if ( ! defined $self->location(@_) ) {
118 <          $self->error("Unable to locate the top of local configuration area");
119 <        }
120 <        print "Found top ".$self->location()."\n";
121 <        $self->_setupstore();
122 <        $self->restore($self->location()."/.SCRAM/ConfigArea.dat");
117 >        @_?$self->{name}=shift
118 >          :$self->{name};
119   }
120  
121 < sub parentconfig {
121 > sub version {
122          my $self=shift;
123 <        @_?$self->{parentconfig}=shift
124 <          :$self->{parentconfig};
123 >        @_?$self->{version}=shift
124 >          :$self->{version};
125   }
126  
127 < sub store {
127 > sub setup {
128          my $self=shift;
129          my $location=shift;
130 +        my $areaname;
131  
132 <        my $fh=$self->openfile(">".$location);
133 <        $self->savevar($fh,"location", $self->location());
134 <        $self->savevar($fh,"url", $self->url());
135 <        $self->savevar($fh,"name", $self->name());
136 <        $self->savevar($fh,"version", $self->version());
137 <        $fh->close();
141 < }
132 >        # -- check we have a project name and version
133 >        my $name=$self->name();
134 >        my $vers=$self->version();
135 >        if ( ( ! defined $name ) && ( ! defined $version )) {
136 >          $self->error("Set ConfigArea name and version before setup");
137 >        }
138  
139 < sub copy {
140 <        my $self=shift;
141 <        my $destination=shift;
142 <        use File::Basename;
143 <        # create the area
139 >        # -- check arguments and set location
140 >        if ( ! defined $location ) {
141 >          $self->error("ConfigArea: Cannot setup new area without a location");
142 >        }
143 >        if ( @_ ) {
144 >          $areaname=shift;
145 >        }
146 >        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
147 >          # -- make up a name from the project name and version
148 >          $vers=~s/^$name\_//;
149 >          $areaname=$name."_".$vers;
150 >        }
151 >        my $arealoc=$location."/".$areaname;
152 >        my $workloc=$arealoc."/".$self->{admindir};
153 >        $self->verbose("Building at $arealoc");
154 >        $self->location($arealoc);
155 >
156 >        # -- create top level structure and work area
157 >        AddDir::adddir($workloc);
158 >
159 >        # -- add a cache
160 >        $self->cache();
161 >
162 >        # -- Save Environment File
163 >        $self->_SaveEnvFile();
164  
149        AddDir::adddir(dirname($destination));
150        
151        my @cpcmd=(qw(cp -r), "$self->location()", "$destination");
152        print "@cpcmd";
153 #       File::Copy::copy("$self->location()", "$destination") or
154        system(@cpcmd) or
155                        $self->error("Cannot copy ".$self->location().
156                        " to $destination ".$!);
157
158        # create a new object based on the new area
159        my $newarea=ref($self)->new($self->parentconfig());
160        $newarea->bootstrapfromlocation($destination);
161        # save it with the new location info
162        $newarea->store($self->location()."/.SCRAM/ConfigArea.dat");
165   }
166  
167 < sub restore {
167 > sub configurationdir {
168          my $self=shift;
169 <        my $location=shift;
169 >        if ( @_ ) {
170 >          $self->{configurationdir}=shift;
171 >        }
172 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
173 > }
174  
175 <        my $fh=$self->openfile("<".$location);
176 <        my $varhash={};
177 <        $self->restorevars($fh,$varhash);
178 <        if ( ! defined $self->location() ) {
179 <          $self->location($$varhash{"location"});
180 <        }
175 <        $self->_setupstore();
176 <        $self->url($$varhash{"url"});
177 <        $self->name($$varhash{"name"});
178 <        $self->version($$varhash{"version"});
179 <        $fh->close();
175 > sub toolbox {
176 >        my $self=shift;
177 >        if ( ! defined $self->{toolbox} ) {
178 >          $self->{toolbox}=BuildSystem::ToolBox->new($self);
179 >        }
180 >        return $self->{toolbox};
181   }
182  
183 < sub name {
183 > sub requirementsdoc {
184          my $self=shift;
185 +        if ( @_ ) {
186 +          $self->{reqdoc}=shift;
187 +        }
188 +        if ( defined $self->{reqdoc} ) {
189 +          return $self->location()."/".$self->{reqdoc};
190 +        }
191 +        else {
192 +          return undef;
193 +        }
194 + }
195  
196 <        @_?$self->{name}=shift
197 <          :$self->{name};
196 > sub scramversion {
197 >        my $self=shift;
198 >        if ( ! defined $self->{scramversion} ) {
199 >          my $filename=$self->location()."/".$self->configurationdir()."/".
200 >                                                        "scram_version";
201 >          if ( -f $filename ) {
202 >            use FileHandle;
203 >            $fh=FileHandle->new();
204 >            open ($fh, "<".$filename);
205 >            my $version=<$fh>;
206 >            chomp $version;
207 >            $self->{scramversion}=$version;
208 >            undef $fh;
209 >          }
210 >        }
211 >        return $self->{scramversion};
212   }
213  
214 < sub version {
214 > sub bootstrapfromlocation {
215          my $self=shift;
216  
217 <        @_?$self->{version}=shift
218 <          :$self->{version};
217 >        my $rv=0;
218 >        
219 >        my $location;
220 >        if ( ! defined ($location=$self->searchlocation(@_)) ) {
221 >         $rv=1;
222 >         $self->verbose("Unable to locate the top of local configuration area");
223 >        }
224 >        else {
225 >         $self->location($location);
226 >         $self->verbose("Found top ".$self->location());
227 >         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
228 >         $self->_LoadEnvFile();
229 >        }
230 >        return $rv;
231   }
232  
233   sub location {
# Line 211 | Line 248 | sub searchlocation {
248  
249          #start search in current directory if not specified
250          my $thispath;
251 <        @_?$thispath=shift
252 <          :$thispath=cwd();
251 >        if ( @_ ) {
252 >          $thispath=shift
253 >        }
254 >        else {
255 >          $thispath=cwd();
256 >        }
257  
258          my $rv=0;
259  
260 +        # chop off any files - we only want dirs
261 +        if ( -f $thispath ) {
262 +          $thispath=~s/(.*)\/.*/$1/;
263 +        }
264          Sloop:{
265          do {
266 < #         print "Searching $thispath\n";
267 <          if ( -e "$thispath/.SCRAM" ) {
268 < #           print "Found\n";
266 >          $self->verbose("Searching $thispath");
267 >          if ( -e "$thispath/".$self->{admindir} ) {
268 >            $self->verbose("Found\n");
269              $rv=1;
270              last Sloop;
271            }
# Line 229 | Line 274 | sub searchlocation {
274          return $rv?$thispath:undef;
275   }
276  
277 < sub meta {
277 > sub archname {
278          my $self=shift;
279 +        if ( @_ ) {
280 +          $self->{archname}=shift;
281 +        }
282 +        return $self->{archname};
283 + }
284  
285 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
286 <                $self->location;
285 > sub archdir {
286 >        my $self=shift;
287 >        if ( @_ ) {
288 >          $self->{archdir}=shift;
289 >        }
290 >        if ( ! defined $self->{archdir} ) {
291 >         if ( defined $self->{archname} ) {
292 >          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
293 >                                                        $self->{archname};
294 >         }
295 >         else {
296 >          $self->error("ConfigArea : cannot create arch directory - ".
297 >                                                "architecture name not set")
298 >         }
299 >        }
300 >        return $self->{archdir};
301   }
302  
303 < sub configitem {
303 > sub satellite {
304          my $self=shift;
305 +
306 +        # -- create the sat object
307 +        my $sat=Configuration::ConfigArea->new();
308 +        $sat->name($self->name());
309 +        $sat->version($self->version());
310 +        $sat->requirementsdoc($self->{reqdoc});
311 +        $sat->configurationdir($self->configurationdir());
312 +        $sat->setup(@_);
313 +
314 +        # -- copy across the cache and ObjectStore
315 +        # -- make sure we dont try building new caches in release areas
316 +        my $rcache=$self->cache("<");
317 +        if ( defined $rcache ) {
318 +          copy($rcache->location(),$sat->cache()->location());
319 +        }
320 +
321 +        # -- make sure we dont try building new objectstores in release areas
322 +        my $rostore=$self->objectstore("<");
323 +        if ( defined $rostore ) {
324 +          copy($rostore->location(),$sat->objectstore()->location());
325 +        }
326 +
327 +        # and make sure in reinitialises
328 +        undef ($sat->{cache});
329 +
330 +        # -- link it to this area
331 +        $sat->linkarea($self);
332          
333 <        return ($self->config()->find("ConfigItem",@_));
333 >        # -- save it
334 >        $sat->save();
335 >
336 >        return $sat;
337   }
338  
339 < sub addconfigitem {
339 > sub copy {
340          my $self=shift;
341 <        my $url=shift;
341 >        my $destination=shift;
342  
343 <        my $docref=$self->activatedoc($url);
344 <        # Set up the document
345 <        $docref->setup();
346 < #       $self->config()->storepolicy("local");
347 <        $docref->save();
343 >        # copy across the admin dir
344 >        my $temp=$self->location()."/".$self->{admindir};
345 >        AddDir::copydir($temp,"$destination/".$self->{admindir});
346 > }
347 >
348 > sub align {
349 >        my $self=shift;
350 >        use File::Copy;
351 >
352 >        $self->_LoadEnvFile();
353 >        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
354 >        my $tmpEnvfile=$Envfile.".bak";
355 >        my $rel=$self->{ENV}{RELEASETOP};
356 >        my $local=$self->location();
357 >
358 >        rename( $Envfile, $tmpEnvfile );
359 >        use FileHandle;
360 >        my $fh=FileHandle->new();
361 >        my $fout=FileHandle->new();
362 >        open ( $fh, "<".$tmpEnvfile ) or
363 >                $self->error("Cannot find Environment file. Area Corrupted? ("
364 >                                .$self->location().")\n $!");
365 >        open ( $fout, ">".$Envfile ) or
366 >                $self->error("Cannot find Environment file. Area Corrupted? ("
367 >                                .$self->location().")\n $!");
368 >        while ( <$fh> ) {
369 >          $_=~s/\Q$rel\L/$local/g;
370 >          print $fout $_;
371 >        }
372 >        undef $fh;
373 >        undef $fout;
374   }
375  
376 < # -------------- Tags ---------------------------------
257 < # -- init parse
258 < sub Project_Start {
376 > sub copysetup {
377          my $self=shift;
378 <        my $name=shift;
261 <        my $hashref=shift;
378 >        my $dest=shift;
379  
380 <        $self->checktag($name,$hashref,'name');
381 <        $self->checktag($name,$hashref,'version');
382 <
383 <        $self->name($$hashref{'name'});
384 <        $self->version($$hashref{'version'});
380 >        my $rv=1;
381 >        # copy across the admin dir
382 >        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
383 >        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
384 >        if ( $temp ne $temp2 ) {
385 >         if ( -d $temp ) {
386 >          AddDir::copydir($temp,$temp2);
387 >          $rv=0;
388 >         }
389 >        }
390 >        return $rv;
391   }
392  
393 + sub copyenv {
394 +        my $self=shift;
395 +        my $hashref=shift;
396 +        
397 +        foreach $elem ( keys %{$self->{ENV}} ) {
398 +           $$hashref{$elem}=$self->{ENV}{$elem};
399 +        }
400 + }
401  
402 < sub Project_text {
402 > sub arch {
403          my $self=shift;
404 <        my $name=shift;
405 <        my $string=shift;
404 >        return $ENV{SCRAM_ARCH};
405 > }
406  
407 <        print $string;
407 > sub linkto {
408 >        my $self=shift;
409 >        my $location=shift;
410 >        if ( -d $location ) {
411 >        my $area=Configuration::ConfigArea->new();
412 >        $area->bootstrapfromlocation($location);
413 >        $self->linkarea($area);
414 >        }
415 >        else {
416 >          $self->error("ConfigArea : Unable to link to non existing directory ".
417 >                         $location);
418 >        }
419   }
420  
421 < # ---- download parse
421 > sub unlinkarea {
422 >        my $self=shift;
423 >        undef $self->{linkarea};
424 >        $self->{linkarea}=undef;
425 >        $self->save();
426 > }
427  
428 < sub Use_download_Start {
428 > sub linkarea {
429          my $self=shift;
430 <        my $name=shift;
431 <        my $hashref=shift;
430 >        my $area=shift;
431 >        if ( defined $area ) {
432 >          $self->{linkarea}=$area;
433 >        }
434 >        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
435 >                        $self->{linkarea}:undef;
436 > }
437  
438 <        $self->checktag($name,$hashref,'url');
439 <        print "Downloading .... ".$$hashref{'url'}."\n";
440 <        $self->getfile($$hashref{'url'});
438 > sub save {
439 >        my $self=shift;
440 >        $self->_SaveEnvFile();
441   }
442  
443 < # --- setup parse
443 > # ---- support routines
444  
445 < sub Use_Start {
445 > sub _SaveEnvFile {
446          my $self=shift;
447 <        my $name=shift;
448 <        my $hashref=shift;
447 >        use FileHandle;
448 >        my $fh=FileHandle->new();
449 >        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
450 >                "Environment" ) or
451 >                $self->error("Cannot Open Environment file to Save ("
452 >                                .$self->location().")\n $!");
453          
454 <        $self->checktag($name,$hashref,'url');
455 <        $self->addconfigitem($$hashref{'url'});
454 >        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
455 >        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
456 >        print $fh "projconfigdir=".$self->configurationdir()."\n";
457 >        print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
458 >        if ( defined $self->linkarea() ) {
459 >          my $area=$self->linkarea()->location();
460 >          if ( $area ne "" ) {
461 >          print $fh "RELEASETOP=".$area."\n";
462 >          }
463 >        }
464 >        undef $fh;
465   }
466  
467 +
468 + sub _LoadEnvFile {
469 +        my $self=shift;
470 +
471 +        use FileHandle;
472 +        my $fh=FileHandle->new();
473 +        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
474 +                "Environment" ) or
475 +                $self->error("Cannot find Environment file. Area Corrupted? ("
476 +                                .$self->location().")\n $!");
477 +        while ( <$fh> ) {
478 +           chomp;
479 +           next if /^#/;
480 +           next if /^\s*$/ ;
481 +           ($name, $value)=split /=/;
482 +           eval "\$self->{ENV}{${name}}=\"$value\"";
483 +        }
484 +        undef $fh;
485 +        
486 +        # -- set internal variables appropriately
487 +        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
488 +          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
489 +        }
490 +        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
491 +          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
492 +        }
493 +        if ( defined $self->{ENV}{"projconfigdir"} ) {
494 +          $self->configurationdir($self->{ENV}{projconfigdir});
495 +        }
496 +        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
497 +          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
498 +        }
499 +        if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
500 +                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
501 +          $self->linkto($self->{ENV}{"RELEASETOP"});
502 +        }
503 +        else {
504 +          $self->{ENV}{"RELEASETOP"}=$self->location();
505 +        }
506 + }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines