src/BuildSystem/ToolManager.pm

#____________________________________________________________________ 
# File: ToolManager.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Copyright: 2003 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::ToolManager;
require 5.004;

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

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

sub new
   {
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self=$class->SUPER::new();    # Inherit from ToolCache
   bless $self,$class;
   $self->init (shift);
   return $self;
   }

sub initpathvars()
   {
   my $self=shift;
   if (!exists $self->{internal}{path_variables})
      {
      my %pathvars=("PATH", 1, "LD_LIBRARY_PATH", 1, "DYLD_LIBRARY_PATH", 1, "DYLD_FALLBACK_LIBRARY_PATH", 1, "PYTHONPATH", 1);
      my $p = $self->_parsetool($self->{configdir}."/Self.xml");
      if ((exists $p->{content}) && (exists $p->{content}{CLIENT}) && (exists $p->{content}{CLIENT}{FLAGS}))
         {
         if (exists $p->{content}{CLIENT}{FLAGS}{REM_PATH_VARIABLES})
            {
            foreach my $f (@{$p->{content}{CLIENT}{FLAGS}{REM_PATH_VARIABLES}})
               {
               delete $pathvars{$f};
               }
            }
         if (exists $p->{content}{CLIENT}{FLAGS}{PATH_VARIABLES})
            {
            foreach my $f (@{$p->{content}{CLIENT}{FLAGS}{PATH_VARIABLES}})
               {
               $pathvars{$f}=1;
               }
            }
         }
      my $paths = join("|",keys %pathvars);
      if ($paths){$paths = "^($paths)\$";}
      $self->{internal}{path_variables}=$paths;
      }
   }

sub init ()
   {
   my $self=shift;
   my $projectarea=shift;
   $self->{topdir}=$projectarea->location();
   $self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
   $self->{archstore}=$projectarea->archdir();
   $self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools";
   $self->name($projectarea->toolcachename());
   $self->initpathvars();
   $self->dirty();
   }
  
sub setupalltools()
   {
   my $self = shift;
   my @selected=();
   my $tooldir=$self->{toolcache}."/selected";
   foreach my $tool (@{&getfileslist($tooldir)})
      {
      if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
      }
   foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");}
   scramlogmsg("\n");
   }

sub coresetup()
   {
   my $self=shift;
   my ($toolfile) = @_;
   
   my $toolparser = $self->_parsetool($toolfile);
   my $store = $toolparser->processrawtool();
   my $toolname = $toolparser->toolname();
   my $toolversion = $toolparser->toolversion();
   scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n");

   # Store the ToolData object in the cache:   
   $self->storeincache($toolname,$store);
   my $srcfile=Utilities::AddDir::fixpath($toolfile);
   my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml");
   use File::Copy;
   if ($srcfile ne $desfile)
      {
      use File::Copy;
      my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml");
      if ($srcfile ne $desfile1)
         {
         copy($srcfile,$desfile1);
         }
      if (-e $desfile) { unlink($desfile);}
      symlink("../available/${toolname}.xml",$desfile); 
      }
   scramlogclean();
   return $self;
   }

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

   if ( -f $filename )
      {
      scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
      # Self file exists so process it:
      my $selfparser = $self->_parsetool($filename);
      my $store = $selfparser->processrawtool();
      # 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 STDERR "\n";
      print STDERR "SCRAM: No file config/Self.xml...nothing to do.";
      print STDERR "\n";
      return;
      }
   }

sub update()
   {
   my $self=shift;
   my $area=shift;
   $self->init($area);
   $self->setupself();
   $self->dirty ()
   }
   
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);
      delete $self->{SETUP}->{$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 = [];
   $self->{internal}{donetools}={};
   $self->{internal}{scram_tools}={};
   foreach my $tool (sort keys %{$self->{SETUP}})
      {
      if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
      elsif ($tool ne "self")
         {
         $self->_toolsdata($tool,$tooldata);
         }
      }
   foreach my $tool (keys %{$self->{internal}{scram_tools}})
      {
      $self->_toolsdata_scram($tool,$tooldata);
      }
   delete $self->{internal}{donetools};
   delete $self->{internal}{scram_tools};
   my $data=[];
   foreach my $d (@$tooldata)
      {
      if (ref($d) eq "ARRAY")
         {
         foreach my $t (@$d) {push @$data,$t;}
         }
      }
   return $data;
   }

