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.11 by williamc, Thu Feb 24 14:24:29 2000 UTC vs.
Revision 1.26 by sashby, Wed Feb 2 18:57:01 2005 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 < # 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(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
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
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 - defaults to cwd/default
31 < #                                 if not specified . ConfigArea_name,
32 < #                                 ConfigArea_location also override .
33 < #                                 Return an object representing the area
34 < # satellite()                   : make a satellite area based on $self
35 < # arch([archobj])               : Set/get the architecture object
36 < # structure(name)               : return the object corresponding to the
37 < #                                 structure name
38 < # structurelist()               : return list of structure objectS
39 < # downloadtotop(dir,url)        : download the url to a dir in the config area
40 < #                                
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])        : 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;
50 use ActiveDoc::ActiveDoc;
49   require 5.004;
50 + use URL::URLcache;
51   use Utilities::AddDir;
52 + use Utilities::Verbose;
53   use ObjectUtilities::ObjectStore;
54 use Configuration::ConfigStore;
55 use Configuration::ActiveDoc_arch;
54   use Cwd;
55 < @ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject);
55 > @ISA=qw(Utilities::Verbose);
56  
57 < sub init {
58 <        my $self=shift;
59 <
60 <        $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_tools","use",\&Use_Start,$self, "", $self, "",$self);
77 <        $self->addtag("setup","structure",\&Structure_Start,$self,
78 <                         "", $self, "",$self);
57 > sub new {
58 >        my $class=shift;
59 >        my $self={};
60 >        bless $self, $class;
61  
62          # data init
63 <        $self->{admindir}=".SCRAM";
63 >        $self->{admindir}=".SCRAM";
64 >        $self->{cachedir}="cache";
65 >        $self->{dbdir}="ObjectDB";
66 >        $self->{tbupdate}=0;
67 >        undef $self->{linkarea};
68 >
69 >        return $self;
70   }
71  
72 < sub basearea {
72 > sub cache {
73          my $self=shift;
74  
87        my $area;
75          if ( @_ ) {
76 <          $area=shift;
90 <          $self->config()->store($area,"BaseArea");
76 >           $self->{cache}=shift;
77          }
78 <        else {
79 <          ($area)=$self->config()->restore("BaseArea");
78 >        if ( ! defined $self->{cache} ) {
79 >          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
80 >          if ( -e $loc  ) {
81 >            $self->{cache}=URL::URLcache->new($loc);
82 >          }
83 >          else {
84 >            $self->{cache}=undef;
85 >          }
86          }
87 <        return $area;
87 >        return $self->{cache};
88   }
89  
90 < sub freebase {
90 > # Tool and project cache info:
91 > sub cacheinfo
92 >   {
93 >   my $self=shift;
94 >   print "\n","<ConfigArea> cacheinfo: ToolCache = ",$self->{toolcachefile},
95 >   ", ProjectCache = ",$self->{projectcachefile},"\n";
96 >   }
97 >
98 > sub toolcachename
99 >   {
100 >   my $self=shift;
101 >   return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ToolCache.db");
102 >   }
103 >
104 > sub projectcachename
105 >   {
106 >   my $self=shift;
107 >   return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ProjectCache.db");
108 >   }
109 >
110 > sub _tbupdate
111 >   {
112 >   # Update toolbox relative to new RequirementsDoc:
113 >   my $self=shift;
114 >   @_?$self->{tbupdate}=shift
115 >      :$self->{tbupdate};
116 >   }
117 >
118 > sub _newcache {
119          my $self=shift;
120 <        $self->config()->delete("BaseArea");
120 >        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
121 >        $self->{cache}=URL::URLcache->new($loc);
122 >        return $self->{cache};
123   }
124  
125 < sub defaultdirname {
125 > sub _newobjectstore {
126          my $self=shift;
127 <        my $name=$self->name();
128 <        my $vers=$self->version();
129 <        $vers=~s/^$name\_//;
108 <        $name=$name."_".$vers;
109 <        return $name;
127 >        my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
128 >        $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
129 >        return $self->{dbstore};
130   }
131  
132 <
113 < sub setup {
132 > sub objectstore {
133          my $self=shift;
134  
135 <        # --- find out the location - default is cwd
136 <        my $location=$self->option("ConfigArea_location");
118 <        if ( ! defined $location ) {
119 <                $location=cwd();
120 <        }
121 <        elsif ( $location!~/^\// ) {
122 <                $location=cwd()."/".$location;
135 >        if ( @_ ) {
136 >            $self->{dbstore}=shift;
137          }
138 <
139 <        # --- find area directory name , default name projectname_version
140 <        my $name=$self->option("ConfigArea_name");
141 <        if ( ! defined $name ) {
142 <          $name=$self->defaultdirname();
138 >        if ( ! defined $self->{dbstore} ) {
139 >          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
140 >          if ( -e $loc ) {
141 >            $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
142 >          }
143 >          else {
144 >            $self->{dbstore}=undef;
145 >          }
146          }
147 <        $self->location($location."/".$name);
131 <
132 <        # make a new store handler
133 <        $self->_setupstore();
134 <
135 <        # --- download everything first
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());
147 >        return $self->{dbstore}
148   }
149  
150 < sub structure {
150 > sub name {
151          my $self=shift;
152 <        my $vr=shift;
153 <        return $self->{structures}{$vr};
152 >        @_?$self->{name}=shift
153 >          :$self->{name};
154   }
155  
156 < sub structurelist {
156 > sub version {
157          my $self=shift;
158 <        return ( keys %{$self->{structures}} );
158 >        @_?$self->{version}=shift
159 >          :$self->{version};
160   }
161  
162 < sub _setupstore {
162 > sub setup {
163          my $self=shift;
164 +        my $location=shift;
165 +        my $areaname;
166 +
167 +        # -- check we have a project name and version
168 +        my $name=$self->name();
169 +        my $vers=$self->version();
170 +        
171 +        if ( ( ! defined $name ) && ( ! defined $version )) {
172 +          $self->error("Set ConfigArea name and version before setup");
173 +        }
174  
175 <        # --- make a new ConfigStore at the location and add it to the db list
176 <        my $ad=Configuration::ConfigStore->new($self->location().
177 <                                "/".$self->{admindir}, $self->arch());
175 >        # -- check arguments and set location
176 >        if ( ! defined $location ) {
177 >          $self->error("ConfigArea: Cannot setup new area without a location");
178 >        }
179 >        if ( @_ ) {
180 >          $areaname=shift;
181 >        }
182 >        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
183 >          # -- make up a name from the project name and version
184 >          $vers=~s/^$name\_//;
185 >          $areaname=$name."_".$vers;
186 >        }
187 >        my $arealoc=$location."/".$areaname;
188 >        my $workloc=$arealoc."/".$self->{admindir};
189 >        $self->verbose("Building at $arealoc");
190 >        $self->location($arealoc);
191 >
192 >        # -- create top level structure and work area
193 >        AddDir::adddir($workloc);
194 >
195 >        # -- add a cache
196 >        $self->_newcache();
197 >
198 >        # -- add an Objectstore
199 >        $self->_newobjectstore();
200 >
201 >        # -- Save Environment File
202 >        $self->_SaveEnvFile();
203  
168        $self->parentconfig($self->config());
169 #        $self->config(Configuration::ConfigureStore->new());
170 #        $self->config()->db("local",$ad);
171 #        $self->config()->db("parent",$self->parentconfig());
172 #        $self->config()->policy("cache","local");
173        $self->config($ad);
174        $self->config()->basedoc($self->parentconfig()->basedoc());
204   }
205  
206 < sub bootstrapfromlocation {
206 > sub configurationdir {
207          my $self=shift;
208 <        
209 <        if ( ! defined $self->location(@_) ) {
181 <          $self->error("Unable to locate the top of local configuration area");
208 >        if ( @_ ) {
209 >          $self->{configurationdir}=shift;
210          }
211 <        print "Found top ".$self->location()."\n";
184 <        $self->_setupstore();
185 <        $self->restore($self->location()."/".$self->{admindir}.
186 <                                                "/ConfigArea.dat");
211 >        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
212   }
213  
214 < sub parentconfig {
214 > sub sourcedir {
215          my $self=shift;
216 <        @_?$self->{parentconfig}=shift
217 <          :$self->{parentconfig};
216 >        if ( @_ ) {
217 >          $self->{sourcedir}=shift;
218 >        }
219 >        return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
220   }
221  
222 < sub store {
222 > sub toolbox {
223          my $self=shift;
224 <        my $location=shift;
225 <
226 <        my $fh=$self->openfile(">".$location);
227 <        $self->savevar($fh,"location", $self->location());
201 <        $self->savevar($fh,"url", $self->url());
202 <        $self->savevar($fh,"name", $self->name());
203 <        $self->savevar($fh,"version", $self->version());
204 <        $fh->close();
205 <
206 <        $self->_storestructures();
224 >        if ( ! defined $self->{toolbox} ) {
225 >          $self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH});
226 >        }
227 >        return $self->{toolbox};
228   }
229  
230 < sub satellite {
230 > sub toolboxversion {
231          my $self=shift;
232 <        my $newarea=$self->copy(@_);
233 <        $newarea->_makesatellites();
234 <        return $newarea;
232 >        if ( @_ ) {
233 >          $self->{toolboxversion}=shift;
234 >        }
235 >        return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef;
236   }
237  
238 < sub copy {
238 > sub requirementsdoc {
239          my $self=shift;
218        use File::Basename;
219        # create the area
220
221        my $destination;
240          if ( @_ ) {
241 <         $destination=shift;
241 >          $self->{reqdoc}=shift;
242 >        }
243 >        if ( defined $self->{reqdoc} ) {
244 >          return $self->location()."/".$self->{reqdoc};
245          }
246          else {
247 <          my($location,$name)=$self->_defaultoptions();
227 <          $destination=$location."/".$name
247 >          return undef;
248          }
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;
249   }
250  
251 < sub restore {
251 > sub scramversion {
252          my $self=shift;
253 <        my $location=shift;
254 <
255 <        my $fh=$self->openfile("<".$location);
256 <        my $varhash={};
257 <        $self->restorevars($fh,$varhash);
258 <        if ( ! defined $self->location() ) {
259 <          $self->location($$varhash{"location"});
260 <        }
261 <        $self->_setupstore();
262 <        $self->url($$varhash{"url"});
263 <        $self->name($$varhash{"name"});
264 <        $self->version($$varhash{"version"});
265 <        $fh->close();
266 <
260 <        $self->_restorestructures();
253 >        if ( ! defined $self->{scramversion} ) {
254 >          my $filename=$self->location()."/".$self->configurationdir()."/".
255 >                                                        "scram_version";
256 >          if ( -f $filename ) {
257 >            use FileHandle;
258 >            $fh=FileHandle->new();
259 >            open ($fh, "<".$filename);
260 >            my $version=<$fh>;
261 >            chomp $version;
262 >            $self->{scramversion}=$version;
263 >            undef $fh;
264 >          }
265 >        }
266 >        return $self->{scramversion};
267   }
268  
269 < sub name {
270 <        my $self=shift;
269 > sub sitename
270 >   {
271 >   ###############################################################
272 >   # sitename()                                                  #
273 >   ###############################################################
274 >   # modified : Mon Dec  3 15:45:35 2001 / SFA                   #
275 >   # params   :                                                  #
276 >   #          :                                                  #
277 >   #          :                                                  #
278 >   #          :                                                  #
279 >   # function : Read the site name from config/site/sitename and #
280 >   #          : export it.                                       #
281 >   #          :                                                  #
282 >   #          :                                                  #
283 >   ###############################################################
284 >   my $self = shift;
285 >   my $sitefile = $self->location()."/".$self->configurationdir()."/site/sitename";
286 >
287 >   $self->{sitename} = 'CERN'; # Use CERN as the default site name
288 >
289 >   use FileHandle;
290 >   my $sitefh = FileHandle->new();
291 >
292 >   # Be verbose and print file we're going to read:
293 >   $self->verbose(">> Going to try to get sitename from: ".$sitefile." ");
294 >  
295 >   # See if we can read from the file. If not, just
296 >   # use default site name:
297 >   open($sitefh,"<".$sitefile) ||
298 >      do
299 >         {
300 >         $self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name.");
301 >         return $self->{sitename};
302 >         };
303 >  
304 >   $sitename = <$sitefh>;
305 >   chomp($sitename);
306 >   $self->{sitename} = $sitename;
307 >  
308 >   # Close the file (be tidy!);
309 >   close($sitefile);
310 >   # Return:
311 >   return $self->{sitename};
312 >   }
313  
266        @_?$self->{name}=shift
267          :$self->{name};
268 }
314  
315 < sub version {
315 > sub bootstrapfromlocation {
316          my $self=shift;
317  
318 <        @_?$self->{version}=shift
319 <          :$self->{version};
318 >        my $rv=0;
319 >        
320 >        my $location;
321 >        if ( ! defined ($location=$self->searchlocation(@_)) ) {
322 >         $rv=1;
323 >         $self->verbose("Unable to locate the top of local configuration area");
324 >        }
325 >        else {
326 >         $self->location($location);
327 >         $self->verbose("Found top ".$self->location());
328 >         $self->_LoadEnvFile();
329 >        }
330 >        return $rv;
331   }
332  
333   sub location {
# Line 289 | Line 345 | sub location {
345  
346   sub searchlocation {
347          my $self=shift;
348 <
348 >        
349          #start search in current directory if not specified
350          my $thispath;
351 <        @_?$thispath=shift
352 <          :$thispath=cwd();
353 <
351 >        if ( @_ ) {
352 >          $thispath=shift
353 >        }
354 >        else {
355 >          $thispath=cwd();
356 >        }
357 >        
358          my $rv=0;
359  
360 +        # chop off any files - we only want dirs
361 +        if ( -f $thispath ) {
362 +          $thispath=~s/(.*)\/.*/$1/;
363 +        }
364          Sloop:{
365          do {
366 < #         print "Searching $thispath\n";
366 >          $self->verbose("Searching $thispath");
367            if ( -e "$thispath/".$self->{admindir} ) {
368 < #           print "Found\n";
368 >            $self->verbose("Found\n");
369              $rv=1;
370              last Sloop;
371            }
372          } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
373 <
373 >      
374          return $rv?$thispath:undef;
375   }
376  
377 < sub meta {
377 > sub archname {
378          my $self=shift;
379 <
380 <        my $string=$self->name()." ".$self->version()." located at :\n  ".
381 <                $self->location;
379 >        if ( @_ ) {
380 >          $self->{archname}=shift;
381 >        }
382 >        return $self->{archname};
383   }
384  
385 < sub configitem {
385 > sub archdir {
386          my $self=shift;
387 <        
388 <        return ($self->config()->find("ConfigItem",@_));
387 >        if ( @_ ) {
388 >          $self->{archdir}=shift;
389 >        }
390 >        if ( ! defined $self->{archdir} ) {
391 >         if ( defined $self->{archname} ) {
392 >          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
393 >                                                        $self->{archname};
394 >         }
395 >         else {
396 >          $self->error("ConfigArea : cannot create arch directory - ".
397 >                                                "architecture name not set")
398 >         }
399 >        }
400 >        return $self->{archdir};
401   }
402  
403 < sub addconfigitem {
403 > sub satellite {
404          my $self=shift;
328        my $url=shift;
405  
406 <        my $docref=$self->activatedoc($url);
407 <        # Set up the document
408 <        $docref->setup();
409 <        $docref->save();
410 < #       $self->config()->storepolicy("local");
411 < }
406 >        # -- create the sat object
407 >        my $sat=Configuration::ConfigArea->new();
408 >        $sat->name($self->name());
409 >        $sat->version($self->version());
410 >        $sat->requirementsdoc($self->{reqdoc});
411 >        $sat->configurationdir($self->configurationdir());
412 >        $sat->sourcedir($self->sourcedir());
413 >        $sat->toolboxversion($self->toolboxversion());
414 >        $sat->setup(@_);
415 >
416 >        # -- copy across the cache and ObjectStore
417 >        # -- make sure we dont try building new caches in release areas
418 >        my $rcache=$self->cache();
419 >        if ( defined $rcache ) {
420 >          copy($rcache->location(),$sat->cache()->location());
421 >        }
422 >
423 >        # -- make sure we dont try building new objectstores in release areas
424 >        my $rostore=$self->objectstore();
425 >        if ( defined $rostore ) {
426 >          copy($rostore->location(),$sat->objectstore()->location());
427 >        }
428  
429 < sub downloadtotop {
430 <        my $self=shift;
431 <        my $url=shift;
432 <        my $dir=shift;
429 >        # and make sure in reinitialises
430 >        undef ($sat->{cache});
431 >
432 >        # -- link it to this area
433 >        $sat->linkarea($self);
434          
435 <        # only download once
436 <        if ( ! -e $self->location()."/".$dir ) {
437 <          $self->{urlhandler}->download($url,$self->location()."/".$dir);
438 <        }
435 >        # -- save it
436 >        $sat->save();
437 >
438 >        return $sat;
439   }
440  
441 < sub _makesatellites {
441 > sub copy {
442          my $self=shift;
443 <        foreach $st ( values %{$self->{structures}} ) {
444 <           $st->setupsatellite()
445 <        }
443 >        my $destination=shift;
444 >
445 >        # copy across the admin dir
446 >        my $temp=$self->location()."/".$self->{admindir};
447 >        AddDir::copydir($temp,"$destination/".$self->{admindir});
448   }
449  
450 < sub _storestructures {
450 > sub align {
451          my $self=shift;
452 <        foreach $struct ( values %{$self->{structures}} ) {
453 <          $self->config()->store($struct, "Structures", $struct->name());
452 >        use File::Copy;
453 >
454 >        $self->_LoadEnvFile();
455 >        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
456 >        my $tmpEnvfile=$Envfile.".bak";
457 >        my $rel=$self->{ENV}{RELEASETOP};
458 >        my $local=$self->location();
459 >
460 >        rename( $Envfile, $tmpEnvfile );
461 >        use FileHandle;
462 >        my $fh=FileHandle->new();
463 >        my $fout=FileHandle->new();
464 >        open ( $fh, "<".$tmpEnvfile ) or
465 >                $self->error("Cannot find Environment file. Area Corrupted? ("
466 >                                .$self->location().")\n $!");
467 >        open ( $fout, ">".$Envfile ) or
468 >                $self->error("Cannot find Environment file. Area Corrupted? ("
469 >                                .$self->location().")\n $!");
470 >        while ( <$fh> ) {
471 >          $_=~s/\Q$rel\L/$local/g;
472 >          print $fout $_;
473          }
474 +        undef $fh;
475 +        undef $fout;
476   }
477  
478 < sub _restorestructures {
478 > sub copysetup {
479          my $self=shift;
480 <        my @strs=$self->config()->find("Structures");
481 <        foreach $struct ( @strs ) {
482 <          $struct->parent($self);
483 <          $self->{structures}{$struct->name()}=$struct;
480 >        my $dest=shift;
481 >        my $rv=1;
482 >        # copy across the admin dir
483 >        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
484 >        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
485 >        if ( $temp ne $temp2 ) {
486 >         if ( -d $temp ) {
487 >          AddDir::copydir($temp,$temp2);
488 >          $rv=0;
489 >         }
490          }
491 +        return $rv;
492   }
493  
494 < sub _defaultoptions {
494 > sub copyurlcache {
495          my $self=shift;
496 <        my $name;
497 <        my $location;
498 <
499 <        # --- find out the location - default is cwd
500 <        $location=$self->option("ConfigArea_location");
501 <        if ( ! defined $location ) {
502 <                $location=cwd();
503 <        }
504 <        elsif ( $location!~/^\// ) {
505 <                $location=cwd()."/".$location;
506 <        }
507 <
508 <        # --- find area directory name , default name projectname_version
509 <        $name=$self->option("ConfigArea_name");
510 <        if ( ! defined $name ) {
511 <          $name=$self->defaultdirname();
512 <        }
513 <        return ($location,$name);
496 >        my $dest=shift;
497 >        my $rv=1;
498 >        # copy across the admin dir
499 >        my $temp=$self->location()."/".$self->{admindir}."/cache";
500 >        my $temp2=$dest."/".$self->{admindir}."/cache";
501 >        if ( $temp ne $temp2 ) {
502 >         if ( -d $temp ) {
503 >          AddDir::copydir($temp,$temp2);
504 >          $rv=0;
505 >         }
506 >        }
507 >        return $rv;
508 > }
509 >
510 > sub copywithskip {
511 >        my $self=shift;
512 >        my $dest=shift;
513 >        my ($filetoskip)=@_;            
514 >        my $rv=1;
515 >        # copy across the admin dir
516 >        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
517 >        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
518 >        if ( $temp ne $temp2 ) {
519 >         if ( -d $temp ) {
520 >          AddDir::copydirwithskip($temp,$temp2,$filetoskip);
521 >          $rv=0;
522 >         }
523 >        }
524 >        return $rv;
525   }
526 < # -------------- Tags ---------------------------------
527 < # -- init parse
394 < sub Project_Start {
526 >
527 > sub copyenv {
528          my $self=shift;
396        my $name=shift;
529          my $hashref=shift;
530 <
531 <        $self->checktag($name,$hashref,'name');
532 <        $self->checktag($name,$hashref,'version');
533 <
402 <        $self->name($$hashref{'name'});
403 <        $self->version($$hashref{'version'});
530 >        
531 >        foreach $elem ( keys %{$self->{ENV}} ) {
532 >           $$hashref{$elem}=$self->{ENV}{$elem};
533 >        }
534   }
535  
536 <
407 < sub Project_text {
536 > sub arch {
537          my $self=shift;
538 <        my $name=shift;
410 <        my $string=shift;
411 <
412 <        print $string;
538 >        return $ENV{SCRAM_ARCH};
539   }
540  
541 < # ---- download parse
416 <
417 < sub Download_Start {
541 > sub linkto {
542          my $self=shift;
543 <        my $name=shift;
420 <        my $hashref=shift;
543 >        my $location=shift;
544  
545 <        $self->checktag($name,$hashref,'url');
546 <        $self->checktag($name,$hashref,'location');
547 <        if ( $$hashref{'location'}!~/^\w/ ) {
548 <          $self->parseerror("location must start with an".
549 <                " alphanumeric character");
545 >        if ( -d $location ) {
546 >        my $area=Configuration::ConfigArea->new();
547 >        $area->bootstrapfromlocation($location);
548 >        $self->linkarea($area);
549 >        }
550 >        else {
551 >          $self->error("ConfigArea : Unable to link to non existing directory ".
552 >                         $location);
553          }
428        print "Downloading .... ".$$hashref{'url'}."\n";
429        $self->downloadtotop($$hashref{'url'},$$hashref{'location'});
554   }
555  
556 < sub Use_download_Start {
556 > sub unlinkarea {
557          my $self=shift;
558 <        my $name=shift;
559 <        my $hashref=shift;
560 <
437 <        $self->checktag($name,$hashref,'url');
438 <        print "Downloading .... ".$$hashref{'url'}."\n";
439 <        $self->getfile($$hashref{'url'});
558 >        undef $self->{linkarea};
559 >        $self->{linkarea}=undef;
560 >        $self->save();
561   }
562  
563 < # --- setup parse
443 <
444 < sub Structure_Start {
563 > sub linkarea {
564          my $self=shift;
565 <        my $name=shift;
566 <        my $hashref=shift;
567 <
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'});
565 >        my $area=shift;
566 >        if ( defined $area ) {
567 >          $self->{linkarea}=$area;
568          }
569 +        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
570 +                        $self->{linkarea}:undef;
571   }
572  
573 < sub Use_Start {
573 > sub save {
574          my $self=shift;
575 <        my $name=shift;
483 <        my $hashref=shift;
484 <        
485 <        $self->checktag($name,$hashref,'url');
486 <        $self->addconfigitem($$hashref{'url'});
575 >        $self->_SaveEnvFile();
576   }
577  
578 + # ---- support routines
579 +
580 + sub _SaveEnvFile
581 +   {
582 +   my $self=shift;
583 +   my $filemode = 0644;
584 +  
585 +   use FileHandle;
586 +   my $fh=FileHandle->new();
587 +   open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
588 +          "Environment" ) or
589 +          $self->error("Cannot Open Environment file to Save ("
590 +                       .$self->location().")\n $!");
591 +        
592 +   print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
593 +   print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
594 +   print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n";
595 +   print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n";
596 +   print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
597 +   print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n";
598 +
599 +   if ( defined $self->linkarea() )
600 +      {
601 +      my $area=$self->linkarea()->location();
602 +      if ( $area ne "" )
603 +         {
604 +         print $fh "RELEASETOP=".$area."\n";
605 +         }
606 +      }
607 +  
608 +   undef $fh;
609 +  
610 +   # Set the default permissions (-rw-r--r--):
611 +   chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
612 +   }
613 +
614 + sub _LoadEnvFile
615 +   {
616 +   my $self=shift;
617 +
618 +   use FileHandle;
619 +   my $fh=FileHandle->new();
620 +   open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
621 +          "Environment" ) or
622 +          $self->error("Cannot find Environment file. Area Corrupted? ("
623 +                       .$self->location().")\n $!");
624 +   while ( <$fh> )
625 +      {
626 +      chomp;
627 +      next if /^#/;
628 +      next if /^\s*$/ ;
629 +      ($name, $value)=split /=/;
630 +      eval "\$self->{ENV}{${name}}=\"$value\"";
631 +      }
632 +   undef $fh;
633 +        
634 +   # -- set internal variables appropriately
635 +   if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} )
636 +      {
637 +      $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
638 +      }
639 +   if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} )
640 +      {
641 +      $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
642 +      }
643 +   if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} )
644 +      {
645 +      $self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"});
646 +      }
647 +   if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} )
648 +      {
649 +      $self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
650 +      }
651 +   if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} )
652 +      {
653 +      $self->requirementsdoc($self->{ENV}{"SCRAM_ProjReqsDoc"});
654 +      }
655 +   if ( defined $self->{ENV}{"SCRAM_TOOLBOXVERSION"} )
656 +      {
657 +      $self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"});
658 +      }
659 +  
660 +   if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
661 +        ($self->{ENV}{"RELEASETOP"} ne $self->location()))
662 +      {
663 +      $self->linkto($self->{ENV}{"RELEASETOP"});
664 +      }
665 +   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines