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.13.2.6 by williamc, Tue May 16 14:03:02 2000 UTC vs.
Revision 1.13.2.6.2.7.2.1 by williamc, Thu Sep 21 12:44:42 2000 UTC

# Line 7 | Line 7
7   # -----------
8   # creates and manages a configuration area
9   #
10 < # Options
10 > # Notes
11   # -------
12 < # ConfigArea_location
13 < # ConfigArea_name
12 > # Persistency - remember to call the save method to make changes persistent
13   #
14   # Interface
15   # ---------
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
# Line 22 | Line 25
25   # requirementsdoc()             : get set the requirements doc
26   # searchlocation([startdir])    : returns the location directory. search starts
27   #                                 from cwd if not specified
25 – # defaultdirname()              : return the default directory name string
28   # scramversion()                : return the scram version associated with
29   #                                 area
30   # configurationdir()            : return the location of the project
# Line 32 | Line 34
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])        : link 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   # - temporary
46   # align()                       : adjust hard paths to suit local loaction
47  
48   package Configuration::ConfigArea;
49   require 5.004;
50 + use URL::URLcache;
51   use Utilities::AddDir;
52   use Utilities::Verbose;
53 + use ObjectUtilities::ObjectStore;
54   use Cwd;
55   @ISA=qw(Utilities::Verbose);
56  
# Line 49 | Line 61 | sub new {
61  
62          # data init
63          $self->{admindir}=".SCRAM";
64 +        $self->{cachedir}="cache";
65 +        $self->{dbdir}="ObjectDB";
66 +        undef $self->{linkarea};
67  
68          return $self;
69   }
70  
71 + sub cache {
72 +        my $self=shift;
73 +
74 +        my $exist=0;
75 +        if ( @_ ) {
76 +          my $cache=shift;
77 +          if ( $cache!~/^</ ) {
78 +            $self->{cache}=$cache;
79 +          }
80 +          $exist=1;
81 +        }
82 +        elsif ( ! defined $self->{cache} ) {
83 +          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
84 +          if ( ! $exist ) {
85 +            $self->{cache}=URL::URLcache->new($loc);
86 +          }
87 +        }
88 +        return $self->{cache};
89 + }
90 +
91 + sub objectstore {
92 +        my $self=shift;
93 +
94 +        my $exist="";
95 +        if ( @_ ) {
96 +          my $db=shift;
97 +          if ( $db!~/^</ ) {
98 +            $self->{dbstore}=cache;
99 +          }
100 +          $exist="<";
101 +        }
102 +        elsif ( ! defined $self->{dbstore} ) {
103 +          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
104 +          $self->{dbstore}=ObjectUtilities::ObjectStore->new($exist.$loc);
105 +        }
106 +        return $self->{dbstore}
107 + }
108 +
109 + sub name {
110 +        my $self=shift;
111 +        @_?$self->{name}=shift
112 +          :$self->{name};
113 + }
114 +
115 + sub version {
116 +        my $self=shift;
117 +        @_?$self->{version}=shift
118 +          :$self->{version};
119 + }
120 +
121 + sub setup {
122 +        my $self=shift;
123 +        my $location=shift;
124 +        my $areaname;
125 +
126 +        # -- check we have a project name and version
127 +        my $name=$self->name();
128 +        my $vers=$self->version();
129 +        if ( ( ! defined $name ) && ( ! defined $version )) {
130 +          $self->error("Set ConfigArea name and version before setup");
131 +        }
132 +
133 +        # -- check arguments and set location
134 +        if ( ! defined $location ) {
135 +          $self->error("ConfigArea: Cannot setup new area without a location");
136 +        }
137 +        if ( @_ ) {
138 +          $areaname=shift;
139 +        }
140 +        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
141 +          # -- make up a name from the project name and version
142 +          $vers=~s/^$name\_//;
143 +          $areaname=$name."_".$vers;
144 +        }
145 +        my $arealoc=$location."/".$areaname;
146 +        my $workloc=$arealoc."/".$self->{admindir};
147 +        $self->verbose("Building at $arealoc");
148 +        $self->location($arealoc);
149 +
150 +        # -- create top level structure and work area
151 +        AddDir::adddir($workloc);
152 +
153 +        # -- add a cache
154 +        $self->cache();
155 +
156 +        # -- Save Environment File
157 +        $self->_SaveEnvFile();
158 +
159 + }
160 +
161   sub configurationdir {
162          my $self=shift;
163          if ( @_ ) {
164            $self->{configurationdir}=shift;
165          }
166 <        if ( ! defined $self->{configurationdir} ) {
62 <          $self->_LoadEnvFile();
63 <          $self->{configurationdir}=$self->{ENV}{projconfigdir};
64 <        }
65 <        return $self->{configurationdir};
166 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
167   }
168  
169   sub toolbox {
# Line 78 | Line 179 | sub requirementsdoc {
179          if ( @_ ) {
180            $self->{reqdoc}=shift;
181          }
182 <        if ( ! defined $self->{reqdoc} ) {
183 <          $self->_LoadEnvFile();
184 <          $self->{reqdoc}=$self->{ENV}{SCRAM_ProjReqsDoc};
182 >        if ( defined $self->{reqdoc} ) {
183 >          return $self->location()."/".$self->{reqdoc};
184 >        }
185 >        else {
186 >          return undef;
187          }
85 –        return $self->{reqdoc};
188   }
189  
190   sub scramversion {
# Line 166 | Line 268 | sub searchlocation {
268          return $rv?$thispath:undef;
269   }
270  
271 + sub archname {
272 +        my $self=shift;
273 +        if ( @_ ) {
274 +          $self->{archname}=shift;
275 +        }
276 +        return $self->{archname};
277 + }
278 +
279 + sub archdir {
280 +        my $self=shift;
281 +        if ( @_ ) {
282 +          $self->{archdir}=shift;
283 +        }
284 +        if ( ! defined $self->{archdir} ) {
285 +         if ( defined $self->{archname} ) {
286 +          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
287 +                                                        $self->{archname};
288 +         }
289 +         else {
290 +          $self->error("ConfigArea : cannot create arch directory - ".
291 +                                                "architecture name not set")
292 +         }
293 +        }
294 +        return $self->{archdir};
295 + }
296 +
297 + sub satellite {
298 +        my $self=shift;
299 +
300 +        # -- create the sat object
301 +        my $sat=Configuration::ConfigArea->new();
302 +        $sat->name($self->name());
303 +        $sat->version($self->version());
304 +        $sat->requirementsdoc($self->{reqdoc});
305 +        $sat->configurationdir($self->configurationdir());
306 +        $sat->setup(@_);
307 +
308 +        # -- copy across the cache and ObjectStore
309 +        # -- make sure we dont try building new caches in release areas
310 +        my $rcache=$self->cache("<");
311 +        if ( defined $rcache ) {
312 +          copy($rcache->location(),$sat->cache()->location());
313 +        }
314 +
315 +        # -- make sure we dont try building new objectstores in release areas
316 +        my $rostore=$self->objectstore("<");
317 +        if ( defined $rostore ) {
318 +          copy($rostore->location(),$sat->objectstore()->location());
319 +        }
320 +
321 +        # and make sure in reinitialises
322 +        undef ($sat->{cache});
323 +
324 +        # -- link it to this area
325 +        $sat->linkarea($self);
326 +        
327 +        # -- save it
328 +        $sat->save();
329 +
330 +        return $sat;
331 + }
332 +
333   sub copy {
334          my $self=shift;
335          my $destination=shift;
# Line 234 | Line 398 | sub arch {
398          return $ENV{SCRAM_ARCH};
399   }
400  
401 + sub linkto {
402 +        my $self=shift;
403 +        my $location=shift;
404 +        if ( -d $location ) {
405 +        my $area=Configuration::ConfigArea->new();
406 +        $area->bootstrapfromlocation($location);
407 +        $self->linkarea($area);
408 +        }
409 +        else {
410 +          $self->error("ConfigArea : Unable to link to non existing directory ".
411 +                         $location);
412 +        }
413 + }
414 +
415 + sub unlinkarea {
416 +        my $self=shift;
417 +        undef $self->{linkarea};
418 +        $self->{linkarea}=undef;
419 +        $self->save();
420 + }
421 +
422 + sub linkarea {
423 +        my $self=shift;
424 +        my $area=shift;
425 +        if ( defined $area ) {
426 +          $self->{linkarea}=$area;
427 +        }
428 +        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
429 +                        $self->{linkarea}:undef;
430 + }
431 +
432 + sub save {
433 +        my $self=shift;
434 +        $self->_SaveEnvFile();
435 + }
436 +
437   # ---- support routines
438 +
439 + sub _SaveEnvFile {
440 +        my $self=shift;
441 +        use FileHandle;
442 +        my $fh=FileHandle->new();
443 +        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
444 +                "Environment" ) or
445 +                $self->error("Cannot Open Environment file to Save ("
446 +                                .$self->location().")\n $!");
447 +        
448 +        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
449 +        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
450 +        print $fh "projconfigdir=".$self->configurationdir()."\n";
451 +        print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
452 +        if ( defined $self->linkarea() ) {
453 +          my $area=$self->linkarea()->location();
454 +          if ( $area ne "" ) {
455 +          print $fh "RELEASETOP=".$area."\n";
456 +          }
457 +        }
458 +        undef $fh;
459 + }
460 +
461 +
462   sub _LoadEnvFile {
463          my $self=shift;
464  
# Line 252 | Line 476 | sub _LoadEnvFile {
476             eval "\$self->{ENV}{${name}}=\"$value\"";
477          }
478          undef $fh;
479 +        
480 +        # -- set internal variables appropriately
481 +        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
482 +          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
483 +        }
484 +        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
485 +          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
486 +        }
487 +        if ( defined $self->{ENV}{"projconfigdir"} ) {
488 +          $self->configurationdir($self->{ENV}{projconfigdir});
489 +        }
490 +        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
491 +          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
492 +        }
493 +        if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
494 +                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
495 +          $self->linkto($self->{ENV}{"RELEASETOP"});
496 +        }
497 +        else {
498 +          $self->{ENV}{"RELEASETOP"}=$self->location();
499 +        }
500   }

Diff Legend

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