sub _parsetool()
   {
   my ($self,$filename)=@_;
   my $p = BuildSystem::ToolParser->new($self->{internal}{path_variables});
   $p->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
   $p->filetail ('</doc>');
   $p->parse($filename);
   return $p;
   }

sub _toolsdata()
   {
   my $self = shift;
   my $tool=shift;
   my $data=shift || [];
   my $order=-1;
   if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
   $self->{internal}{donetools}{$tool}=$order;
   if (exists $self->{SETUP}{$tool})
      {
      if (exists $self->{SETUP}{$tool}{USE})
         {
         foreach my $use (@{$self->{SETUP}{$tool}{USE}})
            {
            my $o=$self->_toolsdata(lc($use),$data);
            if ($o>$order){$order=$o;}
            }
         }
      $order++;
      if(!defined $data->[$order]){$data->[$order]=[];}
      push @{$data->[$order]},$self->{SETUP}{$tool};
      $self->{internal}{donetools}{$tool}=$order;
      }
   return $order;
   }

sub _toolsdata_scram()
   {
   my $self = shift;
   my $tool=shift;
   my $data=shift || [];
   my $order=-1;
   if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
   $self->{internal}{donetools}{$tool}=$order;
   if(!exists $self->{internal}{scram_tools}{$tool}){return $order;}
   use Configuration::ConfigArea;
   use Cache::CacheUtilities;
   my $cache=uc($tool)."_BASE";
   $cache=$self->{SETUP}{$tool}{$cache};
   if (!-d $cache)
      {
      print STDERR "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
      return $order;
      }
   my $area=Configuration::ConfigArea->new();
   $area->location($cache);
   my $cachefile=$area->toolcachename();
   if (!-f $cachefile)
      {
      print STDERR "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
      return $order;
      }
   $cache=&Cache::CacheUtilities::read($cachefile);
   my $tools=$cache->setup();
   $order=scalar(@$data)-1;
   foreach my $use (keys %$tools)
      {
      if ($tools->{$use}->scram_project() == 1)
         {
         my $o=$self->_toolsdata_scram($use,$data);
         if ($o>$order){$order=$o;}
         }
      }
   $order++;
   if(!defined $data->[$order]){$data->[$order]=[];}
   push @{$data->[$order]},$self->{SETUP}{$tool};
   $self->{internal}{donetools}{$tool}=$order;
   return $order;
   }
   
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 remove_tool()
   {
   my $self=shift;
   my ($toolname)=@_;
   delete $self->{SETUP}{$toolname};
   print "Deleting $toolname from cache.","\n";
   $self->updatetooltimestamp (undef, $toolname);
   $self->writecache();
   my $file1=$self->{toolcache}."/selected/${toolname}.xml";
   my $file2=$self->{toolcache}."/available/${toolname}.xml";
   if ((!-f $file2) && (-f $file1))
      {
      use File::Copy;
      copy ($file1,$file2);
      }
   unlink ($file1);
   }

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 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 ($toolname ne "self")
      {
      my $instdir = $self->{archstore}."/InstalledTools";
      my $tfile = "${instdir}/${toolname}";
      if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
      elsif ((defined $obj) && (!-f $tfile))
         {
         Utilities::AddDir::adddir($instdir);
         my $ref;
         open($ref,">$tfile");
         close($ref);
         }
      }
   if ((!$samevalues) || (!-f $stampfile))
      {
      if (!-d $stampdir)
         {
         Utilities::AddDir::adddir($stampdir);
         }
      my $ref;
      open($ref,">$stampfile");
      close($ref);
      if (!$samevalues){$self->dirty();}
      }
   }

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.26
Committed:	Wed Feb 13 11:44:13 2013 UTC (12 years, 2 months ago) by muzaffar
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V2_2_5_pre2, V2_2_5_pre1, V2_2_4, HEAD
Changes since 1.25:	+3 -3 lines
Log Message:	avoid using SCRAM_PATH_VARIABLES env variable
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: ToolManager.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Copyright: 2003 (C) Shaun Ashby
7			#
8			#--------------------------------------------------------------------
9			package BuildSystem::ToolManager;
10			require 5.004;
11
12			use Exporter;
13			use BuildSystem::ToolCache;
14			use BuildSystem::ToolParser;
15			use Utilities::AddDir;
16			use Utilities::Verbose;
17	muzaffar	1.19	use SCRAM::MsgLog;
18	sashby	1.2
19			@ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
20			@EXPORT_OK=qw( );
21			#
22	sashby	1.9
23	sashby	1.2	sub new
24			{
25			my $proto=shift;
26			my $class=ref($proto) \|\| $proto;
27			my $self=$class->SUPER::new(); # Inherit from ToolCache
28			bless $self,$class;
29	muzaffar	1.20	$self->init (shift);
30	sashby	1.2	return $self;
31			}
32
33	muzaffar	1.25	sub initpathvars()
34			{
35			my $self=shift;
36	muzaffar	1.26	if (!exists $self->{internal}{path_variables})
37	muzaffar	1.25	{
38			my %pathvars=("PATH", 1, "LD_LIBRARY_PATH", 1, "DYLD_LIBRARY_PATH", 1, "DYLD_FALLBACK_LIBRARY_PATH", 1, "PYTHONPATH", 1);
39			my $p = $self->_parsetool($self->{configdir}."/Self.xml");
40			if ((exists $p->{content}) && (exists $p->{content}{CLIENT}) && (exists $p->{content}{CLIENT}{FLAGS}))
41			{
42			if (exists $p->{content}{CLIENT}{FLAGS}{REM_PATH_VARIABLES})
43			{
44			foreach my $f (@{$p->{content}{CLIENT}{FLAGS}{REM_PATH_VARIABLES}})
45			{
46			delete $pathvars{$f};
47			}
48			}
49			if (exists $p->{content}{CLIENT}{FLAGS}{PATH_VARIABLES})
50			{
51			foreach my $f (@{$p->{content}{CLIENT}{FLAGS}{PATH_VARIABLES}})
52			{
53			$pathvars{$f}=1;
54			}
55			}
56			}
57			my $paths = join("\|",keys %pathvars);
58			if ($paths){$paths = "^($paths)\$";}
59	muzaffar	1.26	$self->{internal}{path_variables}=$paths;
60	muzaffar	1.25	}
61			}
62
63	muzaffar	1.20	sub init ()
64	sashby	1.2	{
65			my $self=shift;
66			my $projectarea=shift;
67			$self->{topdir}=$projectarea->location();
68			$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
69	muzaffar	1.20	$self->{archstore}=$projectarea->archdir();
70	muzaffar	1.21	$self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools";
71	sashby	1.2	$self->name($projectarea->toolcachename());
72	muzaffar	1.25	$self->initpathvars();
73	muzaffar	1.20	$self->dirty();
74	sashby	1.2	}
75	muzaffar	1.20
76	sashby	1.2	sub setupalltools()
77			{
78			my $self = shift;
79	muzaffar	1.20	my @selected=();
80			my $tooldir=$self->{toolcache}."/selected";
81			foreach my $tool (@{&getfileslist($tooldir)})
82	sashby	1.2	{
83	muzaffar	1.20	if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
84	sashby	1.2	}
85	muzaffar	1.20	foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");}
86	muzaffar	1.19	scramlogmsg("\n");
87	sashby	1.2	}
88
89			sub coresetup()
90			{
91			my $self=shift;
92	muzaffar	1.20	my ($toolfile) = @_;
93	sashby	1.2
94	muzaffar	1.25	my $toolparser = $self->_parsetool($toolfile);
95			my $store = $toolparser->processrawtool();
96	muzaffar	1.20	my $toolname = $toolparser->toolname();
97			my $toolversion = $toolparser->toolversion();
98	muzaffar	1.19	scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,": ".$::normal,"\n");
99	sashby	1.8
100	sashby	1.16	# Store the ToolData object in the cache:
101	muzaffar	1.20	$self->storeincache($toolname,$store);
102			my $srcfile=Utilities::AddDir::fixpath($toolfile);
103			my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml");
104			use File::Copy;
105			if ($srcfile ne $desfile)
106			{
107			use File::Copy;
108			my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml");
109			if ($srcfile ne $desfile1)
110			{
111			copy($srcfile,$desfile1);
112	sashby	1.2	}
113	muzaffar	1.20	if (-e $desfile) { unlink($desfile);}
114			symlink("../available/${toolname}.xml",$desfile);
115	sashby	1.2	}
116	muzaffar	1.20	scramlogclean();
117	sashby	1.2	return $self;
118			}
119
120			sub setupself()
121			{
122			my $self=shift;
123			# Process the file "Self" in local config directory. This is used to
124			# set all the paths/runtime settings for this project:
125	muzaffar	1.20	my $filename=$self->{configdir}."/Self.xml";
126	sashby	1.16
127	sashby	1.2	if ( -f $filename )
128			{
129	muzaffar	1.19	scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
130	sashby	1.2	# Self file exists so process it:
131	muzaffar	1.25	my $selfparser = $self->_parsetool($filename);
132			my $store = $selfparser->processrawtool();
133	sashby	1.2	# If we are in a developer area, also add RELEASETOP paths:
134			if (exists($ENV{RELEASETOP}))
135			{
136			print "\nAdding RELEASE area settings to self....OK","\n", if ($ENV{SCRAM_DEBUG});
137			$store->addreleasetoself();
138			}
139
140			# Store the ToolData object in the cache:
141			$self->storeincache($selfparser->toolname(),$store);
142	muzaffar	1.19	scramlogmsg("\n");
143	sashby	1.2	}
144			else
145			{
146	muzaffar	1.19	scramlogdump();
147	muzaffar	1.23	print STDERR "\n";
148			print STDERR "SCRAM: No file config/Self.xml...nothing to do.";
149			print STDERR "\n";
150	sashby	1.2	return;
151			}
152			}
153
154	muzaffar	1.20	sub update()
155	sashby	1.2	{
156	muzaffar	1.20	my $self=shift;
157			my $area=shift;
158			$self->init($area);
159			$self->setupself();
160			$self->dirty ()
161	sashby	1.2	}
162	muzaffar	1.20
163	sashby	1.2	sub storeincache()
164			{
165			my $self=shift;
166			my ($toolname,$dataobject)=@_;
167
168			# Store ToolData object (for a set-up tool) in cache:
169			if (ref($dataobject) eq 'BuildSystem::ToolData')
170			{
171	sashby	1.16	$self->updatetooltimestamp($dataobject, $toolname);
172	muzaffar	1.20	delete $self->{SETUP}->{$toolname};
173	sashby	1.2	$self->{SETUP}->{$toolname} = $dataobject;
174			}
175			else
176			{
177			$::scram->scramerror("ToolManager: BuildSystem::ToolData object reference expected.")
178			}
179			}
180
181			sub tools()
182			{
183			my $self = shift;
184			my @tools;
185
186			map
187			{
188			if ($_ ne "self")
189			{
190			push(@tools, $_);
191			}
192			} keys %{$self->{SETUP}};
193
194			# Return list of set-up tools:
195			return @tools;
196			}
197
198			sub toolsdata()
199			{
200			my $self = shift;
201			my $tooldata = [];
202	muzaffar	1.20	$self->{internal}{donetools}={};
203			$self->{internal}{scram_tools}={};
204			foreach my $tool (sort keys %{$self->{SETUP}})
205	sashby	1.2	{
206	muzaffar	1.20	if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
207			elsif ($tool ne "self")
208	sashby	1.2	{
209	muzaffar	1.20	$self->_toolsdata($tool,$tooldata);
210			}
211			}
212			foreach my $tool (keys %{$self->{internal}{scram_tools}})
213			{
214			$self->_toolsdata_scram($tool,$tooldata);
215			}
216			delete $self->{internal}{donetools};
217			delete $self->{internal}{scram_tools};
218			my $data=[];
219			foreach my $d (@$tooldata)
220			{
221			if (ref($d) eq "ARRAY")
222			{
223			foreach my $t (@$d) {push @$data,$t;}
224			}
225			}
226			return $data;
227			}
228
229	muzaffar	1.25	sub _parsetool()
230			{
231			my ($self,$filename)=@_;
232	muzaffar	1.26	my $p = BuildSystem::ToolParser->new($self->{internal}{path_variables});
233	muzaffar	1.25	$p->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
234			$p->filetail ('</doc>');
235			$p->parse($filename);
236			return $p;
237			}
238
239	muzaffar	1.20	sub _toolsdata()
240			{
241			my $self = shift;
242			my $tool=shift;
243			my $data=shift \|\| [];
244			my $order=-1;
245			if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
246			$self->{internal}{donetools}{$tool}=$order;
247			if (exists $self->{SETUP}{$tool})
248			{
249			if (exists $self->{SETUP}{$tool}{USE})
250			{
251			foreach my $use (@{$self->{SETUP}{$tool}{USE}})
252	sashby	1.2	{
253	muzaffar	1.20	my $o=$self->_toolsdata(lc($use),$data);
254			if ($o>$order){$order=$o;}
255	sashby	1.2	}
256			}
257	muzaffar	1.20	$order++;
258			if(!defined $data->[$order]){$data->[$order]=[];}
259			push @{$data->[$order]},$self->{SETUP}{$tool};
260			$self->{internal}{donetools}{$tool}=$order;
261	sashby	1.2	}
262	muzaffar	1.20	return $order;
263	sashby	1.2	}
264
265	muzaffar	1.20	sub _toolsdata_scram()
266	sashby	1.2	{
267	muzaffar	1.20	my $self = shift;
268			my $tool=shift;
269			my $data=shift \|\| [];
270			my $order=-1;
271			if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
272			$self->{internal}{donetools}{$tool}=$order;
273			if(!exists $self->{internal}{scram_tools}{$tool}){return $order;}
274			use Configuration::ConfigArea;
275			use Cache::CacheUtilities;
276			my $cache=uc($tool)."_BASE";
277			$cache=$self->{SETUP}{$tool}{$cache};
278			if (!-d $cache)
279			{
280	muzaffar	1.23	print STDERR "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
281	muzaffar	1.20	return $order;
282			}
283			my $area=Configuration::ConfigArea->new();
284			$area->location($cache);
285			my $cachefile=$area->toolcachename();
286			if (!-f $cachefile)
287			{
288	muzaffar	1.23	print STDERR "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
289	muzaffar	1.20	return $order;
290			}
291			$cache=&Cache::CacheUtilities::read($cachefile);
292			my $tools=$cache->setup();
293			$order=scalar(@$data)-1;
294			foreach my $use (keys %$tools)
295			{
296			if ($tools->{$use}->scram_project() == 1)
297			{
298			my $o=$self->_toolsdata_scram($use,$data);
299			if ($o>$order){$order=$o;}
300			}
301			}
302			$order++;
303			if(!defined $data->[$order]){$data->[$order]=[];}
304			push @{$data->[$order]},$self->{SETUP}{$tool};
305			$self->{internal}{donetools}{$tool}=$order;
306			return $order;
307			}
308	sashby	1.2
309			sub checkifsetup()
310			{
311			my $self=shift;
312			my ($tool)=@_;
313			# Return the ToolData object if the tool has been set up:
314			(exists $self->{SETUP}->{$tool}) ? return ($self->{SETUP}->{$tool})
315			: return undef;
316			}
317
318			sub remove_tool()
319			{
320			my $self=shift;
321			my ($toolname)=@_;
322	muzaffar	1.20	delete $self->{SETUP}{$toolname};
323			print "Deleting $toolname from cache.","\n";
324			$self->updatetooltimestamp (undef, $toolname);
325	sashby	1.2	$self->writecache();
326	muzaffar	1.20	my $file1=$self->{toolcache}."/selected/${toolname}.xml";
327			my $file2=$self->{toolcache}."/available/${toolname}.xml";
328			if ((!-f $file2) && (-f $file1))
329			{
330			use File::Copy;
331			copy ($file1,$file2);
332			}
333			unlink ($file1);
334	sashby	1.2	}
335
336			sub scram_projects()
337			{
338			my $self=shift;
339			my $scram_projects={};
340
341			foreach my $t ($self->tools())
342			{
343			# Get the ToolData object:
344			my $td=$self->{SETUP}->{$t};
345			$scram_projects->{$t}=$td->variable_data(uc($t)."_BASE"), if ($td->scram_project());
346			}
347
348			return $scram_projects;
349			}
350
351	sashby	1.16	sub updatetooltimestamp ()
352			{
353			my $self=shift;
354			my $obj=shift;
355			my $toolname=shift;
356			my $samevalues=0;
357	muzaffar	1.18	my $stampdir = $self->{archstore}."/timestamps";
358			my $stampfile="${stampdir}/${toolname}";
359	sashby	1.16	if (exists $self->{SETUP}->{$toolname})
360			{
361			$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
362			}
363	muzaffar	1.20	if ($toolname ne "self")
364			{
365			my $instdir = $self->{archstore}."/InstalledTools";
366			my $tfile = "${instdir}/${toolname}";
367			if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
368			elsif ((defined $obj) && (!-f $tfile))
369			{
370			Utilities::AddDir::adddir($instdir);
371			my $ref;
372			open($ref,">$tfile");
373			close($ref);
374			}
375			}
376	muzaffar	1.18	if ((!$samevalues) \|\| (!-f $stampfile))
377	sashby	1.16	{
378	muzaffar	1.18	if (!-d $stampdir)
379	sashby	1.16	{
380	muzaffar	1.20	Utilities::AddDir::adddir($stampdir);
381	sashby	1.16	}
382	muzaffar	1.20	my $ref;
383			open($ref,">$stampfile");
384			close($ref);
385			if (!$samevalues){$self->dirty();}
386	sashby	1.16	}
387			}
388
389			sub comparetoolsdata ()
390			{
391			my $self=shift;
392			my $data1=shift \|\| ();
393			my $data2=shift \|\| ();
394
395			my $ref1=ref($data1);
396			my $ref2=ref($data2);
397
398			if ($ref1 ne $ref2)
399			{
400			return 0;
401			}
402			elsif ($ref1 eq "CODE")
403			{
404			return 1;
405			}
406			elsif(($ref1 eq "SCALAR") \|\| ($ref1 eq ""))
407			{
408			if ($data1 eq $data2)
409			{
410			return 1;
411			}
412			return 0;
413			}
414			elsif ($ref1 eq "ARRAY")
415			{
416			my $count = scalar(@$data1);
417			if ($count != scalar(@$data2))
418			{
419			return 0;
420			}
421			for (my $i=0; $i<$count; $i++)
422			{
423			if (! $self->comparetoolsdata($data1->[$i],$data2->[$i]))
424			{
425			return 0;
426			}
427			}
428			return 1;
429			}
430			else
431			{
432			foreach my $k (keys %{$data1})
433			{
434			if (! exists $data2->{$k})
435			{
436			return 0;
437			}
438			}
439			foreach my $k (keys %{$data2})
440			{
441			if (! exists $data1->{$k})
442			{
443			return 0;
444			}
445			}
446			foreach my $k (keys %{$data2})
447			{
448			if (! $self->comparetoolsdata($data1->{$k},$data2->{$k}))
449			{
450			return 0;
451			}
452			}
453			return 1;
454			}
455			}
456
457	sashby	1.2	1;