src/BuildSystem/BuildDataStorage.pm

#____________________________________________________________________ 
# File: BuildDataStorage.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2004-06-22 15:16:01+0200
# Revision: $Id: BuildDataStorage.pm,v 1.23.2.1 2008/02/15 14:58:01 muzaffar Exp $ 
#
# Copyright: 2004 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::BuildDataStorage;
require 5.004;
use BuildSystem::BuildFile;
use Exporter;
use File::Basename;

@ISA=qw(Exporter);
@EXPORT_OK=qw( );

sub new()
  ###############################################################
  # new                                                         #
  ###############################################################
  # modified : Tue Jun 22 15:16:08 2004 / SFA                   #
  # params   :                                                  #
  #          :                                                  #
  # function :                                                  #
  #          :                                                  #
  ###############################################################
  {
  my $proto=shift;
  my $class=ref($proto) || $proto;
  my ($configdir) = @_;
  my $self=
     {
     BUILDTREE => {},                # Path/data pairs;
     STATUS => 0,                    # Status of cache
     VERBOSE => 0                    # Verbose mode (0/1);
     }; 
  
  bless $self,$class;

  # The location of the top-level BuildFile:
  $self->{CONFIGDIR} = $configdir;

  # Somewhere to store the dependencies:
  $self->{DEPENDENCIES} = {};  # GLOBAL dependencies
  $self->{SKIPPEDDIRS} = {};   # Global skipped dirs
  $self->init_engine();
  
  return $self;
  }

#### The methods ####
sub datapath()
   {
   my $self=shift;
   my ($path)=@_;
   my $datapath;
   # At project-level, the path is src so just return src. Also,
   # if we received a BuildFile path that we need to determine the data path for,
   # check first to see if the path matches config/BuildFile. If it does, we have the top-level
   # datapath which should be src:
   my $conf="$ENV{SCRAM_CONFIGDIR}"; my $src=$ENV{SCRAM_SOURCEDIR};
   my $bf=$ENV{SCRAM_BUILDFILE};
   if ($path=~/^(${conf}\/${bf}(.xml|)|$src)$/)
      {
      return $src;
      }
   
   # For other paths, strip off the src dir (part of LOCALTOP) and the final BuildFile to
   # get a data position to be used as a key:
   ($datapath = $path) =~ s|^\Q$src\L/||;
   if ($datapath =~ m/(.*)\/$bf(.xml|)$/)
      {
      return $1;
      }
   
   return $datapath;
   }

sub check_global_config()
   {
   my $self=shift;
   my $found=0;
   foreach my $bf ("$ENV{SCRAM_BUILDFILE}.xml","$ENV{SCRAM_BUILDFILE}")
      {
      if (-f $self->{CONFIGDIR}."/${bf}")
         {
         $found=1;
         last;
         }
      }
   if (! $found)
      {
      print "SCRAM error: no $ENV{SCRAM_BUILDFILE} at top-level (config)! Invalid area!","\n";
      exit(1);
      }
   
   return $self;
   }

sub scanbranch()
   {
   my $self=shift;
   my ($files, $datapath)=@_;
   my $bfbranch;
   my $buildfiles;
   # Fix (or rather hack) so that only the current buildfile is parsed, not the parent.
   # This is required becuase it's not desired to pick up dependencies from the level lower:
   # one should always do it via a <use name=x> to get the package deps. We don't care about
   # deps in subsystems (they're only used to define groups) and project-wide deps are added at
   # template level:
   my $file = $files->[0];
   return unless -f $file; # Just in case metabf() is empty...
   $bfbranch=BuildSystem::BuildFile->new();
   $bfbranch->parse($file);
   # Store:
   $self->storebranchmetadata($datapath,$bfbranch);
   return $self;
   }

sub buildtreeitem()
   {
   my $self=shift;
   my ($datapath)=@_;
   # This will return the TreeItem object for
   # the corresponding data path:
   return $self->{BUILDTREE}->{$datapath};
   }

sub updatedirbf ()
   {
   my ($self,$dircache,$path,$bf,$buildclass)=@_;
   use BuildSystem::TreeItem;
   my $treeitem = BuildSystem::TreeItem->new();
   my $datapath = $self->datapath($path); 
   $self->{BUILDTREE}->{$datapath} = $treeitem;
   if ($bf)
      {
      $treeitem->metabf($bf);
      $self->scan($bf, $datapath);
      }
   if (!$buildclass) {$buildclass=$self->buildclass($path);}
   my ($class, $classdir, $suffix) = @{$buildclass};
   $treeitem->class($class);
   $treeitem->classdir($classdir);
   $treeitem->suffix($suffix);
   $treeitem->path($path);
   $treeitem->safepath($path);
   $treeitem->parent($datapath);
   $treeitem->children($dircache->dircache());
   $treeitem->name();
   return $treeitem;
   }

sub updateproductstore()
   {
   my $self=shift;
   my $item = shift;
   if (exists $item->{RAWDATA} && exists $item->{RAWDATA}{content} && exists $item->{RAWDATA}{content}{PRODUCTSTORE})
   {
   my $store = {};
   foreach my $H (@{$item->{RAWDATA}{content}{PRODUCTSTORE}})
      {
      my $storename="";
      if ($H->{'type'} eq 'arch')
         {
         if ($H->{'swap'} eq 'true')
            {
            $storename .= $H->{'name'}."/".$ENV{SCRAM_ARCH};
            }
         else
            {
            $storename .= $ENV{SCRAM_ARCH}."/".$H->{'name'};
            }
      }
      else
         {
         $storename .= $H->{'name'};
         }
         my $key ="SCRAMSTORENAME_".uc($H->{'name'});
         $key=~s/\//_/g;
         $store->{$key}=$storename;
      }
      $item->productstore($store);
   }
}

