src/BuildSystem/ToolManager.pm

#____________________________________________________________________ 
# File: ToolManager.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2003-11-12 15:04:16+0100
# Revision: $Id: ToolManager.pm,v 1.15.2.5 2007/12/13 14:35:44 muzaffar Exp $ 
#
# Copyright: 2003 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::ToolManager;
require 5.004;

use Exporter;
use BuildSystem::ToolCache;
use BuildSystem::ToolParser;
use Utilities::AddDir;
use URL::URLhandler;
use Utilities::Verbose;
use SCRAM::MsgLog;

@ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
@EXPORT_OK=qw( );
#

sub new
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Wed Nov 12 10:34:10 2003 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   {
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self=$class->SUPER::new();    # Inherit from ToolCache
   my $projectarea=shift;

   bless $self,$class;
   
   $self->{arch}=shift;
   $self->{topdir}=$projectarea->location();
   $self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
   $self->{cache}=$projectarea->cache();    # Download tool cache
   $self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
   $self->{datastore}=$self->{topdir}."/.SCRAM";
   $self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
   $self->{tooltimestamp}="timestamps";
   
   # Make sure our tool download dir exists:
   AddDir::adddir($self->{toolfiledir});
   AddDir::adddir($self->{archstore});
   
   # Set the tool cache file to read/write:
   $self->name($projectarea->toolcachename());

   # Check for the downloaded tools cache:
   if (exists($self->{cache}))
      {
      $self->{urlhandler}=URL::URLhandler->new($self->{cache});
      }
   
   return $self;
   }

sub clone()
   {
   my $self=shift;
   my $projectarea=shift;

   # Change cache settings to reflect the new location:
   $self->{topdir}=$projectarea->location();

   $self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
   $self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
   $self->{datastore}=$self->{topdir}."/.SCRAM";
   $self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};

   # Change the cache name:
   $self->name($projectarea->toolcachename());
   $self->cloned_tm(1);
   
   return $self;
   }

sub arch_change_after_copy()
   {
   my $self=shift;
   my ($newarch, $cachename)=@_;
   # Make changes to arch-specific settings when copying tool manager
   # object to another arch during setup:
   $self->{arch} = $newarch;
   $self->{archstore} = $self->{topdir}."/.SCRAM/".$newarch;
   # Change the name of the cache to reflect new (arch-specific) location:
   $self->name($cachename);
   }

sub interactive()
   {
   my $self=shift;
   # Interactive mode on/off:
   @_ ? $self->{interactive} = shift
      : ((defined $self->{interactive}) ? $self->{interactive} : 0);
   }

sub setupalltools()
   {
   my $self = shift;
   my ($arealocation,$setupopt) = @_;
   my (@localtools);
   my $selected;
   
   # Get the selected tool list. Handle the case where there might not be
   # any selected tools: //FIXME: need to handle case where there are no
   # selected tools (not very often but a possibility):
   my $sel = $self->selected();
   
   if (defined ($sel))
      {
      $selected = [ keys %{$sel} ];
      }
   
   # Setup option "setupopt" directs the setup: 1 is for booting from
   # scratch, 0 is when just doing "scram setup" (in this case we don't
   # want to pick up everything from any scram-managed projects):
   if ($setupopt == 1) # We're booting from scratch
      {
      # Look for a match in the scram db:
      foreach my $S (@$selected)
         {
            # Store other tools in ReqDoc in separate array. We will set up these tools later:
            push(@localtools,$S);
         }
      
      # Set up extra tools required in this project, in addition to
      # any scram-managed projects
      foreach my $localtool (@localtools)
         {
         # First check to see if it's already set up (i.e., was contained
         # in list of requirements for scram project):
         if (! $self->definedtool($localtool))
            {
            $self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
            $self->addtoselected($localtool);
            }
         else
            {
            scramlogmsg($localtool," already set up.","\n"),if ($ENV{SCRAM_DEBUG});
            }
         }
      }
   else
      {
      # Just loop over all tools and setup again:
      foreach my $localtool (@{$selected})
         {
         $self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));   
         }
      }
   
   scramlogmsg("\n");
   }

sub coresetup()
   {
   my $self=shift;
   my ($toolname, $toolversion, $toolfile, $force) = @_;
   my ($toolcheck, $toolparser);
   
   scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n");
   
   # New ToolParser object for this tool if there isn't one already.
   # Look in array of raw tools to see if this tool has a ToolParser object:
   $toolcheck=0;
   
   map
      {
      if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
      } $self->rawtools();
   
   # Tool not known so we create a new ToolParser object and parse it:
   if ($toolcheck != 1 || $force == 1)
      {
      $toolparser = BuildSystem::ToolParser->new();
      $toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
      $toolparser->filetail('</doc>');
      # We only want to store the stuff relevant for one particular version:
      $toolparser->parse($toolname, $toolversion, $toolfile);
      # Store the ToolParser object in the cache:
      $self->store($toolparser);
      print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG});
      }
   
   # Next, set up the tool:
   my $store = $toolparser->processrawtool($self->interactive());
   # Make sure that we have this tool in the list of selected tools (just in case this tool was
   # set up by hand afterwards):
   $self->addtoselected($toolname);

   # Check to see if this tool is a compiler. If so, store it.
   # Also store the language that this compiler supprots, and a
   # compiler name (e.g. gcc323) which, in conjunction with a stem
   # architecture name like slc3_ia32_, can be used to build a complete arch string:
   if ($store->scram_compiler() == 1)
      {
      my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
      my @compilername = $store->flags("SCRAM_COMPILER_NAME");
      $self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
      }
   
   # Store the ToolData object in the cache:   
   $self->storeincache($toolparser->toolname(),$store);
   return $self;
   }

