src/Configuration/ConfigArea.pm

#
# ConfigArea.pm
#
# Written by Christopher Williams
#
# Description
# -----------
# creates and manages a configuration area
#
# Notes
# -------
# Persistency - remember to call the save method to make changes persistent
#
# Interface
# ---------
# new()                         : A new ConfigArea object
# name()                        : get/set project name
# setup(dir[,areaname])         : setup a fresh area in dir
# satellite(dir[,areaname])     : setup a satellite area in dir
# version()                     : get/set project version
# location([dir])               : set/return the location of the work area
# bootstrapfromlocation([location]) : bootstrap the object based on location.
#                                     no location specified - cwd used
#                                     return 0 if succesful 1 otherwise
# requirementsdoc()             : get set the requirements doc
# searchlocation([startdir])    : returns the location directory. search starts
#                                 from cwd if not specified
# scramversion()                : return the scram version associated with
#                                 area
# configurationdir()            : return the location of the project 
#                                 configuration directory
# copy(location)                : copy a configuration
# copysetup(location)           : copy the architecture specific tool setup
#                                 returns 0 if successful, 1 otherwise
# copyenv($ref)                 : copy the areas environment into the hashref
# toolbox()                     : return the areas toolbox object
# save()                        : save changes permanently
# linkto(location)              : link the current area to that at location
# unlinkarea()                  : destroy link (autosave)
# linkarea([ConfigArea])        : link the current area to the apec Area Object
# archname()            : get/set a string to indicate architecture
# archdir()             : return the location of the administration arch dep 
#                         directory
# objectstore()         : return the objectStore object of the area
# - temporary
# align()                       : adjust hard paths to suit local loaction

package Configuration::ConfigArea;
require 5.004;
use URL::URLcache;
use Utilities::AddDir;
use Utilities::Verbose;
use ObjectUtilities::ObjectStore;
use Cwd;
@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        my $self={};
        bless $self, $class;

        # data init
        $self->{admindir}=".SCRAM";
        $self->{cachedir}="cache";
        $self->{dbdir}="ObjectDB";
        $self->{tbupdate}=0;
        undef $self->{linkarea};

        return $self;
}

sub cache {
        my $self=shift;

        if ( @_ ) {
           $self->{cache}=shift;
        }
        if ( ! defined $self->{cache} ) {
          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
          if ( -e $loc  ) {
            $self->{cache}=URL::URLcache->new($loc);
          }
          else {
            $self->{cache}=undef;
          }
        }
        return $self->{cache};
}

# Tool and project cache info:
sub cacheinfo
   {
   my $self=shift;
   print "\n","<ConfigArea> cacheinfo: ToolCache = ",$self->{toolcachefile},
   ", ProjectCache = ",$self->{projectcachefile},"\n";
   }

sub toolcachename
   {
   my $self=shift;
   return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ToolCache.db");
   }

sub projectcachename
   {
   my $self=shift;
   return ($self->location()."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}."/ProjectCache.db");
   }

sub _tbupdate
   {
   # Update toolbox relative to new RequirementsDoc:
   my $self=shift;
   @_?$self->{tbupdate}=shift
      :$self->{tbupdate};
   }

sub _newcache {
        my $self=shift;
        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
        $self->{cache}=URL::URLcache->new($loc);
        return $self->{cache};
}

sub _newobjectstore {
        my $self=shift;
        my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
        $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
        return $self->{dbstore};
}

sub objectstore {
        my $self=shift;

        if ( @_ ) {
            $self->{dbstore}=shift;
        }
        if ( ! defined $self->{dbstore} ) {
          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
          if ( -e $loc ) {
            $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
          }
          else {
            $self->{dbstore}=undef;
          }
        }
        return $self->{dbstore}
}

sub name {
        my $self=shift;
        @_?$self->{name}=shift
          :$self->{name};
}

sub version {
        my $self=shift;
        @_?$self->{version}=shift
          :$self->{version};
}

sub setup {
        my $self=shift;
        my $location=shift;
        my $areaname;

        # -- check we have a project name and version
        my $name=$self->name();
        my $vers=$self->version();
        
        if ( ( ! defined $name ) && ( ! defined $version )) {
          $self->error("Set ConfigArea name and version before setup");
        }

        # -- check arguments and set location
        if ( ! defined $location ) {
          $self->error("ConfigArea: Cannot setup new area without a location");
        }
        if ( @_ ) {
          $areaname=shift;
        }
        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
          # -- make up a name from the project name and version
          $vers=~s/^$name\_//;
          $areaname=$name."_".$vers;
        }
        my $arealoc=$location."/".$areaname;
        my $workloc=$arealoc."/".$self->{admindir};
        $self->verbose("Building at $arealoc");
        $self->location($arealoc);

        # -- create top level structure and work area
        AddDir::adddir($workloc);

        # -- add a cache
        $self->_newcache();

        # -- add an Objectstore
        $self->_newobjectstore();

        # -- Save Environment File
        $self->_SaveEnvFile();

}

sub configurationdir {
        my $self=shift;
        if ( @_ ) {
          $self->{configurationdir}=shift;
        }
        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
}

sub sourcedir {
        my $self=shift;
        if ( @_ ) {
          $self->{sourcedir}=shift;
        }
        return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
}

sub toolbox {
        my $self=shift;
        if ( ! defined $self->{toolbox} ) {
          $self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH});
        }
        return $self->{toolbox};
}

sub toolboxversion {
        my $self=shift;
        if ( @_ ) {
          $self->{toolboxversion}=shift;
        }
        return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef;
}

sub requirementsdoc {
        my $self=shift;
        if ( @_ ) {
          $self->{reqdoc}=shift;
        }
        if ( defined $self->{reqdoc} ) {
          return $self->location()."/".$self->{reqdoc};
        }
        else {
          return undef;
        }
}

sub scramversion {
        my $self=shift;
        if ( ! defined $self->{scramversion} ) {
          my $filename=$self->location()."/".$self->configurationdir()."/".
                                                        "scram_version";
          if ( -f $filename ) {
            use FileHandle;
            $fh=FileHandle->new();
            open ($fh, "<".$filename);
            my $version=<$fh>;
            chomp $version;
            $self->{scramversion}=$version;
            undef $fh;
          }
        }
        return $self->{scramversion};
}

sub sitename
   {
   ###############################################################
   # sitename()                                                  #
   ###############################################################
   # modified : Mon Dec  3 15:45:35 2001 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   #          :                                                  #
   #          :                                                  #
   # function : Read the site name from config/site/sitename and #
   #          : export it.                                       #
   #          :                                                  #
   #          :                                                  #
   ###############################################################
   my $self = shift;
   my $sitefile = $self->location()."/".$self->configurationdir()."/site/sitename";

   $self->{sitename} = 'CERN'; # Use CERN as the default site name

   use FileHandle;
   my $sitefh = FileHandle->new();

   # Be verbose and print file we're going to read:
   $self->verbose(">> Going to try to get sitename from: ".$sitefile." ");
   
   # See if we can read from the file. If not, just
   # use default site name:
   open($sitefh,"<".$sitefile) || 
      do
         {
         $self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name.");
         return $self->{sitename};
         };
   
   $sitename = <$sitefh>;
   chomp($sitename);
   $self->{sitename} = $sitename;
   
   # Close the file (be tidy!);
   close($sitefile);
   # Return:
   return $self->{sitename};
   }

sub admindir()
   {
   my $self=shift;
   
   @_ ? $self->{admindir} = shift
      : $self->{admindir};
   }

sub bootstrapfromlocation {
        my $self=shift;

        my $rv=0;
        
        my $location;
        if ( ! defined ($location=$self->searchlocation(@_)) ) {
         $rv=1;
         $self->verbose("Unable to locate the top of local configuration area");
        }
        else {
         $self->location($location);
         $self->verbose("Found top ".$self->location());
         $self->_LoadEnvFile();
        }
        return $rv;
}

sub location {
        my $self=shift;

        if ( @_ ) {
          $self->{location}=shift;
        }
        elsif ( ! defined $self->{location} ) {
          # try and find the release location
          $self->{location}=$self->searchlocation();
        }
        return  $self->{location};
}

sub searchlocation {
        my $self=shift;
        
        #start search in current directory if not specified
        my $thispath;
        if ( @_ ) {
          $thispath=shift
        }
        else {
          $thispath=cwd();
        }
        
        my $rv=0;

        # chop off any files - we only want dirs
        if ( -f $thispath ) {
          $thispath=~s/(.*)\/.*/$1/;
        }
        Sloop:{
        do {
          $self->verbose("Searching $thispath");
          if ( -e "$thispath/".$self->{admindir} ) {
            $self->verbose("Found\n");
            $rv=1;
            last Sloop;
          }
        } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };
       
        return $rv?$thispath:undef;
}

sub archname {
        my $self=shift;
        if ( @_ ) {
          $self->{archname}=shift;
        }
        return $self->{archname};
}

sub archdir {
        my $self=shift;
        if ( @_ ) {
          $self->{archdir}=shift;
        }
        if ( ! defined $self->{archdir} ) {
         if ( defined $self->{archname} ) {
          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
                                                        $self->{archname};
         }
         else {
          $self->error("ConfigArea : cannot create arch directory - ".
                                                "architecture name not set")
         }
        }
        return $self->{archdir};
}

sub satellite {
        my $self=shift;

        # -- create the sat object
        my $sat=Configuration::ConfigArea->new();
        $sat->name($self->name());
        $sat->version($self->version());
        $sat->requirementsdoc($self->{reqdoc});
        $sat->configurationdir($self->configurationdir());
        $sat->sourcedir($self->sourcedir());
        $sat->toolboxversion($self->toolboxversion());
        $sat->setup(@_);

        # -- copy across the cache and ObjectStore
        # -- make sure we dont try building new caches in release areas
        my $rcache=$self->cache();
        if ( defined $rcache ) {
          copy($rcache->location(),$sat->cache()->location());
        }

        # -- make sure we dont try building new objectstores in release areas
        my $rostore=$self->objectstore();
        if ( defined $rostore ) {
          copy($rostore->location(),$sat->objectstore()->location());
        }

        # and make sure in reinitialises
        undef ($sat->{cache});

        # -- link it to this area
        $sat->linkarea($self);
        
        # -- save it
        $sat->save();

        return $sat;
}

sub copy {
        my $self=shift;
        my $destination=shift;

        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir};
        AddDir::copydir($temp,"$destination/".$self->{admindir});
}

sub align {
        my $self=shift;
        use File::Copy;

        $self->_LoadEnvFile();
        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
        my $tmpEnvfile=$Envfile.".bak";
        my $rel=$self->{ENV}{RELEASETOP};
        my $local=$self->location();

        rename( $Envfile, $tmpEnvfile );
        use FileHandle;
        my $fh=FileHandle->new();
        my $fout=FileHandle->new();
        open ( $fh, "<".$tmpEnvfile ) or
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!");
        open ( $fout, ">".$Envfile ) or
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!");
        while ( <$fh> ) {
          $_=~s/\Q$rel\L/$local/g;
          print $fout $_;
        }
        undef $fh;
        undef $fout;
}

sub copysetup {
        my $self=shift;
        my $dest=shift; 
        my $rv=1;
        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
        if ( $temp ne $temp2 ) {
         if ( -d $temp ) {
          AddDir::copydir($temp,$temp2);
          $rv=0;
         }
        }
        return $rv;
}

sub copyurlcache {
        my $self=shift;
        my $dest=shift; 
        my $rv=1;
        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir}."/cache";
        my $temp2=$dest."/".$self->{admindir}."/cache";
        if ( $temp ne $temp2 ) {
         if ( -d $temp ) {
          AddDir::copydir($temp,$temp2);
          $rv=0;
         }
        }
        return $rv;
}

sub copywithskip {
        my $self=shift;
        my $dest=shift;
        my ($filetoskip)=@_;            
        my $rv=1;
        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
        if ( $temp ne $temp2 ) {
         if ( -d $temp ) {
          AddDir::copydirwithskip($temp,$temp2,$filetoskip);
          $rv=0;
         }
        }
        return $rv;
}

sub copyenv {
        my $self=shift;
        my $hashref=shift;
        
        foreach $elem ( keys %{$self->{ENV}} ) {
           $$hashref{$elem}=$self->{ENV}{$elem};
        }
}

sub arch {
        my $self=shift;
        return $ENV{SCRAM_ARCH};
}