sub update()
   {
   my $self=shift;
   my ($dircache, $toolmanager) = @_;
   $self->{TOOLMANAGER} = $toolmanager;
   
   my $newbf  = $dircache->get_data("ADDEDBF");
   my $newdir = $dircache->get_data("ADDEDDIR");
   use File::Path;
   my $mkpath = $ENV{LOCALTOP}."/".$ENV{SCRAM_INTwork}."/MakeData";
   my $mkpubpath = $ENV{LOCALTOP}."/.SCRAM/".$ENV{SCRAM_ARCH}."/MakeData";
   mkpath("${mkpath}/DirCache",0,0755);
   mkpath("${mkpath}/RmvDirCache",0,0755);
   mkpath("$mkpubpath/DirCache",0,0755);
   my %runeng = ();
   my $projinfo=undef;
   eval ("use SCRAM_ExtraBuildRule;");
   if(!$@) {$projinfo = SCRAM_ExtraBuildRule->new();}
   if ($newbf)
      {
      foreach my $bf ("$ENV{SCRAM_BUILDFILE}.xml","$ENV{SCRAM_BUILDFILE}")
         {
         if (exists $newbf->{$ENV{SCRAM_CONFIGDIR}."/${bf}"})
            {
            my $treeitem = $self->updatedirbf($dircache,$ENV{SCRAM_SOURCEDIR},$ENV{SCRAM_CONFIGDIR}."/${bf}");
            $self->updateproductstore($treeitem);
            $runeng{$ENV{SCRAM_SOURCEDIR}}=$treeitem;
            delete $newbf->{$ENV{SCRAM_CONFIGDIR}."/${bf}"};
            last;
            }
         }
      }
   if ($newdir)
      {
      foreach my $path (keys %{$newdir})
         {
         if (!exists $newdir->{$path}) {next;}
         if ($path!~/^$ENV{SCRAM_SOURCEDIR}\/(.+)/){delete $newdir->{$path};next;}
         if ($path eq "$ENV{SCRAM_SOURCEDIR}/$ENV{SCRAM_SOURCEDIR}"){print "****WARNING: SCRAM does not support to have directory $ENV{LOCALTOP}/$ENV{SCRAM_SOURCEDIR}/$ENV{SCRAM_SOURCEDIR}.\n";next;}
         my $cinfo = $self->buildclass($path);
         if ($cinfo && $cinfo->[2] ne ""){$dircache->prune($path,0,$cinfo->[2]);}
         else
            {
            my $dpath = $self->datapath($path);
            my $pitem=undef;
            if (exists $self->{BUILDTREE}->{$dpath})
               {
               $pitem=$self->{BUILDTREE}->{$dpath};
               if (defined $pitem)
                  {
                  my $bf = $pitem->metabf();
                  if (scalar(@$bf)>0)
                     {
                     $bf=$bf->[0];
                     if (!exists $newbf->{$bf})
                        {
                        delete $newdir->{$path};
                        next;
                        }
                     }
                  }
               }
            my $item = $self->updatedirbf($dircache,$path,"",$cinfo);
            my $flag=0;
            if (!defined $projinfo)
               {
               if ($cinfo->[0] eq "library"){$flag=1;}
               }
            else
               {
               $flag=$projinfo->ispublic($item);
               }
            $runeng{$path}=$item;
            if ($flag)
               {
               my $treeitem = $self->{BUILDTREE}->{$dpath};
               $dircache->{PACKMAP}{$treeitem->parent()}=$dpath;
               $item->publictype (1);
               }
            }
         }
      }
      
   my %mkrebuild=();
   $mkrebuild{"${mkpath}/RmvDirCache"}=1;
   my $remdir = $dircache->get_data("REMOVEDDIR");
   if ($remdir)
      {
      foreach  my $path (keys %{$remdir})
         {
         delete $remdir->{$path};
         my $spath = $path; $spath =~ s|/|_|g;
         open(OFILE,">${mkpath}/RmvDirCache/${spath}.mk");
         print OFILE "REMOVED_DIRS += $path\n";
         close(OFILE);
         my $mpath = "${mkpath}/DirCache/${spath}.mk";
         if (!-f $mpath)
            {
            $mpath = "${mkpubpath}/DirCache/${spath}.mk";
            }
         if (-f $mpath)
            {
            unlink $mpath;
            $mkrebuild{dirname($mpath)}=1;
            }
         }
      }
      
   if ($newbf)
      {
      foreach my $bf (keys %{$newbf})
         {
         my $dpath = $self->datapath($bf);
         if (exists $dircache->{PACKMAP}{$dpath})
            {
            $dpath = $dircache->{PACKMAP}{$dpath};
            }
         $self->scan($bf,$dpath);
         $self->{BUILDTREE}->{$dpath}->metabf($bf);
         $runeng{"$ENV{SCRAM_SOURCEDIR}/${dpath}"} = $self->{BUILDTREE}->{$dpath};
         delete $newbf->{$bf};
         }
      }
   foreach my $path (sort {$a cmp $b} keys %runeng)
      {
      my $treeitem = $runeng{$path};
      delete $newdir->{$path};
      $self->run_engine($treeitem);
      if (exists $treeitem->{MKDIR})
         {
         foreach my $d (keys %{$treeitem->{MKDIR}})
            {
            $d=~s/\/\//\//;
            $mkrebuild{$d}=1;
            }
         delete $treeitem->{MKDIR};
         }
      }
    foreach my $dir (keys %mkrebuild)
       {
       open(MKFILE,">${dir}.mk") || die "Can not open file for writing: ${dir}.mk";
       close(MKFILE);
       if (-d $dir)
          {
          system("cd $dir; find . -name \"*\" -type f | xargs -n 2000 cat >> ${dir}.mk");
          }
       }
   }

sub scan()
   {
   my $self=shift;
   my ($buildfile, $datapath) = @_;
   my $bfparse;
   $bfparse=BuildSystem::BuildFile->new(1);
   # Execute the parse:
   $bfparse->parse($buildfile);
   # See if there were skipped dirs:
   my $skipped = $bfparse->skippeddirs($datapath);   
   # Check to see if there was an info array for this location.
   # If so, we extract the first element of the array (i.e. ->[1])
   # and store it under the datapath entry. This is just so that useful
   # messages explaining why the dir was skipped can be preserved.
   if (ref($skipped) eq 'ARRAY')
      {
      $self->skipdir($datapath,$skipped->[1]);
      }

   $self->storedata($datapath, $bfparse);

   return $self;
   }

sub init_engine()
   {
   my $self=shift;
   if (!exists $self->{TEMPLATE_ENGINE})
      {
      # Create the interface to the template engine:
      use BuildSystem::TemplateInterface;
      # Pass in the config dir as the location where templates live:
      $self->{TEMPLATE_ENGINE} = BuildSystem::TemplateInterface->new();
      }
   }

sub run_engine()
   {
   my $self=shift;
   my ($templatedata)=@_;
   $self->{TEMPLATE_ENGINE}->template_data($templatedata);
   $self->{TEMPLATE_ENGINE}->run();
   return $self;
   }

