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.17 by williamc, Thu Sep 21 14:25:06 2000 UTC vs.
Revision 1.29 by sashby, Thu Mar 10 12:39:28 2005 UTC

# Line 37 | Line 37
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
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 < #                                 if called with temp - will set as undef
46 < #                                 if it dosnt already exist - otherwise will
47 < #                                 attempt to create it.
44 > # objectstore()         : return the objectStore object of the area
45   # - temporary
46   # align()                       : adjust hard paths to suit local loaction
47  
# Line 66 | Line 63 | sub new {
63          $self->{admindir}=".SCRAM";
64          $self->{cachedir}="cache";
65          $self->{dbdir}="ObjectDB";
66 +        $self->{tbupdate}=0;
67          undef $self->{linkarea};
68  
69          return $self;
# Line 74 | Line 72 | sub new {
72   sub cache {
73          my $self=shift;
74  
77 –        my $exist=0;
75          if ( @_ ) {
76 <          my $cache=shift;
80 <          if ( $cache!~/^</ ) {
81 <            $self->{cache}=$cache;
82 <          }
83 <          $exist=1;
76 >           $self->{cache}=shift;
77          }
78          if ( ! defined $self->{cache} ) {
79            my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
80 <          if (  !$exist || ( -e $loc ) ) {
80 >          if ( -e $loc  ) {
81              $self->{cache}=URL::URLcache->new($loc);
82            }
83            else {
# Line 94 | Line 87 | sub cache {
87          return $self->{cache};
88   }
89  
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 +        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
121 +        $self->{cache}=URL::URLcache->new($loc);
122 +        return $self->{cache};
123 + }
124 +
125 + sub _newobjectstore {
126 +        my $self=shift;
127 +        my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
128 +        $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
129 +        return $self->{dbstore};
130 + }
131 +
132   sub objectstore {
133          my $self=shift;
134  
100 –        my $exist="";
135          if ( @_ ) {
136 <          my $db=shift;
103 <          if ( $db!~/^</ ) {
104 <            $self->{dbstore}=cache;
105 <          }
106 <          $exist="<";
136 >            $self->{dbstore}=shift;
137          }
138          if ( ! defined $self->{dbstore} ) {
139            my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
140 <          $self->{dbstore}=ObjectUtilities::ObjectStore->new($exist.$loc);
140 >          if ( -e $loc ) {
141 >            $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
142 >          }
143 >          else {
144 >            $self->{dbstore}=undef;
145 >          }
146          }
147          return $self->{dbstore}
148   }
# Line 132 | Line 167 | sub setup {
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          }
# Line 157 | Line 193 | sub setup {
193          AddDir::adddir($workloc);
194  
195          # -- add a cache
196 <        $self->cache();
196 >        $self->_newcache();
197 >
198 >        # -- add an Objectstore
199 >        $self->_newobjectstore();
200  
201          # -- Save Environment File
202          $self->_SaveEnvFile();
# Line 172 | Line 211 | sub configurationdir {
211          return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
212   }
213  
214 + sub sourcedir {
215 +        my $self=shift;
216 +        if ( @_ ) {
217 +          $self->{sourcedir}=shift;
218 +        }
219 +        return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
220 + }
221 +
222   sub toolbox {
223          my $self=shift;
224          if ( ! defined $self->{toolbox} ) {
225 <          $self->{toolbox}=BuildSystem::ToolBox->new($self);
225 >          $self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH});
226          }
227          return $self->{toolbox};
228   }
229  
230 + sub toolboxversion {
231 +        my $self=shift;
232 +        if ( @_ ) {
233 +          $self->{toolboxversion}=shift;
234 +        }
235 +        return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef;
236 + }
237 +
238   sub requirementsdoc {
239          my $self=shift;
240          if ( @_ ) {
# Line 211 | Line 266 | sub scramversion {
266          return $self->{scramversion};
267   }
268  
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 +
314 + sub admindir()
315 +   {
316 +   my $self=shift;
317 +  
318 +   @_ ? $self->{admindir} = shift
319 +      : $self->{admindir};
320 +   }
321 +
322   sub bootstrapfromlocation {
323          my $self=shift;
324  
# Line 224 | Line 332 | sub bootstrapfromlocation {
332          else {
333           $self->location($location);
334           $self->verbose("Found top ".$self->location());
227 –         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
335           $self->_LoadEnvFile();
336          }
337          return $rv;
# Line 245 | Line 352 | sub location {
352  
353   sub searchlocation {
354          my $self=shift;
355 <
355 >        
356          #start search in current directory if not specified
357          my $thispath;
358          if ( @_ ) {
# Line 254 | Line 361 | sub searchlocation {
361          else {
362            $thispath=cwd();
363          }
364 <
364 >        
365          my $rv=0;
366  
367          # chop off any files - we only want dirs
# Line 270 | Line 377 | sub searchlocation {
377              last Sloop;
378            }
379          } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
380 <
380 >      
381          return $rv?$thispath:undef;
382   }
383  
# Line 309 | Line 416 | sub satellite {
416          $sat->version($self->version());
417          $sat->requirementsdoc($self->{reqdoc});
418          $sat->configurationdir($self->configurationdir());
419 +        $sat->sourcedir($self->sourcedir());
420 +        $sat->toolboxversion($self->toolboxversion());
421          $sat->setup(@_);
422  
423          # -- copy across the cache and ObjectStore
424          # -- make sure we dont try building new caches in release areas
425 <        my $rcache=$self->cache("<");
425 >        my $rcache=$self->cache();
426          if ( defined $rcache ) {
427            copy($rcache->location(),$sat->cache()->location());
428          }
429  
430          # -- make sure we dont try building new objectstores in release areas
431 <        my $rostore=$self->objectstore("<");
431 >        my $rostore=$self->objectstore();
432          if ( defined $rostore ) {
433            copy($rostore->location(),$sat->objectstore()->location());
434          }
# Line 375 | Line 484 | sub align {
484  
485   sub copysetup {
486          my $self=shift;
487 <        my $dest=shift;
379 <
487 >        my $dest=shift;
488          my $rv=1;
489          # copy across the admin dir
490          my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
# Line 390 | Line 498 | sub copysetup {
498          return $rv;
499   }
500  
501 + sub copyurlcache {
502 +        my $self=shift;
503 +        my $dest=shift;
504 +        my $rv=1;
505 +        # copy across the admin dir
506 +        my $temp=$self->location()."/".$self->{admindir}."/cache";
507 +        my $temp2=$dest."/".$self->{admindir}."/cache";
508 +        if ( $temp ne $temp2 ) {
509 +         if ( -d $temp ) {
510 +          AddDir::copydir($temp,$temp2);
511 +          $rv=0;
512 +         }
513 +        }
514 +        return $rv;
515 + }
516 +
517 + sub copywithskip {
518 +        my $self=shift;
519 +        my $dest=shift;
520 +        my ($filetoskip)=@_;            
521 +        my $rv=1;
522 +        # copy across the admin dir
523 +        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
524 +        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
525 +        if ( $temp ne $temp2 ) {
526 +         if ( -d $temp ) {
527 +          AddDir::copydirwithskip($temp,$temp2,$filetoskip);
528 +          $rv=0;
529 +         }
530 +        }
531 +        return $rv;
532 + }
533 +
534   sub copyenv {
535          my $self=shift;
536          my $hashref=shift;
# Line 407 | Line 548 | sub arch {
548   sub linkto {
549          my $self=shift;
550          my $location=shift;
551 +
552          if ( -d $location ) {
553          my $area=Configuration::ConfigArea->new();
554          $area->bootstrapfromlocation($location);
# Line 440 | Line 582 | sub save {
582          $self->_SaveEnvFile();
583   }
584  
585 + sub reqdoc()
586 +   {
587 +   my $self=shift;
588 +   my ($path)=@_;
589 +   return $path."/".$self->{reqdoc};
590 +   }
591 +
592 + sub creationtime()
593 +   {
594 +   my $self=shift;
595 +   my ($location)= @_;
596 +   $location||=$self->location();
597 +   my $requirementsdoc = $self->reqdoc($location);
598 +   my ($mode, $time) = (stat($requirementsdoc))[2, 9];
599 +   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
600 +
601 +   ($sec < 10) ? ($sec = "0".$sec) : $sec;
602 +   ($min < 10) ? ($min = "0".$min) : $min;
603 +
604 +   $year += 1900;
605 +   my $months =
606 +      {
607 +      0 => "Jan", 1 => "Feb",
608 +      2 => "Mar", 3 => "Apr",
609 +      4 => "May", 5 => "Jun",
610 +      6 => "Jul", 7 => "Aug",
611 +      8 => "Sept", 9 => "Oct",
612 +      10 => "Nov", 11 => "Dec" };
613 +  
614 +   my $days = { 1 => "Mon", 2 => "Tue", 3 => "Wed", 4 => "Thu", 5 => "Fri", 6 => "Sat", 7 => "Sun"};
615 +  
616 +   # Return the timestamp (as string) of the requirementsdoc:
617 +   return $days->{$wday}."-".$mday."-".$months->{$mon}."-".$year." ".$hour.":".$min.":".$sec;
618 +   }
619 +
620   # ---- support routines
621  
622 < sub _SaveEnvFile {
623 <        my $self=shift;
624 <        use FileHandle;
625 <        my $fh=FileHandle->new();
626 <        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
627 <                "Environment" ) or
628 <                $self->error("Cannot Open Environment file to Save ("
629 <                                .$self->location().")\n $!");
622 > sub _SaveEnvFile
623 >   {
624 >   my $self=shift;
625 >   my $filemode = 0644;
626 >  
627 >   use FileHandle;
628 >   my $fh=FileHandle->new();
629 >   open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
630 >          "Environment" ) or
631 >          $self->error("Cannot Open Environment file to Save ("
632 >                       .$self->location().")\n $!");
633          
634 <        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
635 <        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
636 <        print $fh "projconfigdir=".$self->configurationdir()."\n";
637 <        print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
638 <        if ( defined $self->linkarea() ) {
639 <          my $area=$self->linkarea()->location();
640 <          if ( $area ne "" ) {
641 <          print $fh "RELEASETOP=".$area."\n";
642 <          }
643 <        }
644 <        undef $fh;
645 < }
646 <
647 <
648 < sub _LoadEnvFile {
649 <        my $self=shift;
650 <
651 <        use FileHandle;
652 <        my $fh=FileHandle->new();
653 <        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
654 <                "Environment" ) or
655 <                $self->error("Cannot find Environment file. Area Corrupted? ("
656 <                                .$self->location().")\n $!");
657 <        while ( <$fh> ) {
658 <           chomp;
659 <           next if /^#/;
660 <           next if /^\s*$/ ;
661 <           ($name, $value)=split /=/;
662 <           eval "\$self->{ENV}{${name}}=\"$value\"";
663 <        }
664 <        undef $fh;
634 >   print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
635 >   print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
636 >   print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n";
637 >   print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n";
638 >   print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
639 >   print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n";
640 >
641 >   if ( defined $self->linkarea() )
642 >      {
643 >      my $area=$self->linkarea()->location();
644 >      if ( $area ne "" )
645 >         {
646 >         print $fh "RELEASETOP=".$area."\n";
647 >         }
648 >      }
649 >  
650 >   undef $fh;
651 >  
652 >   # Set the default permissions (-rw-r--r--):
653 >   chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
654 >   }
655 >
656 > sub _LoadEnvFile
657 >   {
658 >   my $self=shift;
659 >
660 >   use FileHandle;
661 >   my $fh=FileHandle->new();
662 >   open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
663 >          "Environment" ) or
664 >          $self->error("Cannot find Environment file. Area Corrupted? ("
665 >                       .$self->location().")\n $!");
666 >   while ( <$fh> )
667 >      {
668 >      chomp;
669 >      next if /^#/;
670 >      next if /^\s*$/ ;
671 >      ($name, $value)=split /=/;
672 >      eval "\$self->{ENV}{${name}}=\"$value\"";
673 >      }
674 >   undef $fh;
675          
676 <        # -- set internal variables appropriately
677 <        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
678 <          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
679 <        }
680 <        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
681 <          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
682 <        }
683 <        if ( defined $self->{ENV}{"projconfigdir"} ) {
684 <          $self->configurationdir($self->{ENV}{projconfigdir});
685 <        }
686 <        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
687 <          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
688 <        }
689 <        if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
690 <                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
691 <          $self->linkto($self->{ENV}{"RELEASETOP"});
692 <        }
693 <        else {
694 <          $self->{ENV}{"RELEASETOP"}=$self->location();
695 <        }
696 < }
676 >   # -- set internal variables appropriately
677 >   if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} )
678 >      {
679 >      $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
680 >      }
681 >   if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} )
682 >      {
683 >      $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
684 >      }
685 >   if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} )
686 >      {
687 >      $self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"});
688 >      }
689 >   if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} )
690 >      {
691 >      $self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
692 >      }
693 >   if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} )
694 >      {
695 >      $self->requirementsdoc($self->{ENV}{"SCRAM_ProjReqsDoc"});
696 >      }
697 >   if ( defined $self->{ENV}{"SCRAM_TOOLBOXVERSION"} )
698 >      {
699 >      if ($self->{ENV}{"SCRAM_TOOLBOXVERSION"} eq '')
700 >         {
701 >         $self->toolboxversion("STANDALONE");
702 >         }
703 >      else
704 >         {
705 >         $self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"});
706 >         }
707 >      }
708 >  
709 >   if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
710 >        ($self->{ENV}{"RELEASETOP"} ne $self->location()))
711 >      {
712 >      $self->linkto($self->{ENV}{"RELEASETOP"});
713 >      }
714 >   }

Diff Legend

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