sub toolsetup()
   {
   my $self=shift;
   my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
   my ($urlcache, $url, $filename, $tfname);
   my $toolfile;
   my $force = 0; # we may have to force a reparse of a tool file
   
   $toolname =~ tr[A-Z][a-z];
   $toolversion ||= $self->defaultversion($toolname);
   $urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
   
   # Check for the downloaded tools cache:
   if (defined($urlcache))
      {
      $self->{urlhandler}=URL::URLhandler->new($urlcache);
      }

   $url = $self->toolurls()->{$toolname};
   $filename = $self->{toolfiledir}."/".$toolname;
   
   # If .SCRAM/InstalledTools doesn't exist, create it:
   if (! -d $self->{toolfiledir})
      {
      AddDir::adddir($self->{toolfiledir});
      }
   
   # First, check to see if there was a tool URL given. If so, we might need to read
   # from http or from a file: type URL:
   if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
      {      
      # See what kind of URL (file:, http:, cvs:, svn:, .. ):
      if ($proto eq 'file')
         {
         # Check to see if there is a ~ and substitute the user
         # home directory if there is (file:~/xyz):      
         if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|))
            {
            $urlv = $ENV{HOME}."/".$urlpath;
            }
         elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|))
            {
            # Relative to current directory (file:./xyz):
            use Cwd qw(&cwd);
            $urlv = cwd()."/".$urlpath;
            }
         
         # If the tool url is a file and the file exists,
         # copy it to .SCRAM/InstalledTools and set the
         # filename accordingly:
         if ( -f $urlv)
            {
            use File::Copy;
            copy($urlv, $filename);
            my $mode = 0644; chmod $mode, $filename;
            $toolfile=$filename;
            # Here we must account for the fact that the file tool doc may be
            # a modified version of an existing tool in the current config. we
            # make sure that this file is reparsed, even if there is already a
            # ToolParser object for the tool:
            $force = 1;
            }
         else
            {
            $::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!");               
            }
         }
      elsif ($proto eq 'http')
         {
         print "SCRAM: downloading $toolname from $toolurl","\n";
         # Download from WWW first:
         use LWP::Simple qw(&getstore);
         my $http_response_val = &getstore($toolurl, $filename);
         
         # Check the HTTP status. If doc not found, exit:
         if ($http_response_val != 200)
            {
            my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|);         
            $::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
            }
         else
            {
            $toolfile=$filename;
            }
         }
      elsif ($proto eq 'cvs')
         {
         print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
         print "[ not yet supported ]","\n";
         exit(0);
         }
      elsif ($proto eq 'svn')
         {
         print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
         print "[ not yet supported ]","\n";
         exit(0);
         }
      else
         {
         $::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
         }
      }
   else
      {
      # Copy the downloaded tool file to InstalledTools directory:
      if ( ! -f $filename )
         {
         # If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
         # We signal an error and exit:
         if ($url eq '')
            {
            $::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
            }
         else
            {
            # Otherwise, we try to download it:
            $self->verbose("Attempting Download of $url");
            # Get file from download cache:
            ($url,$filename)=$self->{urlhandler}->get($url);                
            use File::Copy;
            $tfname=$self->{toolfiledir}."/".$toolname;  
            copy($filename, $tfname);
            my $mode = 0644; chmod $mode, $tfname;
            $toolfile=$tfname;
            }
         }
      else
         {
         # File already exists in the .SCRAM/InstallTools directory:
         $toolfile=$filename;
         }
      }
   
   # Run the core setup routine:
   $self->coresetup($toolname, $toolversion, $toolfile,$force);
   return $self;
   }

sub setupself()
   {
   my $self=shift;
   my ($location)=@_;
   # Process the file "Self" in local config directory. This is used to
   # set all the paths/runtime settings for this project:
   my $filename=$location."/config/Self.xml";

   if ( -f $filename )
      {
      scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
      # Self file exists so process it:
      $selfparser = BuildSystem::ToolParser->new();
      $selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
      $selfparser->filehead ('</doc>');
      $selfparser->parse('self','SELF',$filename);

      # Next, set up the tool:
      $store = $selfparser->processrawtool($self->interactive());

      # If we are in a developer area, also add RELEASETOP paths:
      if (exists($ENV{RELEASETOP}))
         {
         print "\nAdding RELEASE area settings to self....OK","\n", if ($ENV{SCRAM_DEBUG});
         $store->addreleasetoself();
         }
      
      # Store the ToolData object in the cache:
      $self->storeincache($selfparser->toolname(),$store);
      scramlogmsg("\n");
      }
   else
      {
      scramlogdump();
      print "\n";
      print "SCRAM: No file config/Self.xml...nothing to do.";
      print "\n";
      return;
      }
   }

sub defaultversion()
   {
   my $self = shift;
   my ($tool) = @_;
   # Return default versions as taken from configuration:
   return (%{$self->defaultversions()}->{$tool});
   }

sub storeincache()
   {
   my $self=shift;
   my ($toolname,$dataobject)=@_;

   # Store ToolData object (for a set-up tool) in cache:
   if (ref($dataobject) eq 'BuildSystem::ToolData')
      {
      $self->updatetooltimestamp($dataobject, $toolname);
      $self->{SETUP}->{$toolname} = $dataobject;
      }
   else
      {
      $::scram->scramerror("ToolManager: BuildSystem::ToolData object reference expected.")
      }
   }

sub tools()
   {
   my $self = shift;
   my @tools;
   
   map
      {
      if ($_ ne "self")
         {
         push(@tools, $_);
         }
      } keys %{$self->{SETUP}};
   
   # Return list of set-up tools:
   return @tools;
   }

sub toolsdata()
   {
   my $self = shift;
   my $tooldata = [];
   my $rawsel = $self->selected();
   
   foreach my $tool ( sort { %{$rawsel}->{$a}
                             <=> %{$rawsel}->{$b}}
                      keys %{$rawsel} )
      {
      # Return tool data objects of all set-up tools, skipping the tool "self":
      if ($_ ne "self")
         {
         # Keep only tools that have really been set up:
         if (exists $self->{SETUP}->{$tool})
            {
            push(@tooldata,$self->{SETUP}->{$tool});
            }
         }
      }
   
   # Return the array of tools, in order that they appear in RequirementsDoc:
   return @tooldata;
   }

sub definedtool()
   {
   my $self=shift;
   my ($tool)=@_;
   
   # Check to see if tool X is an external tool:
   grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
      : return 0;
   }

sub checkifsetup()
   {
   my $self=shift;
   my ($tool)=@_;
   # Return the ToolData object if the tool has been set up:
   (exists $self->{SETUP}->{$tool}) ? return ($self->{SETUP}->{$tool})
      : return undef;
   }

sub cloned_tm()
   {
   my $self=shift;
   # Has this area already been cloned and brought in-line with current location:
   @_ ? $self->{CLONED} = $_[0]
      : $self->{CLONED};
   }

sub remove_tool()
   {
   my $self=shift;
   my ($toolname)=@_;
   my $tools = $self->{SETUP};
   my $newtlist = {};
   
   while (my ($tool, $tooldata) = each %$tools)
      {
      if ($tool ne $toolname)
         {
         $newtlist->{$tool} = $tooldata;
         }
      else
         {
         # Is this tool a compiler?
         if ($tooldata->scram_compiler() == 1)
            {
            # Also remove this from the compiler info if there happens to be an entry:
            while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
               {
               if ($toolname eq $ctool->[0])
                  {
                  delete $self->{SCRAM_COMPILER}->{$langtype};
                  print "Deleting compiler $toolname from cache.","\n";
                  }
               }
            }
         else
            {
            print "Deleting $toolname from cache.","\n";
            }
         }
      }
   
   $self->{SETUP} = $newtlist;
   $self->updatetooltimestamp ("", $toolname);
   # Now remove from the RAW tool list:
   $self->cleanup_raw($toolname);
   print "ToolManager: Updating tool cache.","\n";
   $self->writecache();
   }

sub scram_projects()
   {
   my $self=shift;
   my $scram_projects={};

   foreach my $t ($self->tools())
      {
      # Get the ToolData object:
      my $td=$self->{SETUP}->{$t};
      $scram_projects->{$t}=$td->variable_data(uc($t)."_BASE"), if ($td->scram_project());
      }
   
   return $scram_projects;
   }

sub scram_compiler()
   {
   my $self=shift;
   my ($langtype, $toolname, $compilername)=@_;

   if ($langtype)
      {
      # Store the compiler info according to supported
      # language types.
      #
      # ---------------------- e.g C++      cxxcompiler    gcc323
      $self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
      }
   else
      {
      return $self->{SCRAM_COMPILER};
      }
   }

sub updatetool()
   {
   my $self=shift;
   my ($name, $obj) = @_;

   # Replace the existing copy of the tool with the new one:
   if (exists $self->{SETUP}->{$name})
      {
      # Check to make sure that we were really passed a compiler with
      # the desired name:
      if ($obj->toolname() eq $name)
         {
         $self->updatetooltimestamp ($obj, $name);
         print "ToolManager: Updating the cached copy of ".$name."\n";
         delete $self->{SETUP}->{$name};
         $self->{SETUP}->{$name} = $obj;
         $self->writecache();
         }
      else
         {
         print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
         print "         Not making any changes.","\n";
         }
      }
   else
      {
      print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
      }
   }

sub check_compatibility()
   {
   my $self=shift;
   my ($itoolmgr)=@_;
   # Get the version of the toolmanager. If the project fails to return a version
   # string we return 0 for no compatibility (in which case, all tools will be set
   # up in the traditional way):
   my $itm_configversion = $itoolmgr->configversion();
   if ($itm_configversion)
      {
      # The configurations won't be identical. We must compare the digits:
      my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
      my $current_configversion = $self->configversion();
      my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
      ($current_numeric_version == $numeric_version) && return 1; # OK, compatible;
      }
   # Project does not define configuration version so just return:
   return 0;
   }

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

sub updatetooltimestamp ()
   {
   my $self=shift;
   my $obj=shift;
   my $toolname=shift;
   my $samevalues=0;
   my $stampdir = $self->{archstore}."/timestamps";
   my $stampfile="${stampdir}/${toolname}";
   if (exists $self->{SETUP}->{$toolname})
      {
      $samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
      }
   if ((!$samevalues) || (!-f $stampfile))
      {
      if (!-d $stampdir)
         {
         AddDir::adddir($stampdir);
         }
      open(TIMESTAMPFILE,">$stampfile");
      close(TIMESTAMPFILE);
      }
   }

sub comparetoolsdata ()
   {
   my $self=shift;
   my $data1=shift || ();
   my $data2=shift || ();
  
   my $ref1=ref($data1);
   my $ref2=ref($data2);
  
   if ($ref1 ne $ref2)
      {
      return 0;
      }
   elsif ($ref1 eq "CODE")
      {
      return 1;
      }
   elsif(($ref1 eq "SCALAR") || ($ref1 eq ""))
      {
      if ($data1 eq $data2)
         {
         return 1;
         }
      return 0;
      }
   elsif ($ref1 eq "ARRAY")
      {
      my $count = scalar(@$data1);
      if ($count != scalar(@$data2))
         {
         return 0;
         }
      for (my $i=0; $i<$count; $i++)
          {
          if (! $self->comparetoolsdata($data1->[$i],$data2->[$i]))
             {
             return 0;
             }
          }
      return 1;
      }
   else
      {
      foreach my $k (keys %{$data1})
         {
         if (! exists $data2->{$k})
            {
            return 0;
            }
         }
      foreach my $k (keys %{$data2})
         {
         if (! exists $data1->{$k})
            {
            return 0;
            }
         }
      foreach my $k (keys %{$data2})
         {
         if (! $self->comparetoolsdata($data1->{$k},$data2->{$k}))
            {
            return 0;
            }
         }
      return 1;
      }
   }