sub linkto {
        my $self=shift;
        my $location=shift;

        if ( -d $location ) {
        my $area=Configuration::ConfigArea->new();
        $area->bootstrapfromlocation($location);
        $self->linkarea($area);
        }
        else {
          $self->error("ConfigArea : Unable to link to non existing directory ".
                         $location);
        }
}

sub unlinkarea {
        my $self=shift;
        undef $self->{linkarea};
        $self->{linkarea}=undef;
        $self->save();
}

sub linkarea {
        my $self=shift;
        my $area=shift;
        if ( defined $area ) {
          $self->{linkarea}=$area;
        }
        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
                        $self->{linkarea}:undef;
}

sub save {
        my $self=shift;
        $self->_SaveEnvFile();
}

sub reqdoc()
   {
   my $self=shift;
   my ($path)=@_;
   return $path."/".$self->{reqdoc};
   }

sub creationtime()
   {
   my $self=shift;
   my ($location)= @_;
   $location||=$self->location();
   my $requirementsdoc = $self->reqdoc($location);
   my ($mode, $time) = (stat($requirementsdoc))[2, 9];
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);

   ($sec < 10) ? ($sec = "0".$sec) : $sec;
   ($min < 10) ? ($min = "0".$min) : $min;

   $year += 1900;
   my $months =
      {
      0 => "Jan", 1 => "Feb",
      2 => "Mar", 3 => "Apr",
      4 => "May", 5 => "Jun",
      6 => "Jul", 7 => "Aug",
      8 => "Sept", 9 => "Oct",
      10 => "Nov", 11 => "Dec" };
   
   my $days = { 1 => "Mon", 2 => "Tue", 3 => "Wed", 4 => "Thu", 5 => "Fri", 6 => "Sat", 7 => "Sun"};
   
   # Return the timestamp (as string) of the requirementsdoc:
   return $days->{$wday}."-".$mday."-".$months->{$mon}."-".$year." ".$hour.":".$min.":".$sec;
   }

# ---- support routines

sub _SaveEnvFile
   {
   my $self=shift;
   my $filemode = 0644;
   
   use FileHandle;
   my $fh=FileHandle->new();
   open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
          "Environment" ) or 
          $self->error("Cannot Open Environment file to Save ("
                       .$self->location().")\n $!"); 
        
   print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
   print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
   print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n";
   print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n";
   print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
   print $fh "SCRAM_TOOLBOXVERSION=".$self->{toolboxversion}."\n";

   if ( defined $self->linkarea() )
      {
      my $area=$self->linkarea()->location();
      if ( $area ne "" )
         {
         print $fh "RELEASETOP=".$area."\n";
         }
      }
   
   undef $fh;
   
   # Set the default permissions (-rw-r--r--):
   chmod $filemode, $self->location()."/".$self->{admindir}."/Environment";
   }

sub _LoadEnvFile
   {
   my $self=shift;

   use FileHandle;
   my $fh=FileHandle->new();
   open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
          "Environment" ) or 
          $self->error("Cannot find Environment file. Area Corrupted? ("
                       .$self->location().")\n $!"); 
   while ( <$fh> )
      {
      chomp;
      next if /^#/;
      next if /^\s*$/ ;
      ($name, $value)=split /=/;
      eval "\$self->{ENV}{${name}}=\"$value\"";
      }
   undef $fh;
        
   # -- set internal variables appropriately
   if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} )
      {
      $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
      }
   if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} )
      {
      $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
      } 
   if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} )
      {
      $self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"});
      }
   if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} )
      {
      $self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"});
      }
   if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} )
      {
      $self->requirementsdoc($self->{ENV}{"SCRAM_ProjReqsDoc"});
      }
   if ( defined $self->{ENV}{"SCRAM_TOOLBOXVERSION"} )
      {
      if ($self->{ENV}{"SCRAM_TOOLBOXVERSION"} eq '')
         {
         $self->toolboxversion("STANDALONE");
         }
      else
         {
         $self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"});
         }
      }
   
   if ( ( defined $self->{ENV}{"RELEASETOP"} ) && 
        ($self->{ENV}{"RELEASETOP"} ne $self->location()))
      {
      $self->linkto($self->{ENV}{"RELEASETOP"});
      }
   }