sub buildclass
   {
   my $self=shift;
   my ($path)=@_;
   my $cache=[];
   # From Lassi TUURA (with mods by me):
   #
   # Associate a path with ClassPath setting.
   # For now, just assumes global data has been scanned and class settings
   # are already known (in $self->{CONFIGDATA}->classpath()).   
   # Generate more optimal classpath data structure, only once.
   # Split every cache definition into an array of pairs, directory
   # name and class.  So ClassPath of type "+foo/+bar/src+library"
   # becomes [ [ "" "foo" ] [ "" "bar" ] [ "src" "library" ] ]

   my @CLASSPATHS=@{$self->{BUILDTREE}->{$ENV{SCRAM_SOURCEDIR}}->rawdata()->{content}->{CLASSPATH}};
   # This does not work, even though classpath() is a valid method and rawdata()
   # returns an object blessed into the correct type:
   # my @CLASSPATHS=@{$self->{BUILDTREE}->{$ENV{SCRAM_SOURCEDIR}}->rawdata()->classpath()};

   if (! scalar @$cache)
      {
      foreach my $classpath (@CLASSPATHS)
         {
         push (@$cache, [map { [ split(/\+/, $_) ] } split(/\//, $classpath)]);
         }
      }
   
   print "WARNING: No ClassPath definitions, nothing will be done!","\n",
   if (! scalar @$cache);
   # Now scan the class paths.  All the classpaths are given a rank
   # to mark how relevant they are, and then the best match is chosen.
   #
   # The ranking logic is as follows.  We scan each class path and
   # drop if it doesn't match at all.  For paths that match, we
   # record how many components of the class was *not* used to match
   # on the class: for a short $path, many classes will match.
   # For each path component we record whether the match was exact
   # (if the class part is empty, i.e. "", it's a wildcard that
   # matches everything).  Given these rankings, we pick
   #   - the *first* class that
   #   - has least *unmatched* components
   #   - with *first* or *longest* exact match sequence in
   #     left-to-right order.
   my @ranks = ();
   my @dirs = split(/\/+/, $path);
   CLASS: foreach my $class (@$cache)
      {
      # The first two members of $rank are fixed: how much of path
      # was and was not used in the match.
      my $rank = [[], [@dirs]];
      foreach my $component (@$class)
         {
         my $dir = $rank->[1][0];
         if (! defined $dir)
            {
            # Path exhausted.  Leave used/unused as is.
            last;
            }
         elsif ($component->[0] eq "")
            {
            # Wildcard match, push class and use up path
            push(@$rank, [1, $component->[1]]);
            push(@{$rank->[0]}, shift(@{$rank->[1]}));
            }
         elsif ($component->[0] eq $dir)
            {
            # Exact match, push class and use up path
            push(@$rank, [0, $component->[1]]);
            push(@{$rank->[0]}, shift(@{$rank->[1]}));
            }
         else
            {
            # Unmatched, leave used/unused as is.
            last;
            }
         }

      push(@ranks, $rank);
      }

   # If no classes match, bail out:
   if (! scalar @ranks)
      {
      return "";
      }
   
   # Sort in ascending order by how much was of class was not used;
   # the first entry has least "extra" trailing match data.  Then
   # truncate to only those equal to the best rank.
   my @sorted = sort { scalar(@{$a->[1]}) <=> scalar(@{$b->[1]}) } @ranks;
   my @best = grep(scalar(@{$_->[1]}) == scalar(@{$sorted[0][1]}), @sorted);

   # Now figure which of the best-ranking classes have the longest
   # exact match in left-to-right order (= which one is first, and
   # those with equal first exact match, longest exact match).
   my $n = 0;
   my $class = $best[$n][scalar @{$best[$n]}-1];
   # Return the class data:
   return [ $class->[1], join('/', @{$best[$n][0]}), join('/', @{$best[$n][1]}) ];
   }

sub storedata
   {
   my $self=shift;
   my ($datapath, $data)=@_;
   # Store the content of this BuildFile in cache:
   $self->{BUILDTREE}->{$datapath}->rawdata($data);
   return $self;
   }

sub removedata
   {
   my $self=shift;
   my ($removedpaths) = @_;
   
   foreach my $rd (@$removedpaths)
      {
      my $datapath = $self->datapath($rd);
      # Remove all data, recursively, from $datapath:
      $self->recursive_remove_data($datapath);
      }
   
   return $self;
   }

sub recursive_remove_data()
   {
   my $self=shift;
   my ($datapath)=@_;
   
   # Delete main entry in build data via TreeItem:
   if (exists($self->{BUILDTREE}->{$datapath}))
      {
      # We also must modify the parent TreeItem to remove the child
      # from SAFE_SUBDIRS as well as from CHILDREN array:      
      my $parent = $self->{BUILDTREE}->{$datapath}->parent();
      $self->{BUILDTREE}->{$parent}->updatechildlist($datapath);     
      
      # Get the children:
      my @children = $self->{BUILDTREE}->{$datapath}->children();
      
      foreach my $childpath (@children)
         {
         # The child path value is the datapath so can be used
         # directly when deleting data entries
         $self->recursive_remove_data($childpath);       
         }
      
      # Finally, delete the parent data (a TreeItem):
      delete $self->{BUILDTREE}->{$datapath};
      }
   
   # return:
   return $self;
   }

sub storebranchmetadata()
   {
   my $self=shift;
   my ($datapath,$data)=@_;
   
   # Store the content of this BuildFile in cache:
   $self->{BUILDTREE}->{$datapath}->branchmetadata($data);
   return $self;
   }

sub buildobject
   {
   my $self=shift;
   my ($datapath)=@_;

   if (exists($self->{BUILDTREE}->{$datapath}) && defined($self->{BUILDTREE}->{$datapath}->rawdata()))
      {
      return $self->{BUILDTREE}->{$datapath}->rawdata();
      }
   else
      {
      return undef;
      }
   }

sub metaobject
   {
   my $self=shift;
   my ($datapath)=@_;
   
   if (exists($self->{BUILDTREE}->{$datapath}) && defined($self->{BUILDTREE}->{$datapath}->branchmetadata()))
      {
      return $self->{BUILDTREE}->{$datapath}->branchmetadata();
      }
   else
      {
      return undef;
      }
   }

sub searchprojects()
   {
   my $self=shift;
   my ($group,$projectref)=@_;
   
   foreach my $pjt (keys %{$self->{SCRAM_PROJECTS}})
      {
      print "Checking for group $group in SCRAM project $pjt","\n", if ($ENV{SCRAM_DEBUG});
      # As soon as a project is found to have defined $group, we return
      # the project name:
      if (exists $self->{SCRAM_PROJECTS}->{$pjt}->{KNOWNGROUPS}->{$group})
         {
         # Store the project name and data path:
         $$projectref="project ".uc($pjt)." (".$self->{SCRAM_PROJECTS}->{$pjt}->{KNOWNGROUPS}->{$group}."/".$ENV{SCRAM_BUILDFILE}.")";
         return(1);
         }
      }
   
   # No group found to have been defined already so return false:
   return (0);
   }

sub findgroup
   {
   my $self=shift;
   my ($groupname) = @_;

   if (exists $self->{KNOWNGROUPS}->{$groupname})
      {
      # If group exists, return data:
      return $self->{KNOWNGROUPS}->{$groupname};
      }
   else
      {
      # Not found so return:
      return(0);
      }
   }

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

sub scramprojectbases()
   {
   my $self=shift;
   return $self->{SCRAM_PROJECT_BASES};
   }

sub alldirs
   {
   my $self=shift;
   return @{$self->{ALLDIRS}};
   }

sub skipdir
   {
   my $self=shift;
   my ($dir, $message) = @_;   

   # Set the info if we have both args:
   if ($dir && $message)
      {
      $self->{SKIPPEDDIRS}->{$dir} = $message;
      }
   # If we have the dir name only, return true if
   # this dir is to be skipped:
   elsif ($dir)
      {
      (exists($self->{SKIPPEDDIRS}->{$dir})) ? return 1 : return 0;
      }
   else
      {
      # Dump the list of directories and the message for each:
      foreach my $directory (keys %{$self->{SKIPPEDDIRS}})
         {
         print "Directory \"",$directory,"\" skipped by the build system";
         if (length($self->{SKIPPEDDIRS}->{$directory}->[0]) > 10)
            {
            chomp($self->{SKIPPEDDIRS}->{$directory}->[0]);
            my @lines = split("\n",$self->{SKIPPEDDIRS}->{$directory}->[0]); print ":\n";
            foreach my $line (@lines)
               {
               next if ($line =~ /^\s*$/);
               print "\t-- ",$line,"\n";
               }
            print "\n";
            }
         else
            {
            print ".","\n";
            }
         }
      }
   }

# Keep a record of which packages are missed by each location
# so that, on subsequent updates, these can be inserted auto-
# matically in the metadata for the location:
sub unresolved()
   {
   my $self=shift;
   my ($location, $pneeded) = @_;   
   # Need to record a mapping "LOCATION -> [ missing packages ]" and a
   # reverse-lookup "<missing package> -> [ LOCATIONS (where update required) ]"   
   $self->{UNRESOLVED_DEPS_BY_LOC}->{$location}->{$pneeded} = 1;
   $self->{UNRESOLVED_DEPS_BY_PKG}->{$pneeded}->{$location} = 1;
   }

sub verbose
   {
   my $self=shift;
   # Turn on verbose mode:
   @_ ? $self->{VERBOSE} = shift
      : $self->{VERBOSE}
   }

sub cachestatus()
   {
   my $self=shift;
   # Set/return the status of the cache:
   @_ ? $self->{STATUS} = shift
      : $self->{STATUS}
   }

sub logmsg
   {
   my $self=shift;
   # Print a message to STDOUT if VERBOSE is true:
   print STDERR @_ if $self->verbose();
   }

sub name()
   {
   my $self=shift;
   # Set/return the name of the cache to use:
   @_ ? $self->{CACHENAME} = shift
      : $self->{CACHENAME}
   }

sub save()
   {
   my $self=shift;
   # Delete unwanted stuff:
   delete $self->{DEPENDENCIES};
   delete $self->{TOOLMANAGER};
   delete $self->{TEMPLATE_ENGINE};
   delete $self->{SCRAM_PROJECTS};
   delete $self->{SCRAM_PROJECT_BASES};   
   return $self;
   }

1;
Revision:	1.23.2.2
Committed:	Fri Feb 15 17:30:58 2008 UTC (17 years, 2 months ago) by muzaffar
Content type:	text/plain
Branch:	forBinLess_SCRAM
CVS Tags:	V1_2_0-cand2
Changes since 1.23.2.1:	+1 -61 lines
Log Message:	more cleanup. no more http: protocol used. So no more extra dependency on libwww and uri perl modules
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: BuildDataStorage.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2004-06-22 15:16:01+0200
7	muzaffar	1.23.2.2	# Revision: $Id: BuildDataStorage.pm,v 1.23.2.1 2008/02/15 14:58:01 muzaffar Exp $
8	sashby	1.2	#
9			# Copyright: 2004 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::BuildDataStorage;
13			require 5.004;
14	sashby	1.16	use BuildSystem::BuildFile;
15	sashby	1.2	use Exporter;
16	muzaffar	1.17	use File::Basename;
17	sashby	1.16
18	sashby	1.2	@ISA=qw(Exporter);
19			@EXPORT_OK=qw( );
20
21			sub new()
22			###############################################################
23			# new #
24			###############################################################
25			# modified : Tue Jun 22 15:16:08 2004 / SFA #
26			# params : #
27			# : #
28			# function : #
29			# : #
30			###############################################################
31			{
32			my $proto=shift;
33			my $class=ref($proto) \|\| $proto;
34			my ($configdir) = @_;
35			my $self=
36			{
37			BUILDTREE => {}, # Path/data pairs;
38			STATUS => 0, # Status of cache
39			VERBOSE => 0 # Verbose mode (0/1);
40			};
41
42			bless $self,$class;
43
44			# The location of the top-level BuildFile:
45			$self->{CONFIGDIR} = $configdir;
46
47			# Somewhere to store the dependencies:
48			$self->{DEPENDENCIES} = {}; # GLOBAL dependencies
49	sashby	1.3	$self->{SKIPPEDDIRS} = {}; # Global skipped dirs
50	sashby	1.2	$self->init_engine();
51
52			return $self;
53			}
54
55			#### The methods ####
56			sub datapath()
57			{
58			my $self=shift;
59			my ($path)=@_;
60			my $datapath;
61			# At project-level, the path is src so just return src. Also,
62			# if we received a BuildFile path that we need to determine the data path for,
63			# check first to see if the path matches config/BuildFile. If it does, we have the top-level
64			# datapath which should be src:
65	muzaffar	1.17	my $conf="$ENV{SCRAM_CONFIGDIR}"; my $src=$ENV{SCRAM_SOURCEDIR};
66			my $bf=$ENV{SCRAM_BUILDFILE};
67			if ($path=~/^(${conf}\/${bf}(.xml\|)\|$src)$/)
68	sashby	1.2	{
69	muzaffar	1.17	return $src;
70	sashby	1.2	}
71
72			# For other paths, strip off the src dir (part of LOCALTOP) and the final BuildFile to
73			# get a data position to be used as a key:
74	muzaffar	1.17	($datapath = $path) =~ s\|^\Q$src\L/\|\|;
75			if ($datapath =~ m/(.*)\/$bf(.xml\|)$/)
76	sashby	1.2	{
77			return $1;
78			}
79
80			return $datapath;
81			}
82
83			sub check_global_config()
84			{
85			my $self=shift;
86	muzaffar	1.17	my $found=0;
87			foreach my $bf ("$ENV{SCRAM_BUILDFILE}.xml","$ENV{SCRAM_BUILDFILE}")
88			{
89			if (-f $self->{CONFIGDIR}."/${bf}")
90			{
91			$found=1;
92			last;
93			}
94			}
95			if (! $found)
96	sashby	1.2	{
97	muzaffar	1.17	print "SCRAM error: no $ENV{SCRAM_BUILDFILE} at top-level (config)! Invalid area!","\n";
98	sashby	1.2	exit(1);
99			}
100
101			return $self;
102			}
103
104			sub scanbranch()
105			{
106			my $self=shift;
107	sashby	1.7	my ($files, $datapath)=@_;
108			my $bfbranch;
109			my $buildfiles;
110	sashby	1.4	# Fix (or rather hack) so that only the current buildfile is parsed, not the parent.
111			# This is required becuase it's not desired to pick up dependencies from the level lower:
112			# one should always do it via a <use name=x> to get the package deps. We don't care about
113			# deps in subsystems (they're only used to define groups) and project-wide deps are added at
114			# template level:
115	sashby	1.16	my $file = $files->[0];
116			return unless -f $file; # Just in case metabf() is empty...
117			$bfbranch=BuildSystem::BuildFile->new();
118			$bfbranch->parse($file);
119	sashby	1.2	# Store:
120			$self->storebranchmetadata($datapath,$bfbranch);
121			return $self;
122			}
123
124			sub buildtreeitem()
125			{
126			my $self=shift;
127			my ($datapath)=@_;
128			# This will return the TreeItem object for
129			# the corresponding data path:
130			return $self->{BUILDTREE}->{$datapath};
131			}
132
133	muzaffar	1.17	sub updatedirbf ()
134			{
135			my ($self,$dircache,$path,$bf,$buildclass)=@_;
136			use BuildSystem::TreeItem;
137			my $treeitem = BuildSystem::TreeItem->new();
138			my $datapath = $self->datapath($path);
139			$self->{BUILDTREE}->{$datapath} = $treeitem;
140			if ($bf)
141			{
142			$treeitem->metabf($bf);
143			$self->scan($bf, $datapath);
144			}
145			if (!$buildclass) {$buildclass=$self->buildclass($path);}
146			my ($class, $classdir, $suffix) = @{$buildclass};
147			$treeitem->class($class);
148			$treeitem->classdir($classdir);
149			$treeitem->suffix($suffix);
150			$treeitem->path($path);
151			$treeitem->safepath($path);
152			$treeitem->parent($datapath);
153			$treeitem->children($dircache->dircache());
154			$treeitem->name();
155			return $treeitem;
156			}
157
158			sub updateproductstore()
159	sashby	1.2	{
160			my $self=shift;
161	muzaffar	1.17	my $item = shift;
162			if (exists $item->{RAWDATA} && exists $item->{RAWDATA}{content} && exists $item->{RAWDATA}{content}{PRODUCTSTORE})
163			{
164			my $store = {};
165			foreach my $H (@{$item->{RAWDATA}{content}{PRODUCTSTORE}})
166	sashby	1.2	{
167	muzaffar	1.17	my $storename="";
168			if ($H->{'type'} eq 'arch')
169			{
170			if ($H->{'swap'} eq 'true')
171	sashby	1.2	{
172	muzaffar	1.17	$storename .= $H->{'name'}."/".$ENV{SCRAM_ARCH};
173	sashby	1.2	}
174	muzaffar	1.17	else
175	sashby	1.2	{
176	muzaffar	1.17	$storename .= $ENV{SCRAM_ARCH}."/".$H->{'name'};
177	sashby	1.2	}
178	muzaffar	1.17	}
179	sashby	1.2	else
180	sashby	1.3	{
181	muzaffar	1.17	$storename .= $H->{'name'};
182	sashby	1.3	}
183	muzaffar	1.17	my $key ="SCRAMSTORENAME_".uc($H->{'name'});
184			$key=~s/\//_/g;
185			$store->{$key}=$storename;
186	sashby	1.2	}
187	muzaffar	1.17	$item->productstore($store);
188	sashby	1.2	}
189	muzaffar	1.17	}
190	sashby	1.2
191			sub update()
192			{
193			my $self=shift;
194	muzaffar	1.17	my ($dircache, $toolmanager) = @_;
195	sashby	1.2	$self->{TOOLMANAGER} = $toolmanager;
196
197	muzaffar	1.17	my $newbf = $dircache->get_data("ADDEDBF");
198			my $newdir = $dircache->get_data("ADDEDDIR");
199			use File::Path;
200			my $mkpath = $ENV{LOCALTOP}."/".$ENV{SCRAM_INTwork}."/MakeData";
201			my $mkpubpath = $ENV{LOCALTOP}."/.SCRAM/".$ENV{SCRAM_ARCH}."/MakeData";
202			mkpath("${mkpath}/DirCache",0,0755);
203			mkpath("${mkpath}/RmvDirCache",0,0755);
204			mkpath("$mkpubpath/DirCache",0,0755);
205			my %runeng = ();
206			my $projinfo=undef;
207	muzaffar	1.23.2.1	eval ("use SCRAM_ExtraBuildRule;");
208			if(!$@) {$projinfo = SCRAM_ExtraBuildRule->new();}
209	muzaffar	1.17	if ($newbf)
210	sashby	1.2	{
211	muzaffar	1.17	foreach my $bf ("$ENV{SCRAM_BUILDFILE}.xml","$ENV{SCRAM_BUILDFILE}")
212			{
213			if (exists $newbf->{$ENV{SCRAM_CONFIGDIR}."/${bf}"})
214			{
215			my $treeitem = $self->updatedirbf($dircache,$ENV{SCRAM_SOURCEDIR},$ENV{SCRAM_CONFIGDIR}."/${bf}");
216			$self->updateproductstore($treeitem);
217			$runeng{$ENV{SCRAM_SOURCEDIR}}=$treeitem;
218			delete $newbf->{$ENV{SCRAM_CONFIGDIR}."/${bf}"};
219			last;
220			}
221			}
222	sashby	1.2	}
223	muzaffar	1.17	if ($newdir)
224	sashby	1.2	{
225	muzaffar	1.17	foreach my $path (keys %{$newdir})
226			{
227			if (!exists $newdir->{$path}) {next;}
228			if ($path!~/^$ENV{SCRAM_SOURCEDIR}\/(.+)/){delete $newdir->{$path};next;}
229	muzaffar	1.23.2.1	if ($path eq "$ENV{SCRAM_SOURCEDIR}/$ENV{SCRAM_SOURCEDIR}"){print "****WARNING: SCRAM does not support to have directory $ENV{LOCALTOP}/$ENV{SCRAM_SOURCEDIR}/$ENV{SCRAM_SOURCEDIR}.\n";next;}
230	muzaffar	1.17	my $cinfo = $self->buildclass($path);
231			if ($cinfo && $cinfo->[2] ne ""){$dircache->prune($path,0,$cinfo->[2]);}
232			else
233	sashby	1.2	{
234	muzaffar	1.21	my $dpath = $self->datapath($path);
235			my $pitem=undef;
236	muzaffar	1.23	if (exists $self->{BUILDTREE}->{$dpath})
237			{
238			$pitem=$self->{BUILDTREE}->{$dpath};
239			if (defined $pitem)
240			{
241			my $bf = $pitem->metabf();
242			if (scalar(@$bf)>0)
243			{
244			$bf=$bf->[0];
245			if (!exists $newbf->{$bf})
246			{
247			delete $newdir->{$path};
248			next;
249			}
250			}
251			}
252			}
253	muzaffar	1.21	my $item = $self->updatedirbf($dircache,$path,"",$cinfo);
254			my $flag=0;
255	muzaffar	1.17	if (!defined $projinfo)
256			{
257			if ($cinfo->[0] eq "library"){$flag=1;}
258			}
259			else
260			{
261			$flag=$projinfo->ispublic($item);
262			}
263	muzaffar	1.21	$runeng{$path}=$item;
264	muzaffar	1.17	if ($flag)
265			{
266			my $treeitem = $self->{BUILDTREE}->{$dpath};
267			$dircache->{PACKMAP}{$treeitem->parent()}=$dpath;
268			$item->publictype (1);
269			}
270			}
271	sashby	1.2	}
272			}
273	muzaffar	1.17
274			my %mkrebuild=();
275			$mkrebuild{"${mkpath}/RmvDirCache"}=1;
276			my $remdir = $dircache->get_data("REMOVEDDIR");
277			if ($remdir)
278	sashby	1.2	{
279	muzaffar	1.17	foreach my $path (keys %{$remdir})
280			{
281			delete $remdir->{$path};
282			my $spath = $path; $spath =~ s\|/\|_\|g;
283			open(OFILE,">${mkpath}/RmvDirCache/${spath}.mk");
284			print OFILE "REMOVED_DIRS += $path\n";
285			close(OFILE);
286			my $mpath = "${mkpath}/DirCache/${spath}.mk";
287			if (!-f $mpath)
288			{
289			$mpath = "${mkpubpath}/DirCache/${spath}.mk";
290			}
291			if (-f $mpath)
292	sashby	1.11	{
293	muzaffar	1.17	unlink $mpath;
294			$mkrebuild{dirname($mpath)}=1;
295			}
296	sashby	1.11	}
297	sashby	1.2	}
298
299	muzaffar	1.17	if ($newbf)
300	sashby	1.9	{
301	muzaffar	1.17	foreach my $bf (keys %{$newbf})
302			{
303			my $dpath = $self->datapath($bf);
304			if (exists $dircache->{PACKMAP}{$dpath})
305			{
306			$dpath = $dircache->{PACKMAP}{$dpath};
307			}
308			$self->scan($bf,$dpath);
309			$self->{BUILDTREE}->{$dpath}->metabf($bf);
310			$runeng{"$ENV{SCRAM_SOURCEDIR}/${dpath}"} = $self->{BUILDTREE}->{$dpath};
311			delete $newbf->{$bf};
312			}
313			}
314			foreach my $path (sort {$a cmp $b} keys %runeng)
315			{
316			my $treeitem = $runeng{$path};
317			delete $newdir->{$path};
318			$self->run_engine($treeitem);
319			if (exists $treeitem->{MKDIR})
320			{
321			foreach my $d (keys %{$treeitem->{MKDIR}})
322			{
323			$d=~s/\/\//\//;
324			$mkrebuild{$d}=1;
325			}
326			delete $treeitem->{MKDIR};
327	sashby	1.2	}
328			}
329	muzaffar	1.17	foreach my $dir (keys %mkrebuild)
330			{
331			open(MKFILE,">${dir}.mk") \|\| die "Can not open file for writing: ${dir}.mk";
332			close(MKFILE);
333			if (-d $dir)
334			{
335	muzaffar	1.20	system("cd $dir; find . -name \"*\" -type f \| xargs -n 2000 cat >> ${dir}.mk");
336	muzaffar	1.17	}
337			}
338	sashby	1.2	}
339
340			sub scan()
341			{
342			my $self=shift;
343	sashby	1.16	my ($buildfile, $datapath) = @_;
344	sashby	1.7	my $bfparse;
345	muzaffar	1.23.2.1	$bfparse=BuildSystem::BuildFile->new(1);
346	sashby	1.7	# Execute the parse:
347	sashby	1.2	$bfparse->parse($buildfile);
348	sashby	1.3	# See if there were skipped dirs:
349			my $skipped = $bfparse->skippeddirs($datapath);
350			# Check to see if there was an info array for this location.
351			# If so, we extract the first element of the array (i.e. ->[1])
352			# and store it under the datapath entry. This is just so that useful
353			# messages explaining why the dir was skipped can be preserved.
354			if (ref($skipped) eq 'ARRAY')
355			{
356			$self->skipdir($datapath,$skipped->[1]);
357			}
358	sashby	1.2
359			$self->storedata($datapath, $bfparse);
360	muzaffar	1.17
361	sashby	1.2	return $self;
362			}
363
364			sub init_engine()
365			{
366			my $self=shift;
367	muzaffar	1.23.2.1	if (!exists $self->{TEMPLATE_ENGINE})
368			{
369			# Create the interface to the template engine:
370			use BuildSystem::TemplateInterface;
371			# Pass in the config dir as the location where templates live:
372			$self->{TEMPLATE_ENGINE} = BuildSystem::TemplateInterface->new();
373			}
374	sashby	1.2	}
375
376			sub run_engine()
377			{
378			my $self=shift;
379			my ($templatedata)=@_;
380			$self->{TEMPLATE_ENGINE}->template_data($templatedata);
381			$self->{TEMPLATE_ENGINE}->run();
382			return $self;
383			}
384
385			sub buildclass
386			{
387			my $self=shift;
388			my ($path)=@_;
389			my $cache=[];
390	sashby	1.11	# From Lassi TUURA (with mods by me):
391			#
392	sashby	1.2	# Associate a path with ClassPath setting.
393			# For now, just assumes global data has been scanned and class settings
394			# are already known (in $self->{CONFIGDATA}->classpath()).
395			# Generate more optimal classpath data structure, only once.
396			# Split every cache definition into an array of pairs, directory
397			# name and class. So ClassPath of type "+foo/+bar/src+library"
398			# becomes [ [ "" "foo" ] [ "" "bar" ] [ "src" "library" ] ]
399	muzaffar	1.23.2.1
400	sashby	1.16	my @CLASSPATHS=@{$self->{BUILDTREE}->{$ENV{SCRAM_SOURCEDIR}}->rawdata()->{content}->{CLASSPATH}};
401			# This does not work, even though classpath() is a valid method and rawdata()
402			# returns an object blessed into the correct type:
403			# my @CLASSPATHS=@{$self->{BUILDTREE}->{$ENV{SCRAM_SOURCEDIR}}->rawdata()->classpath()};
404
405	sashby	1.2	if (! scalar @$cache)
406			{
407			foreach my $classpath (@CLASSPATHS)
408			{
409			push (@$cache, [map { [ split(/\+/, $_) ] } split(/\//, $classpath)]);
410			}
411			}
412
413			print "WARNING: No ClassPath definitions, nothing will be done!","\n",
414			if (! scalar @$cache);
415			# Now scan the class paths. All the classpaths are given a rank
416			# to mark how relevant they are, and then the best match is chosen.
417			#
418			# The ranking logic is as follows. We scan each class path and
419			# drop if it doesn't match at all. For paths that match, we
420			# record how many components of the class was not used to match
421			# on the class: for a short $path, many classes will match.
422			# For each path component we record whether the match was exact
423			# (if the class part is empty, i.e. "", it's a wildcard that
424			# matches everything). Given these rankings, we pick
425			# - the first class that
426			# - has least unmatched components
427			# - with first or longest exact match sequence in
428			# left-to-right order.
429			my @ranks = ();
430			my @dirs = split(/\/+/, $path);
431			CLASS: foreach my $class (@$cache)
432			{
433			# The first two members of $rank are fixed: how much of path
434			# was and was not used in the match.
435			my $rank = [[], [@dirs]];
436			foreach my $component (@$class)
437			{
438			my $dir = $rank->[1][0];
439			if (! defined $dir)
440			{
441			# Path exhausted. Leave used/unused as is.
442			last;
443			}
444			elsif ($component->[0] eq "")
445			{
446			# Wildcard match, push class and use up path
447			push(@$rank, [1, $component->[1]]);
448			push(@{$rank->[0]}, shift(@{$rank->[1]}));
449			}
450			elsif ($component->[0] eq $dir)
451			{
452			# Exact match, push class and use up path
453			push(@$rank, [0, $component->[1]]);
454			push(@{$rank->[0]}, shift(@{$rank->[1]}));
455			}
456			else
457			{
458			# Unmatched, leave used/unused as is.
459			last;
460			}
461			}
462
463			push(@ranks, $rank);
464			}
465
466			# If no classes match, bail out:
467			if (! scalar @ranks)
468			{
469			return "";
470			}
471
472			# Sort in ascending order by how much was of class was not used;
473			# the first entry has least "extra" trailing match data. Then
474			# truncate to only those equal to the best rank.
475			my @sorted = sort { scalar(@{$a->[1]}) <=> scalar(@{$b->[1]}) } @ranks;
476			my @best = grep(scalar(@{$_->[1]}) == scalar(@{$sorted[0][1]}), @sorted);
477
478			# Now figure which of the best-ranking classes have the longest
479			# exact match in left-to-right order (= which one is first, and
480			# those with equal first exact match, longest exact match).
481			my $n = 0;
482			my $class = $best[$n][scalar @{$best[$n]}-1];
483			# Return the class data:
484			return [ $class->[1], join('/', @{$best[$n][0]}), join('/', @{$best[$n][1]}) ];
485			}
486
487			sub storedata
488			{
489			my $self=shift;
490			my ($datapath, $data)=@_;
491			# Store the content of this BuildFile in cache:
492			$self->{BUILDTREE}->{$datapath}->rawdata($data);
493			return $self;
494			}
495
496			sub removedata
497			{
498			my $self=shift;
499			my ($removedpaths) = @_;
500
501			foreach my $rd (@$removedpaths)
502			{
503			my $datapath = $self->datapath($rd);
504			# Remove all data, recursively, from $datapath:
505			$self->recursive_remove_data($datapath);
506			}
507
508			return $self;
509			}
510
511			sub recursive_remove_data()
512			{
513			my $self=shift;
514			my ($datapath)=@_;
515
516			# Delete main entry in build data via TreeItem:
517			if (exists($self->{BUILDTREE}->{$datapath}))
518			{
519			# We also must modify the parent TreeItem to remove the child
520			# from SAFE_SUBDIRS as well as from CHILDREN array:
521			my $parent = $self->{BUILDTREE}->{$datapath}->parent();
522			$self->{BUILDTREE}->{$parent}->updatechildlist($datapath);
523
524			# Get the children:
525			my @children = $self->{BUILDTREE}->{$datapath}->children();
526
527			foreach my $childpath (@children)
528			{
529			# The child path value is the datapath so can be used
530			# directly when deleting data entries
531			$self->recursive_remove_data($childpath);
532			}
533
534			# Finally, delete the parent data (a TreeItem):
535			delete $self->{BUILDTREE}->{$datapath};
536			}
537
538			# return:
539			return $self;
540			}
541
542			sub storebranchmetadata()
543			{
544			my $self=shift;
545			my ($datapath,$data)=@_;
546
547			# Store the content of this BuildFile in cache:
548			$self->{BUILDTREE}->{$datapath}->branchmetadata($data);
549			return $self;
550			}
551
552			sub buildobject
553			{
554			my $self=shift;
555			my ($datapath)=@_;
556
557			if (exists($self->{BUILDTREE}->{$datapath}) && defined($self->{BUILDTREE}->{$datapath}->rawdata()))
558			{
559			return $self->{BUILDTREE}->{$datapath}->rawdata();
560			}
561			else
562			{
563			return undef;
564			}
565			}
566
567			sub metaobject
568			{
569			my $self=shift;
570			my ($datapath)=@_;
571
572			if (exists($self->{BUILDTREE}->{$datapath}) && defined($self->{BUILDTREE}->{$datapath}->branchmetadata()))
573			{
574			return $self->{BUILDTREE}->{$datapath}->branchmetadata();
575			}
576			else
577			{
578			return undef;
579			}
580			}
581
582	sashby	1.6	sub searchprojects()
583			{
584			my $self=shift;
585			my ($group,$projectref)=@_;
586
587			foreach my $pjt (keys %{$self->{SCRAM_PROJECTS}})
588			{
589			print "Checking for group $group in SCRAM project $pjt","\n", if ($ENV{SCRAM_DEBUG});
590			# As soon as a project is found to have defined $group, we return
591			# the project name:
592			if (exists $self->{SCRAM_PROJECTS}->{$pjt}->{KNOWNGROUPS}->{$group})
593			{
594			# Store the project name and data path:
595	muzaffar	1.17	$$projectref="project ".uc($pjt)." (".$self->{SCRAM_PROJECTS}->{$pjt}->{KNOWNGROUPS}->{$group}."/".$ENV{SCRAM_BUILDFILE}.")";
596	sashby	1.6	return(1);
597			}
598			}
599
600			# No group found to have been defined already so return false:
601			return (0);
602			}
603
604	sashby	1.2	sub findgroup
605			{
606			my $self=shift;
607			my ($groupname) = @_;
608
609			if (exists $self->{KNOWNGROUPS}->{$groupname})
610			{
611			# If group exists, return data:
612			return $self->{KNOWNGROUPS}->{$groupname};
613			}
614			else
615			{
616			# Not found so return:
617			return(0);
618			}
619			}
620
621			sub knowngroups
622			{
623			my $self=shift;
624			@_ ? $self->{KNOWNGROUPS}=shift
625			: $self->{KNOWNGROUPS}
626			}
627
628			sub scramprojectbases()
629			{
630			my $self=shift;
631			return $self->{SCRAM_PROJECT_BASES};
632			}
633
634			sub alldirs
635			{
636			my $self=shift;
637			return @{$self->{ALLDIRS}};
638			}
639
640	sashby	1.3	sub skipdir
641			{
642			my $self=shift;
643			my ($dir, $message) = @_;
644
645			# Set the info if we have both args:
646			if ($dir && $message)
647			{
648			$self->{SKIPPEDDIRS}->{$dir} = $message;
649			}
650			# If we have the dir name only, return true if
651			# this dir is to be skipped:
652			elsif ($dir)
653			{
654			(exists($self->{SKIPPEDDIRS}->{$dir})) ? return 1 : return 0;
655			}
656			else
657			{
658			# Dump the list of directories and the message for each:
659			foreach my $directory (keys %{$self->{SKIPPEDDIRS}})
660			{
661			print "Directory \"",$directory,"\" skipped by the build system";
662			if (length($self->{SKIPPEDDIRS}->{$directory}->[0]) > 10)
663			{
664			chomp($self->{SKIPPEDDIRS}->{$directory}->[0]);
665			my @lines = split("\n",$self->{SKIPPEDDIRS}->{$directory}->[0]); print ":\n";
666			foreach my $line (@lines)
667			{
668			next if ($line =~ /^\s*$/);
669			print "\t-- ",$line,"\n";
670			}
671			print "\n";
672			}
673			else
674			{
675			print ".","\n";
676			}
677			}
678			}
679			}
680
681	sashby	1.11	# Keep a record of which packages are missed by each location
682			# so that, on subsequent updates, these can be inserted auto-
683			# matically in the metadata for the location:
684			sub unresolved()
685			{
686			my $self=shift;
687			my ($location, $pneeded) = @_;
688			# Need to record a mapping "LOCATION -> [ missing packages ]" and a
689			# reverse-lookup "<missing package> -> [ LOCATIONS (where update required) ]"
690			$self->{UNRESOLVED_DEPS_BY_LOC}->{$location}->{$pneeded} = 1;
691			$self->{UNRESOLVED_DEPS_BY_PKG}->{$pneeded}->{$location} = 1;
692			}
693
694	sashby	1.2	sub verbose
695			{
696			my $self=shift;
697			# Turn on verbose mode:
698			@_ ? $self->{VERBOSE} = shift
699			: $self->{VERBOSE}
700			}
701
702			sub cachestatus()
703			{
704			my $self=shift;
705			# Set/return the status of the cache:
706			@_ ? $self->{STATUS} = shift
707			: $self->{STATUS}
708			}
709
710			sub logmsg
711			{
712			my $self=shift;
713			# Print a message to STDOUT if VERBOSE is true:
714			print STDERR @_ if $self->verbose();
715			}
716
717			sub name()
718			{
719			my $self=shift;
720			# Set/return the name of the cache to use:
721			@_ ? $self->{CACHENAME} = shift
722			: $self->{CACHENAME}
723			}
724
725			sub save()
726			{
727			my $self=shift;
728			# Delete unwanted stuff:
729			delete $self->{DEPENDENCIES};
730			delete $self->{TOOLMANAGER};
731			delete $self->{TEMPLATE_ENGINE};
732			delete $self->{SCRAM_PROJECTS};
733			delete $self->{SCRAM_PROJECT_BASES};
734			return $self;
735			}
736
737			1;