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.13.2.3 2006/09/04 15:17:51 sashby 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;

@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};
   
   # 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
      {
      # Check to see if there are any SCRAM-managed projects in our local requirements:
      my $scramprojects = $::scram->_loadscramdb();
      
      # Look for a match in the scram db:
      foreach my $S (@$selected)
         {
         if (exists ($scramprojects->{$S}))
            {
            # Now check the version required exists in
            # list of scram projects with this name:
            while (my ($pdata,$plocation) = each %{$scramprojects->{$S}})
               {
               # Split the $pdata string to get the real name and the version:
               my ($pname,$pversion) = split(":",$pdata);
               if ($pversion eq $self->defaultversion($S))
                  {
                  # Get the tool manager for the scram project:
                  my $sa=$::scram->scramfunctions()->scramprojectdb()->getarea($pname,$pversion);
                  # Load the tool cache:
                  if ( -r $sa->toolcachename())
                     {
                     use Cache::CacheUtilities;
                     my $satoolmanager=&Cache::CacheUtilities::read($sa->toolcachename());
                     # Copy needed content from toolmanager for scram-managed project only
                     # if the projects have compatible configurations (compare first set of
                     # digits):
                     if ($self->check_compatibility($satoolmanager))
                        {
                        $self->inheritcontent($satoolmanager);
                        }
                     }
                  }
               }
            # Also add this scram-managed project to list of tools to set up:
            push(@localtools,$S);
            }
         else
            {
            # 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
            {
            print $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));   
         }
      }
   
   print "\n";
   }

sub coresetup()
   {
   my $self=shift;
   my ($toolname, $toolversion, $toolfile, $force) = @_;
   my ($toolcheck, $toolparser);
   
   print "\n";
   print $::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();
      # 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";
   
   if ( -f $filename )
      {
      print "\n";
      print $::bold."Setting up SELF:".$::normal,"\n";
      # Self file exists so process it:
      $selfparser = BuildSystem::ToolParser->new();
      $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);
      print "\n";
      }
   else
      {
      print "\n";
      print "SCRAM: No file config/Self...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->{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;
   
   # 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)
         {
         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};
   }

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