Revision:	1.29
Committed:	Thu Mar 10 12:39:28 2005 UTC (20 years, 2 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	v102p1, V1_0_1
Changes since 1.28:	+7 -0 lines
Log Message:	Fix to scram project listing (ref bug #6945).
#	User	Rev	Content
1	williamc	1.1	#
2			# ConfigArea.pm
3			#
4	williamc	1.14	# Written by Christopher Williams
5	williamc	1.1	#
6			# Description
7	williamc	1.9	# -----------
8			# creates and manages a configuration area
9			#
10	williamc	1.14	# Notes
11	williamc	1.9	# -------
12	williamc	1.14	# Persistency - remember to call the save method to make changes persistent
13	williamc	1.1	#
14			# Interface
15			# ---------
16	williamc	1.14	# 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	williamc	1.5	# searchlocation([startdir]) : returns the location directory. search starts
27			# from cwd if not specified
28	williamc	1.14	# 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	williamc	1.19	# linkarea([ConfigArea]) : link the current area to the apec Area Object
41	williamc	1.14	# archname() : get/set a string to indicate architecture
42			# archdir() : return the location of the administration arch dep
43			# directory
44	williamc	1.18	# objectstore() : return the objectStore object of the area
45	williamc	1.14	# - temporary
46			# align() : adjust hard paths to suit local loaction
47	williamc	1.1
48			package Configuration::ConfigArea;
49			require 5.004;
50	williamc	1.14	use URL::URLcache;
51	williamc	1.1	use Utilities::AddDir;
52	williamc	1.14	use Utilities::Verbose;
53	williamc	1.1	use ObjectUtilities::ObjectStore;
54	williamc	1.6	use Cwd;
55	williamc	1.14	@ISA=qw(Utilities::Verbose);
56	williamc	1.1
57	williamc	1.14	sub new {
58			my $class=shift;
59			my $self={};
60			bless $self, $class;
61	williamc	1.5
62	williamc	1.14	# data init
63			$self->{admindir}=".SCRAM";
64			$self->{cachedir}="cache";
65			$self->{dbdir}="ObjectDB";
66	sashby	1.23	$self->{tbupdate}=0;
67	williamc	1.14	undef $self->{linkarea};
68	williamc	1.8
69	williamc	1.14	return $self;
70	williamc	1.1	}
71
72	williamc	1.14	sub cache {
73	williamc	1.9	my $self=shift;
74	williamc	1.16
75	williamc	1.19	if ( @_ ) {
76			$self->{cache}=shift;
77			}
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 $self->{cache};
88	williamc	1.14	}
89	williamc	1.9
90	sashby	1.23	# 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	williamc	1.18	sub _newcache {
119	williamc	1.19	my $self=shift;
120			my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
121			$self->{cache}=URL::URLcache->new($loc);
122			return $self->{cache};
123	williamc	1.18	}
124
125			sub _newobjectstore {
126	williamc	1.19	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	williamc	1.18
132	williamc	1.14	sub objectstore {
133	williamc	1.19	my $self=shift;
134	williamc	1.16
135	williamc	1.19	if ( @_ ) {
136			$self->{dbstore}=shift;
137			}
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			return $self->{dbstore}
148	williamc	1.9	}
149
150	williamc	1.14	sub name {
151	williamc	1.9	my $self=shift;
152	williamc	1.14	@_?$self->{name}=shift
153			:$self->{name};
154	williamc	1.9	}
155	williamc	1.7
156	williamc	1.14	sub version {
157	williamc	1.6	my $self=shift;
158	williamc	1.14	@_?$self->{version}=shift
159			:$self->{version};
160	williamc	1.9	}
161	williamc	1.8
162	williamc	1.1	sub setup {
163			my $self=shift;
164	williamc	1.14	my $location=shift;
165			my $areaname;
166	williamc	1.1
167	williamc	1.14	# -- check we have a project name and version
168			my $name=$self->name();
169			my $vers=$self->version();
170	sashby	1.23
171	williamc	1.14	if ( ( ! defined $name ) && ( ! defined $version )) {
172			$self->error("Set ConfigArea name and version before setup");
173			}
174
175			# -- check arguments and set location
176	williamc	1.7	if ( ! defined $location ) {
177	williamc	1.14	$self->error("ConfigArea: Cannot setup new area without a location");
178	williamc	1.7	}
179	williamc	1.14	if ( @_ ) {
180			$areaname=shift;
181	williamc	1.6	}
182	williamc	1.14	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	williamc	1.1	}
187	williamc	1.14	my $arealoc=$location."/".$areaname;
188			my $workloc=$arealoc."/".$self->{admindir};
189			$self->verbose("Building at $arealoc");
190			$self->location($arealoc);
191	williamc	1.1
192	williamc	1.14	# -- create top level structure and work area
193			AddDir::adddir($workloc);
194	williamc	1.1
195	williamc	1.14	# -- add a cache
196	williamc	1.18	$self->_newcache();
197
198	williamc	1.19	# -- add an Objectstore
199			$self->_newobjectstore();
200	williamc	1.5
201	williamc	1.14	# -- Save Environment File
202			$self->_SaveEnvFile();
203	williamc	1.3
204	williamc	1.9	}
205
206	williamc	1.14	sub configurationdir {
207	williamc	1.9	my $self=shift;
208	williamc	1.14	if ( @_ ) {
209			$self->{configurationdir}=shift;
210			}
211			return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
212	williamc	1.9	}
213
214	sashby	1.23	sub sourcedir {
215			my $self=shift;
216			if ( @_ ) {
217			$self->{sourcedir}=shift;
218			}
219			return (defined $self->{sourcedir})?$self->{sourcedir}:undef;
220			}
221
222	williamc	1.14	sub toolbox {
223	williamc	1.3	my $self=shift;
224	williamc	1.14	if ( ! defined $self->{toolbox} ) {
225	williamc	1.19	$self->{toolbox}=BuildSystem::ToolBox->new($self, $ENV{SCRAM_ARCH});
226	williamc	1.14	}
227			return $self->{toolbox};
228	williamc	1.4	}
229
230	sashby	1.23	sub toolboxversion {
231			my $self=shift;
232			if ( @_ ) {
233			$self->{toolboxversion}=shift;
234			}
235			return (defined $self->{toolboxversion})?$self->{toolboxversion}:undef;
236			}
237
238	williamc	1.14	sub requirementsdoc {
239	williamc	1.5	my $self=shift;
240	williamc	1.14	if ( @_ ) {
241			$self->{reqdoc}=shift;
242			}
243			if ( defined $self->{reqdoc} ) {
244			return $self->location()."/".$self->{reqdoc};
245	williamc	1.12	}
246			else {
247	williamc	1.14	return undef;
248	williamc	1.12	}
249	williamc	1.5	}
250
251	williamc	1.14	sub scramversion {
252	williamc	1.4	my $self=shift;
253	williamc	1.14	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	williamc	1.1	}
268
269	sashby	1.21	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	sashby	1.22
292			# Be verbose and print file we're going to read:
293			$self->verbose(">> Going to try to get sitename from: ".$sitefile." ");
294	sashby	1.21
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	sashby	1.22	$self->verbose(">> Unable to read a site name definition file. Using \'CERN\' as the site name.");
301	sashby	1.21	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	sashby	1.29	sub admindir()
315			{
316			my $self=shift;
317
318			@_ ? $self->{admindir} = shift
319			: $self->{admindir};
320			}
321	sashby	1.21
322	williamc	1.14	sub bootstrapfromlocation {
323	williamc	1.1	my $self=shift;
324
325	williamc	1.14	my $rv=0;
326
327			my $location;
328			if ( ! defined ($location=$self->searchlocation(@_)) ) {
329			$rv=1;
330			$self->verbose("Unable to locate the top of local configuration area");
331	williamc	1.9	}
332			else {
333	williamc	1.14	$self->location($location);
334			$self->verbose("Found top ".$self->location());
335			$self->_LoadEnvFile();
336	williamc	1.9	}
337	williamc	1.14	return $rv;
338	williamc	1.1	}
339
340			sub location {
341			my $self=shift;
342
343	williamc	1.5	if ( @_ ) {
344	williamc	1.6	$self->{location}=shift;
345	williamc	1.5	}
346			elsif ( ! defined $self->{location} ) {
347			# try and find the release location
348	williamc	1.9	$self->{location}=$self->searchlocation();
349	williamc	1.5	}
350			return $self->{location};
351			}
352
353			sub searchlocation {
354			my $self=shift;
355	sashby	1.20
356	williamc	1.5	#start search in current directory if not specified
357			my $thispath;
358	williamc	1.14	if ( @_ ) {
359			$thispath=shift
360			}
361			else {
362			$thispath=cwd();
363			}
364	sashby	1.20
365	williamc	1.5	my $rv=0;
366
367	williamc	1.14	# chop off any files - we only want dirs
368			if ( -f $thispath ) {
369			$thispath=~s/(.)\/./$1/;
370			}
371	williamc	1.6	Sloop:{
372			do {
373	williamc	1.14	$self->verbose("Searching $thispath");
374	williamc	1.8	if ( -e "$thispath/".$self->{admindir} ) {
375	williamc	1.14	$self->verbose("Found\n");
376	williamc	1.5	$rv=1;
377	williamc	1.6	last Sloop;
378	williamc	1.5	}
379	williamc	1.6	} while ( ($thispath=~s/(.)\/./$1/)=~/./ ) };
380	sashby	1.20
381	williamc	1.5	return $rv?$thispath:undef;
382	williamc	1.1	}
383
384	williamc	1.14	sub archname {
385	williamc	1.1	my $self=shift;
386	williamc	1.14	if ( @_ ) {
387			$self->{archname}=shift;
388			}
389			return $self->{archname};
390			}
391	williamc	1.1
392	williamc	1.14	sub archdir {
393			my $self=shift;
394			if ( @_ ) {
395			$self->{archdir}=shift;
396			}
397			if ( ! defined $self->{archdir} ) {
398			if ( defined $self->{archname} ) {
399			$self->{archdir}=$self->location()."/".$self->{admindir}."/".
400			$self->{archname};
401			}
402			else {
403			$self->error("ConfigArea : cannot create arch directory - ".
404			"architecture name not set")
405			}
406			}
407			return $self->{archdir};
408	williamc	1.1	}
409
410	williamc	1.14	sub satellite {
411	williamc	1.1	my $self=shift;
412	williamc	1.14
413			# -- create the sat object
414			my $sat=Configuration::ConfigArea->new();
415			$sat->name($self->name());
416			$sat->version($self->version());
417			$sat->requirementsdoc($self->{reqdoc});
418			$sat->configurationdir($self->configurationdir());
419	sashby	1.23	$sat->sourcedir($self->sourcedir());
420			$sat->toolboxversion($self->toolboxversion());
421	williamc	1.14	$sat->setup(@_);
422
423			# -- copy across the cache and ObjectStore
424	williamc	1.16	# -- make sure we dont try building new caches in release areas
425	williamc	1.18	my $rcache=$self->cache();
426	williamc	1.16	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	williamc	1.18	my $rostore=$self->objectstore();
432	williamc	1.16	if ( defined $rostore ) {
433			copy($rostore->location(),$sat->objectstore()->location());
434			}
435	williamc	1.14
436			# and make sure in reinitialises
437			undef ($sat->{cache});
438
439			# -- link it to this area
440			$sat->linkarea($self);
441	williamc	1.1
442	williamc	1.14	# -- save it
443			$sat->save();
444
445			return $sat;
446	williamc	1.1	}
447
448	williamc	1.14	sub copy {
449	williamc	1.1	my $self=shift;
450	williamc	1.14	my $destination=shift;
451	williamc	1.1
452	williamc	1.14	# copy across the admin dir
453			my $temp=$self->location()."/".$self->{admindir};
454			AddDir::copydir($temp,"$destination/".$self->{admindir});
455	williamc	1.13	}
456
457	williamc	1.14	sub align {
458	williamc	1.13	my $self=shift;
459	williamc	1.14	use File::Copy;
460
461			$self->_LoadEnvFile();
462			my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
463			my $tmpEnvfile=$Envfile.".bak";
464			my $rel=$self->{ENV}{RELEASETOP};
465			my $local=$self->location();
466
467			rename( $Envfile, $tmpEnvfile );
468			use FileHandle;
469			my $fh=FileHandle->new();
470			my $fout=FileHandle->new();
471			open ( $fh, "<".$tmpEnvfile ) or
472			$self->error("Cannot find Environment file. Area Corrupted? ("
473			.$self->location().")\n $!");
474			open ( $fout, ">".$Envfile ) or
475			$self->error("Cannot find Environment file. Area Corrupted? ("
476			.$self->location().")\n $!");
477			while ( <$fh> ) {
478			$_=~s/\Q$rel\L/$local/g;
479			print $fout $_;
480			}
481			undef $fh;
482			undef $fout;
483	williamc	1.1	}
484
485	williamc	1.14	sub copysetup {
486	williamc	1.9	my $self=shift;
487	sashby	1.24	my $dest=shift;
488			my $rv=1;
489			# copy across the admin dir
490			my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
491			my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
492			if ( $temp ne $temp2 ) {
493			if ( -d $temp ) {
494			AddDir::copydir($temp,$temp2);
495			$rv=0;
496			}
497			}
498			return $rv;
499			}
500
501	sashby	1.26	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	sashby	1.24	sub copywithskip {
518			my $self=shift;
519	williamc	1.14	my $dest=shift;
520	sashby	1.24	my ($filetoskip)=@_;
521	williamc	1.14	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	sashby	1.24	AddDir::copydirwithskip($temp,$temp2,$filetoskip);
528	williamc	1.14	$rv=0;
529			}
530	williamc	1.9	}
531	williamc	1.14	return $rv;
532	williamc	1.9	}
533
534	williamc	1.14	sub copyenv {
535	williamc	1.9	my $self=shift;
536	williamc	1.14	my $hashref=shift;
537
538			foreach $elem ( keys %{$self->{ENV}} ) {
539			$$hashref{$elem}=$self->{ENV}{$elem};
540	williamc	1.9	}
541			}
542
543	williamc	1.14	sub arch {
544	williamc	1.9	my $self=shift;
545	williamc	1.14	return $ENV{SCRAM_ARCH};
546	williamc	1.9	}
547
548	williamc	1.14	sub linkto {
549	williamc	1.9	my $self=shift;
550	williamc	1.14	my $location=shift;
551	sashby	1.23
552	williamc	1.14	if ( -d $location ) {
553			my $area=Configuration::ConfigArea->new();
554			$area->bootstrapfromlocation($location);
555			$self->linkarea($area);
556			}
557			else {
558			$self->error("ConfigArea : Unable to link to non existing directory ".
559			$location);
560	williamc	1.9	}
561			}
562
563	williamc	1.14	sub unlinkarea {
564	williamc	1.9	my $self=shift;
565	williamc	1.14	undef $self->{linkarea};
566			$self->{linkarea}=undef;
567			$self->save();
568			}
569	williamc	1.9
570	williamc	1.14	sub linkarea {
571	williamc	1.1	my $self=shift;
572	williamc	1.14	my $area=shift;
573			if ( defined $area ) {
574			$self->{linkarea}=$area;
575			}
576			return (defined $self->{linkarea} && $self->{linkarea} ne "")?
577			$self->{linkarea}:undef;
578	williamc	1.1	}
579
580	williamc	1.14	sub save {
581	williamc	1.1	my $self=shift;
582	williamc	1.14	$self->_SaveEnvFile();
583	williamc	1.1	}
584
585	sashby	1.27	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	williamc	1.14	# ---- support routines
621	williamc	1.1
622	sashby	1.25	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	williamc	1.14
634	sashby	1.25	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	williamc	1.9
641	sashby	1.25	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	williamc	1.1
656	sashby	1.23	sub _LoadEnvFile
657			{
658			my $self=shift;
659	williamc	1.9
660	sashby	1.23	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	williamc	1.14
676	sashby	1.23	# -- 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	sashby	1.28	if ($self->{ENV}{"SCRAM_TOOLBOXVERSION"} eq '')
700			{
701			$self->toolboxversion("STANDALONE");
702			}
703			else
704			{
705			$self->toolboxversion($self->{ENV}{"SCRAM_TOOLBOXVERSION"});
706			}
707	sashby	1.23	}
708
709			if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
710			($self->{ENV}{"RELEASETOP"} ne $self->location()))
711			{
712			$self->linkto($self->{ENV}{"RELEASETOP"});
713			}
714			}