1;
Revision:	1.19
Committed:	Fri Dec 14 09:03:47 2007 UTC (17 years, 4 months ago) by muzaffar
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_1_7, V1_1_6, V1_1_5, V1_2_0-cand1, V1_1_4, V1_1_3, V1_1_2, V1_1_0_reltag8, V1_1_0_reltag7, V1_1_0_reltag6, V1_1_1, V1_1_0_reltag5, V1_1_0_reltag4, V1_1_0_reltag3, V1_1_0_reltag2, V1_1_0_reltag1, V1_1_0_reltag, V1_1_0_cand3, V1_1_0_cand2, V1_1_0_cand1
Branch point for:	forBinLess_SCRAM
Changes since 1.18:	+9 -9 lines
Log Message:	replace head with xml branch
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: ToolManager.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2003-11-12 15:04:16+0100
7	muzaffar	1.19	# Revision: $Id: ToolManager.pm,v 1.15.2.5 2007/12/13 14:35:44 muzaffar Exp $
8	sashby	1.2	#
9			# Copyright: 2003 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::ToolManager;
13			require 5.004;
14
15			use Exporter;
16			use BuildSystem::ToolCache;
17			use BuildSystem::ToolParser;
18			use Utilities::AddDir;
19			use URL::URLhandler;
20			use Utilities::Verbose;
21	muzaffar	1.19	use SCRAM::MsgLog;
22	sashby	1.2
23			@ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
24			@EXPORT_OK=qw( );
25			#
26	sashby	1.9
27	sashby	1.2	sub new
28			###############################################################
29			# new #
30			###############################################################
31			# modified : Wed Nov 12 10:34:10 2003 / SFA #
32			# params : #
33			# : #
34			# function : #
35			# : #
36			###############################################################
37			{
38			my $proto=shift;
39			my $class=ref($proto) \|\| $proto;
40			my $self=$class->SUPER::new(); # Inherit from ToolCache
41			my $projectarea=shift;
42
43			bless $self,$class;
44
45			$self->{arch}=shift;
46			$self->{topdir}=$projectarea->location();
47			$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
48			$self->{cache}=$projectarea->cache(); # Download tool cache
49			$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
50			$self->{datastore}=$self->{topdir}."/.SCRAM";
51			$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
52	muzaffar	1.18	$self->{tooltimestamp}="timestamps";
53	sashby	1.2
54			# Make sure our tool download dir exists:
55			AddDir::adddir($self->{toolfiledir});
56			AddDir::adddir($self->{archstore});
57
58			# Set the tool cache file to read/write:
59			$self->name($projectarea->toolcachename());
60
61			# Check for the downloaded tools cache:
62			if (exists($self->{cache}))
63			{
64			$self->{urlhandler}=URL::URLhandler->new($self->{cache});
65			}
66
67			return $self;
68			}
69
70			sub clone()
71			{
72			my $self=shift;
73			my $projectarea=shift;
74	sashby	1.3
75	sashby	1.2	# Change cache settings to reflect the new location:
76			$self->{topdir}=$projectarea->location();
77
78			$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
79			$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
80			$self->{datastore}=$self->{topdir}."/.SCRAM";
81			$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
82
83			# Change the cache name:
84			$self->name($projectarea->toolcachename());
85			$self->cloned_tm(1);
86
87			return $self;
88			}
89
90			sub arch_change_after_copy()
91			{
92			my $self=shift;
93			my ($newarch, $cachename)=@_;
94			# Make changes to arch-specific settings when copying tool manager
95			# object to another arch during setup:
96			$self->{arch} = $newarch;
97			$self->{archstore} = $self->{topdir}."/.SCRAM/".$newarch;
98			# Change the name of the cache to reflect new (arch-specific) location:
99			$self->name($cachename);
100			}
101
102			sub interactive()
103			{
104			my $self=shift;
105			# Interactive mode on/off:
106			@_ ? $self->{interactive} = shift
107			: ((defined $self->{interactive}) ? $self->{interactive} : 0);
108			}
109
110			sub setupalltools()
111			{
112			my $self = shift;
113			my ($arealocation,$setupopt) = @_;
114			my (@localtools);
115			my $selected;
116
117			# Get the selected tool list. Handle the case where there might not be
118			# any selected tools: //FIXME: need to handle case where there are no
119			# selected tools (not very often but a possibility):
120			my $sel = $self->selected();
121
122			if (defined ($sel))
123			{
124			$selected = [ keys %{$sel} ];
125			}
126
127			# Setup option "setupopt" directs the setup: 1 is for booting from
128			# scratch, 0 is when just doing "scram setup" (in this case we don't
129			# want to pick up everything from any scram-managed projects):
130			if ($setupopt == 1) # We're booting from scratch
131			{
132			# Look for a match in the scram db:
133	muzaffar	1.18	foreach my $S (@$selected)
134			{
135			# Store other tools in ReqDoc in separate array. We will set up these tools later:
136			push(@localtools,$S);
137			}
138	sashby	1.2
139			# Set up extra tools required in this project, in addition to
140			# any scram-managed projects
141			foreach my $localtool (@localtools)
142			{
143			# First check to see if it's already set up (i.e., was contained
144			# in list of requirements for scram project):
145			if (! $self->definedtool($localtool))
146			{
147			$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
148			$self->addtoselected($localtool);
149			}
150			else
151			{
152	muzaffar	1.19	scramlogmsg($localtool," already set up.","\n"),if ($ENV{SCRAM_DEBUG});
153	sashby	1.2	}
154			}
155			}
156			else
157			{
158			# Just loop over all tools and setup again:
159			foreach my $localtool (@{$selected})
160			{
161			$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
162			}
163			}
164
165	muzaffar	1.19	scramlogmsg("\n");
166	sashby	1.2	}
167
168			sub coresetup()
169			{
170			my $self=shift;
171	sashby	1.13	my ($toolname, $toolversion, $toolfile, $force) = @_;
172	sashby	1.2	my ($toolcheck, $toolparser);
173
174	muzaffar	1.19	scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,": ".$::normal,"\n");
175	sashby	1.2
176			# New ToolParser object for this tool if there isn't one already.
177			# Look in array of raw tools to see if this tool has a ToolParser object:
178			$toolcheck=0;
179
180			map
181			{
182			if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
183			} $self->rawtools();
184
185			# Tool not known so we create a new ToolParser object and parse it:
186	sashby	1.13	if ($toolcheck != 1 \|\| $force == 1)
187	sashby	1.2	{
188			$toolparser = BuildSystem::ToolParser->new();
189	muzaffar	1.18	$toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
190			$toolparser->filetail('</doc>');
191	sashby	1.2	# We only want to store the stuff relevant for one particular version:
192			$toolparser->parse($toolname, $toolversion, $toolfile);
193			# Store the ToolParser object in the cache:
194			$self->store($toolparser);
195	sashby	1.13	print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG});
196	sashby	1.2	}
197
198			# Next, set up the tool:
199			my $store = $toolparser->processrawtool($self->interactive());
200			# Make sure that we have this tool in the list of selected tools (just in case this tool was
201			# set up by hand afterwards):
202			$self->addtoselected($toolname);
203	sashby	1.8
204			# Check to see if this tool is a compiler. If so, store it.
205			# Also store the language that this compiler supprots, and a
206			# compiler name (e.g. gcc323) which, in conjunction with a stem
207			# architecture name like slc3_ia32_, can be used to build a complete arch string:
208			if ($store->scram_compiler() == 1)
209			{
210			my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
211			my @compilername = $store->flags("SCRAM_COMPILER_NAME");
212			$self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
213			}
214
215	sashby	1.16	# Store the ToolData object in the cache:
216	sashby	1.2	$self->storeincache($toolparser->toolname(),$store);
217			return $self;
218			}
219
220			sub toolsetup()
221			{
222			my $self=shift;
223			my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
224			my ($urlcache, $url, $filename, $tfname);
225			my $toolfile;
226	sashby	1.13	my $force = 0; # we may have to force a reparse of a tool file
227	sashby	1.6
228	sashby	1.2	$toolname =~ tr[A-Z][a-z];
229			$toolversion \|\|= $self->defaultversion($toolname);
230			$urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
231	sashby	1.6
232	sashby	1.2	# Check for the downloaded tools cache:
233			if (defined($urlcache))
234			{
235			$self->{urlhandler}=URL::URLhandler->new($urlcache);
236			}
237	sashby	1.6
238	sashby	1.2	$url = $self->toolurls()->{$toolname};
239			$filename = $self->{toolfiledir}."/".$toolname;
240
241	sashby	1.4	# If .SCRAM/InstalledTools doesn't exist, create it:
242			if (! -d $self->{toolfiledir})
243			{
244			AddDir::adddir($self->{toolfiledir});
245			}
246
247	sashby	1.2	# First, check to see if there was a tool URL given. If so, we might need to read
248			# from http or from a file: type URL:
249			if (my ($proto, $urlv) = ($toolurl =~ /(.):(.)/))
250			{
251			# See what kind of URL (file:, http:, cvs:, svn:, .. ):
252			if ($proto eq 'file')
253			{
254	sashby	1.10	# Check to see if there is a ~ and substitute the user
255	sashby	1.13	# home directory if there is (file:~/xyz):
256			if (my ($urlpath) = ($urlv =~ m\|^\~/(.*)$\|))
257			{
258			$urlv = $ENV{HOME}."/".$urlpath;
259			}
260			elsif (my ($urlpath) = ($urlv =~ m\|^\./(.*)$\|))
261			{
262			# Relative to current directory (file:./xyz):
263			use Cwd qw(&cwd);
264			$urlv = cwd()."/".$urlpath;
265			}
266
267	sashby	1.2	# If the tool url is a file and the file exists,
268			# copy it to .SCRAM/InstalledTools and set the
269			# filename accordingly:
270			if ( -f $urlv)
271			{
272			use File::Copy;
273			copy($urlv, $filename);
274	sashby	1.5	my $mode = 0644; chmod $mode, $filename;
275	sashby	1.2	$toolfile=$filename;
276	sashby	1.13	# Here we must account for the fact that the file tool doc may be
277			# a modified version of an existing tool in the current config. we
278			# make sure that this file is reparsed, even if there is already a
279			# ToolParser object for the tool:
280			$force = 1;
281	sashby	1.2	}
282			else
283			{
284	sashby	1.13	$::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!");
285	sashby	1.2	}
286			}
287			elsif ($proto eq 'http')
288			{
289			print "SCRAM: downloading $toolname from $toolurl","\n";
290			# Download from WWW first:
291			use LWP::Simple qw(&getstore);
292			my $http_response_val = &getstore($toolurl, $filename);
293	sashby	1.13
294	sashby	1.2	# Check the HTTP status. If doc not found, exit:
295			if ($http_response_val != 200)
296			{
297			my ($server,$doc) = ($urlv =~ m\|//(.?)/(.)\|);
298			$::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
299			}
300			else
301			{
302			$toolfile=$filename;
303			}
304			}
305			elsif ($proto eq 'cvs')
306			{
307			print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
308			print "[ not yet supported ]","\n";
309			exit(0);
310			}
311			elsif ($proto eq 'svn')
312			{
313			print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
314			print "[ not yet supported ]","\n";
315			exit(0);
316			}
317			else
318			{
319			$::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
320			}
321			}
322			else
323			{
324			# Copy the downloaded tool file to InstalledTools directory:
325			if ( ! -f $filename )
326			{
327	sashby	1.7	# If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
328			# We signal an error and exit:
329	sashby	1.6	if ($url eq '')
330			{
331	sashby	1.7	$::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
332	sashby	1.6	}
333			else
334			{
335			# Otherwise, we try to download it:
336			$self->verbose("Attempting Download of $url");
337			# Get file from download cache:
338			($url,$filename)=$self->{urlhandler}->get($url);
339			use File::Copy;
340			$tfname=$self->{toolfiledir}."/".$toolname;
341			copy($filename, $tfname);
342			my $mode = 0644; chmod $mode, $tfname;
343			$toolfile=$tfname;
344			}
345	sashby	1.2	}
346			else
347			{
348			# File already exists in the .SCRAM/InstallTools directory:
349			$toolfile=$filename;
350			}
351			}
352
353			# Run the core setup routine:
354	sashby	1.13	$self->coresetup($toolname, $toolversion, $toolfile,$force);
355	sashby	1.2	return $self;
356			}
357
358			sub setupself()
359			{
360			my $self=shift;
361			my ($location)=@_;
362			# Process the file "Self" in local config directory. This is used to
363			# set all the paths/runtime settings for this project:
364	sashby	1.16	my $filename=$location."/config/Self.xml";
365
366	sashby	1.2	if ( -f $filename )
367			{
368	muzaffar	1.19	scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
369	sashby	1.2	# Self file exists so process it:
370			$selfparser = BuildSystem::ToolParser->new();
371	muzaffar	1.18	$selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
372			$selfparser->filehead ('</doc>');
373	sashby	1.2	$selfparser->parse('self','SELF',$filename);
374
375			# Next, set up the tool:
376			$store = $selfparser->processrawtool($self->interactive());
377	muzaffar	1.19
378	sashby	1.2	# If we are in a developer area, also add RELEASETOP paths:
379			if (exists($ENV{RELEASETOP}))
380			{
381			print "\nAdding RELEASE area settings to self....OK","\n", if ($ENV{SCRAM_DEBUG});
382			$store->addreleasetoself();
383			}
384
385			# Store the ToolData object in the cache:
386			$self->storeincache($selfparser->toolname(),$store);
387	muzaffar	1.19	scramlogmsg("\n");
388	sashby	1.2	}
389			else
390			{
391	muzaffar	1.19	scramlogdump();
392	sashby	1.2	print "\n";
393	sashby	1.16	print "SCRAM: No file config/Self.xml...nothing to do.";
394	sashby	1.2	print "\n";
395			return;
396			}
397			}
398
399			sub defaultversion()
400			{
401			my $self = shift;
402			my ($tool) = @_;
403			# Return default versions as taken from configuration:
404			return (%{$self->defaultversions()}->{$tool});
405			}
406
407			sub storeincache()
408			{
409			my $self=shift;
410			my ($toolname,$dataobject)=@_;
411
412			# Store ToolData object (for a set-up tool) in cache:
413			if (ref($dataobject) eq 'BuildSystem::ToolData')
414			{
415	sashby	1.16	$self->updatetooltimestamp($dataobject, $toolname);
416	sashby	1.2	$self->{SETUP}->{$toolname} = $dataobject;
417			}
418			else
419			{
420			$::scram->scramerror("ToolManager: BuildSystem::ToolData object reference expected.")
421			}
422			}
423
424			sub tools()
425			{
426			my $self = shift;
427			my @tools;
428
429			map
430			{
431			if ($_ ne "self")
432			{
433			push(@tools, $_);
434			}
435			} keys %{$self->{SETUP}};
436
437			# Return list of set-up tools:
438			return @tools;
439			}
440
441			sub toolsdata()
442			{
443			my $self = shift;
444			my $tooldata = [];
445			my $rawsel = $self->selected();
446
447			foreach my $tool ( sort { %{$rawsel}->{$a}
448			<=> %{$rawsel}->{$b}}
449			keys %{$rawsel} )
450			{
451			# Return tool data objects of all set-up tools, skipping the tool "self":
452			if ($_ ne "self")
453			{
454			# Keep only tools that have really been set up:
455			if (exists $self->{SETUP}->{$tool})
456			{
457			push(@tooldata,$self->{SETUP}->{$tool});
458			}
459			}
460			}
461
462			# Return the array of tools, in order that they appear in RequirementsDoc:
463			return @tooldata;
464			}
465
466			sub definedtool()
467			{
468			my $self=shift;
469			my ($tool)=@_;
470
471			# Check to see if tool X is an external tool:
472			grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
473			: return 0;
474			}
475
476			sub checkifsetup()
477			{
478			my $self=shift;
479			my ($tool)=@_;
480			# Return the ToolData object if the tool has been set up:
481			(exists $self->{SETUP}->{$tool}) ? return ($self->{SETUP}->{$tool})
482			: return undef;
483			}
484
485			sub cloned_tm()
486			{
487			my $self=shift;
488			# Has this area already been cloned and brought in-line with current location:
489			@_ ? $self->{CLONED} = $_[0]
490			: $self->{CLONED};
491			}
492
493			sub remove_tool()
494			{
495			my $self=shift;
496			my ($toolname)=@_;
497			my $tools = $self->{SETUP};
498			my $newtlist = {};
499
500			while (my ($tool, $tooldata) = each %$tools)
501			{
502			if ($tool ne $toolname)
503			{
504			$newtlist->{$tool} = $tooldata;
505			}
506			else
507			{
508	sashby	1.10	# Is this tool a compiler?
509			if ($tooldata->scram_compiler() == 1)
510			{
511			# Also remove this from the compiler info if there happens to be an entry:
512			while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
513			{
514			if ($toolname eq $ctool->[0])
515			{
516			delete $self->{SCRAM_COMPILER}->{$langtype};
517			print "Deleting compiler $toolname from cache.","\n";
518			}
519			}
520			}
521			else
522			{
523			print "Deleting $toolname from cache.","\n";
524			}
525	sashby	1.2	}
526			}
527
528			$self->{SETUP} = $newtlist;
529	sashby	1.16	$self->updatetooltimestamp ("", $toolname);
530	sashby	1.2	# Now remove from the RAW tool list:
531			$self->cleanup_raw($toolname);
532			print "ToolManager: Updating tool cache.","\n";
533			$self->writecache();
534			}
535
536			sub scram_projects()
537			{
538			my $self=shift;
539			my $scram_projects={};
540
541			foreach my $t ($self->tools())
542			{
543			# Get the ToolData object:
544			my $td=$self->{SETUP}->{$t};
545			$scram_projects->{$t}=$td->variable_data(uc($t)."_BASE"), if ($td->scram_project());
546			}
547
548			return $scram_projects;
549			}
550
551	sashby	1.8	sub scram_compiler()
552			{
553			my $self=shift;
554			my ($langtype, $toolname, $compilername)=@_;
555
556			if ($langtype)
557			{
558			# Store the compiler info according to supported
559			# language types.
560			#
561			# ---------------------- e.g C++ cxxcompiler gcc323
562			$self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
563			}
564			else
565			{
566			return $self->{SCRAM_COMPILER};
567			}
568			}
569
570	sashby	1.12	sub updatetool()
571	sashby	1.11	{
572			my $self=shift;
573	sashby	1.12	my ($name, $obj) = @_;
574	sashby	1.11
575			# Replace the existing copy of the tool with the new one:
576	sashby	1.12	if (exists $self->{SETUP}->{$name})
577	sashby	1.11	{
578			# Check to make sure that we were really passed a compiler with
579			# the desired name:
580	sashby	1.12	if ($obj->toolname() eq $name)
581	sashby	1.11	{
582	sashby	1.16	$self->updatetooltimestamp ($obj, $name);
583	sashby	1.12	print "ToolManager: Updating the cached copy of ".$name."\n";
584			delete $self->{SETUP}->{$name};
585			$self->{SETUP}->{$name} = $obj;
586	sashby	1.11	$self->writecache();
587			}
588			else
589			{
590	sashby	1.12	print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
591	sashby	1.11	print " Not making any changes.","\n";
592			}
593			}
594			else
595			{
596	sashby	1.12	print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
597	sashby	1.11	}
598			}
599
600	sashby	1.14	sub check_compatibility()
601			{
602			my $self=shift;
603			my ($itoolmgr)=@_;
604			# Get the version of the toolmanager. If the project fails to return a version
605			# string we return 0 for no compatibility (in which case, all tools will be set
606			# up in the traditional way):
607			my $itm_configversion = $itoolmgr->configversion();
608			if ($itm_configversion)
609			{
610			# The configurations won't be identical. We must compare the digits:
611			my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]\_([0-9a-z]).*?/);
612			my $current_configversion = $self->configversion();
613			my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]\_([0-9a-z]).*?/);
614			($current_numeric_version == $numeric_version) && return 1; # OK, compatible;
615			}
616			# Project does not define configuration version so just return:
617			return 0;
618			}
619
620			sub configversion()
621			{
622			my $self=shift;
623			@_ ? $self->{CONFIGVERSION} = shift
624			: $self->{CONFIGVERSION};
625			}
626
627	sashby	1.16	sub updatetooltimestamp ()
628			{
629			my $self=shift;
630			my $obj=shift;
631			my $toolname=shift;
632			my $samevalues=0;
633	muzaffar	1.18	my $stampdir = $self->{archstore}."/timestamps";
634			my $stampfile="${stampdir}/${toolname}";
635	sashby	1.16	if (exists $self->{SETUP}->{$toolname})
636			{
637			$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
638			}
639	muzaffar	1.18	if ((!$samevalues) \|\| (!-f $stampfile))
640	sashby	1.16	{
641	muzaffar	1.18	if (!-d $stampdir)
642	sashby	1.16	{
643	muzaffar	1.18	AddDir::adddir($stampdir);
644	sashby	1.16	}
645	muzaffar	1.18	open(TIMESTAMPFILE,">$stampfile");
646	sashby	1.16	close(TIMESTAMPFILE);
647			}
648			}
649
650			sub comparetoolsdata ()
651			{
652			my $self=shift;
653			my $data1=shift \|\| ();
654			my $data2=shift \|\| ();
655
656			my $ref1=ref($data1);
657			my $ref2=ref($data2);
658
659			if ($ref1 ne $ref2)
660			{
661			return 0;
662			}
663			elsif ($ref1 eq "CODE")
664			{
665			return 1;
666			}
667			elsif(($ref1 eq "SCALAR") \|\| ($ref1 eq ""))
668			{
669			if ($data1 eq $data2)
670			{
671			return 1;
672			}
673			return 0;
674			}
675			elsif ($ref1 eq "ARRAY")
676			{
677			my $count = scalar(@$data1);
678			if ($count != scalar(@$data2))
679			{
680			return 0;
681			}
682			for (my $i=0; $i<$count; $i++)
683			{
684			if (! $self->comparetoolsdata($data1->[$i],$data2->[$i]))
685			{
686			return 0;
687			}
688			}
689			return 1;
690			}
691			else
692			{
693			foreach my $k (keys %{$data1})
694			{
695			if (! exists $data2->{$k})
696			{
697			return 0;
698			}
699			}
700			foreach my $k (keys %{$data2})
701			{
702			if (! exists $data1->{$k})
703			{
704			return 0;
705			}
706			}
707			foreach my $k (keys %{$data2})
708			{
709			if (! $self->comparetoolsdata($data1->{$k},$data2->{$k}))
710			{
711			return 0;
712			}
713			}
714			return 1;
715			}
716			}
717
718	sashby	1.2	1;