ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolManager.pm

Comparing COMP/SCRAM/src/BuildSystem/ToolManager.pm (file contents):
Revision 1.14 by sashby, Wed May 17 12:21:57 2006 UTC vs.
Revision 1.26 by muzaffar, Wed Feb 13 11:44:13 2013 UTC

#	Line 3 | Line 3
3		#____________________________________________________________________
4		#
5		# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6	–	# Update: 2003-11-12 15:04:16+0100
7	–	# Revision: $Id$
8	–	#
6		# Copyright: 2003 (C) Shaun Ashby
7		#
8		#--------------------------------------------------------------------
#	Line 16 | Line 13 | use Exporter;
13		use BuildSystem::ToolCache;
14		use BuildSystem::ToolParser;
15		use Utilities::AddDir;
19	–	use URL::URLhandler;
16		use Utilities::Verbose;
17	+	use SCRAM::MsgLog;
18
19		@ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
20		@EXPORT_OK=qw( );
21		#
22
23		sub new
27	–	###############################################################
28	–	# new                                                         #
29	–	###############################################################
30	–	# modified : Wed Nov 12 10:34:10 2003 / SFA                   #
31	–	# params   :                                                  #
32	–	#          :                                                  #
33	–	# function :                                                  #
34	–	#          :                                                  #
35	–	###############################################################
24		{
25		my $proto=shift;
26		my $class=ref($proto) || $proto;
27		my $self=$class->SUPER::new();    # Inherit from ToolCache
40	–	my $projectarea=shift;
41	–
28		bless $self,$class;
29	<
30	<	$self->{arch}=shift;
31	<	$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());
29	>	$self->init (shift);
30	>	return $self;
31	>	}
32
33	<	# Check for the downloaded tools cache:
34	<	if (exists($self->{cache}))
33	>	sub initpathvars()
34	>	{
35	>	my $self=shift;
36	>	if (!exists $self->{internal}{path_variables})
37		{
38	<	$self->{urlhandler}=URL::URLhandler->new($self->{cache});
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	>	$self->{internal}{path_variables}=$paths;
60		}
64	–
65	–	return $self;
61		}
62
63	<	sub clone()
63	>	sub init ()
64		{
65		my $self=shift;
66		my $projectarea=shift;
72	–
73	–	# Change cache settings to reflect the new location:
67		$self->{topdir}=$projectarea->location();
75	–
68		$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
69	<	$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
70	<	$self->{datastore}=$self->{topdir}."/.SCRAM";
79	<	$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
80	<
81	<	# Change the cache name:
69	>	$self->{archstore}=$projectarea->archdir();
70	>	$self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools";
71		$self->name($projectarea->toolcachename());
72	<	$self->cloned_tm(1);
73	<
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);
72	>	$self->initpathvars();
73	>	$self->dirty();
74		}
75	<
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	<
75	>
76		sub setupalltools()
77		{
78		my $self = shift;
79	<	my ($arealocation,$setupopt) = @_;
80	<	my (@localtools);
81	<	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	<	# 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	<	print "DEBUG: $pname and current project have compatible configurations.\n";
159	<	$self->inheritcontent($satoolmanager);
160	<	}
161	<	else
162	<	{
163	<	print "DEBUG: $pname and current project do NOT have compatible configurations. Skipping...\n";
164	<	}
165	<	}
166	<	}
167	<	}
168	<	# Also add this scram-managed project to list of tools to set up:
169	<	push(@localtools,$S);
170	<	}
171	<	else
172	<	{
173	<	# Store other tools in ReqDoc in separate array. We will set up these tools later:
174	<	push(@localtools,$S);
175	<	}
176	<	}
177	<
178	<	# Set up extra tools required in this project, in addition to
179	<	# any scram-managed projects
180	<	foreach my $localtool (@localtools)
181	<	{
182	<	# First check to see if it's already set up (i.e., was contained
183	<	# in list of requirements for scram project):
184	<	if (! $self->definedtool($localtool))
185	<	{
186	<	$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
187	<	$self->addtoselected($localtool);
188	<	}
189	<	else
190	<	{
191	<	print $localtool," already set up.","\n",if ($ENV{SCRAM_DEBUG});
192	<	}
193	<	}
194	<	}
195	<	else
79	>	my @selected=();
80	>	my $tooldir=$self->{toolcache}."/selected";
81	>	foreach my $tool (@{&getfileslist($tooldir)})
82		{
83	<	# Just loop over all tools and setup again:
198	<	foreach my $localtool (@{$selected})
199	<	{
200	<	$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
201	<	}
83	>	if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
84		}
85	<
86	<	print "\n";
85	>	foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");}
86	>	scramlogmsg("\n");
87		}
88
89		sub coresetup()
90		{
91		my $self=shift;
92	<	my ($toolname, $toolversion, $toolfile, $force) = @_;
211	<	my ($toolcheck, $toolparser);
212	<
213	<	print "\n";
214	<	print $::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n";
215	<
216	<	# New ToolParser object for this tool if there isn't one already.
217	<	# Look in array of raw tools to see if this tool has a ToolParser object:
218	<	$toolcheck=0;
219	<
220	<	map
221	<	{
222	<	if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
223	<	} $self->rawtools();
224	<
225	<	# Tool not known so we create a new ToolParser object and parse it:
226	<	if ($toolcheck != 1 || $force == 1)
227	<	{
228	<	$toolparser = BuildSystem::ToolParser->new();
229	<	# We only want to store the stuff relevant for one particular version:
230	<	$toolparser->parse($toolname, $toolversion, $toolfile);
231	<	# Store the ToolParser object in the cache:
232	<	$self->store($toolparser);
233	<	print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG});
234	<	}
235	<
236	<	# Next, set up the tool:
237	<	my $store = $toolparser->processrawtool($self->interactive());
238	<	# Make sure that we have this tool in the list of selected tools (just in case this tool was
239	<	# set up by hand afterwards):
240	<	$self->addtoselected($toolname);
241	<
242	<	# Check to see if this tool is a compiler. If so, store it.
243	<	# Also store the language that this compiler supprots, and a
244	<	# compiler name (e.g. gcc323) which, in conjunction with a stem
245	<	# architecture name like slc3_ia32_, can be used to build a complete arch string:
246	<	if ($store->scram_compiler() == 1)
247	<	{
248	<	my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
249	<	my @compilername = $store->flags("SCRAM_COMPILER_NAME");
250	<	$self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
251	<	}
252	<
253	<	# Store the ToolData object in the cache:
254	<	$self->storeincache($toolparser->toolname(),$store);
255	<	return $self;
256	<	}
257	<
258	<	sub toolsetup()
259	<	{
260	<	my $self=shift;
261	<	my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
262	<	my ($urlcache, $url, $filename, $tfname);
263	<	my $toolfile;
264	<	my $force = 0; # we may have to force a reparse of a tool file
265	<
266	<	$toolname =~ tr[A-Z][a-z];
267	<	$toolversion ||= $self->defaultversion($toolname);
268	<	$urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
269	<
270	<	# Check for the downloaded tools cache:
271	<	if (defined($urlcache))
272	<	{
273	<	$self->{urlhandler}=URL::URLhandler->new($urlcache);
274	<	}
275	<
276	<	$url = $self->toolurls()->{$toolname};
277	<	$filename = $self->{toolfiledir}."/".$toolname;
278	<
279	<	# If .SCRAM/InstalledTools doesn't exist, create it:
280	<	if (! -d $self->{toolfiledir})
281	<	{
282	<	AddDir::adddir($self->{toolfiledir});
283	<	}
92	>	my ($toolfile) = @_;
93
94	<	# First, check to see if there was a tool URL given. If so, we might need to read
95	<	# from http or from a file: type URL:
96	<	if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
97	<	{
98	<	# See what kind of URL (file:, http:, cvs:, svn:, .. ):
99	<	if ($proto eq 'file')
100	<	{
101	<	# Check to see if there is a ~ and substitute the user
102	<	# home directory if there is (file:~/xyz):
103	<	if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|))
104	<	{
105	<	$urlv = $ENV{HOME}."/".$urlpath;
106	<	}
107	<	elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|))
108	<	{
109	<	# Relative to current directory (file:./xyz):
110	<	use Cwd qw(&cwd);
111	<	$urlv = cwd()."/".$urlpath;
303	<	}
304	<
305	<	# If the tool url is a file and the file exists,
306	<	# copy it to .SCRAM/InstalledTools and set the
307	<	# filename accordingly:
308	<	if ( -f $urlv)
309	<	{
310	<	use File::Copy;
311	<	copy($urlv, $filename);
312	<	my $mode = 0644; chmod $mode, $filename;
313	<	$toolfile=$filename;
314	<	# Here we must account for the fact that the file tool doc may be
315	<	# a modified version of an existing tool in the current config. we
316	<	# make sure that this file is reparsed, even if there is already a
317	<	# ToolParser object for the tool:
318	<	$force = 1;
319	<	}
320	<	else
321	<	{
322	<	$::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!");
323	<	}
324	<	}
325	<	elsif ($proto eq 'http')
326	<	{
327	<	print "SCRAM: downloading $toolname from $toolurl","\n";
328	<	# Download from WWW first:
329	<	use LWP::Simple qw(&getstore);
330	<	my $http_response_val = &getstore($toolurl, $filename);
331	<
332	<	# Check the HTTP status. If doc not found, exit:
333	<	if ($http_response_val != 200)
334	<	{
335	<	my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|);
336	<	$::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
337	<	}
338	<	else
339	<	{
340	<	$toolfile=$filename;
341	<	}
342	<	}
343	<	elsif ($proto eq 'cvs')
344	<	{
345	<	print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
346	<	print "[ not yet supported ]","\n";
347	<	exit(0);
348	<	}
349	<	elsif ($proto eq 'svn')
350	<	{
351	<	print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
352	<	print "[ not yet supported ]","\n";
353	<	exit(0);
354	<	}
355	<	else
356	<	{
357	<	$::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
358	<	}
359	<	}
360	<	else
361	<	{
362	<	# Copy the downloaded tool file to InstalledTools directory:
363	<	if ( ! -f $filename )
364	<	{
365	<	# If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
366	<	# We signal an error and exit:
367	<	if ($url eq '')
368	<	{
369	<	$::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
370	<	}
371	<	else
372	<	{
373	<	# Otherwise, we try to download it:
374	<	$self->verbose("Attempting Download of $url");
375	<	# Get file from download cache:
376	<	($url,$filename)=$self->{urlhandler}->get($url);
377	<	use File::Copy;
378	<	$tfname=$self->{toolfiledir}."/".$toolname;
379	<	copy($filename, $tfname);
380	<	my $mode = 0644; chmod $mode, $tfname;
381	<	$toolfile=$tfname;
382	<	}
383	<	}
384	<	else
385	<	{
386	<	# File already exists in the .SCRAM/InstallTools directory:
387	<	$toolfile=$filename;
94	>	my $toolparser = $self->_parsetool($toolfile);
95	>	my $store = $toolparser->processrawtool();
96	>	my $toolname = $toolparser->toolname();
97	>	my $toolversion = $toolparser->toolversion();
98	>	scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n");
99	>
100	>	# Store the ToolData object in the cache:
101	>	$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		}
113	+	if (-e $desfile) { unlink($desfile);}
114	+	symlink("../available/${toolname}.xml",$desfile);
115		}
116	<
391	<	# Run the core setup routine:
392	<	$self->coresetup($toolname, $toolversion, $toolfile,$force);
116	>	scramlogclean();
117		return $self;
118		}
119
120		sub setupself()
121		{
122		my $self=shift;
399	–	my ($location)=@_;
123		# Process the file "Self" in local config directory. This is used to
124		# set all the paths/runtime settings for this project:
125	<	my $filename=$location."/config/Self";
125	>	my $filename=$self->{configdir}."/Self.xml";
126
127		if ( -f $filename )
128		{
129	<	print "\n";
407	<	print $::bold."Setting up SELF:".$::normal,"\n";
129	>	scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
130		# Self file exists so process it:
131	<	$selfparser = BuildSystem::ToolParser->new();
132	<	$selfparser->parse('self','SELF',$filename);
411	<
412	<	# Next, set up the tool:
413	<	$store = $selfparser->processrawtool($self->interactive());
414	<
131	>	my $selfparser = $self->_parsetool($filename);
132	>	my $store = $selfparser->processrawtool();
133		# If we are in a developer area, also add RELEASETOP paths:
134		if (exists($ENV{RELEASETOP}))
135		{
#	Line 421 | Line 139 | sub setupself()
139
140		# Store the ToolData object in the cache:
141		$self->storeincache($selfparser->toolname(),$store);
142	<	print "\n";
142	>	scramlogmsg("\n");
143		}
144		else
145		{
146	<	print "\n";
147	<	print "SCRAM: No file config/Self...nothing to do.";
148	<	print "\n";
146	>	scramlogdump();
147	>	print STDERR "\n";
148	>	print STDERR "SCRAM: No file config/Self.xml...nothing to do.";
149	>	print STDERR "\n";
150		return;
151		}
152		}
153
154	<	sub defaultversion()
154	>	sub update()
155		{
156	<	my $self = shift;
157	<	my ($tool) = @_;
158	<	# Return default versions as taken from configuration:
159	<	return (%{$self->defaultversions()}->{$tool});
156	>	my $self=shift;
157	>	my $area=shift;
158	>	$self->init($area);
159	>	$self->setupself();
160	>	$self->dirty ()
161		}
162	<
162	>
163		sub storeincache()
164		{
165		my $self=shift;
#	Line 448 | Line 168 | sub storeincache()
168		# Store ToolData object (for a set-up tool) in cache:
169		if (ref($dataobject) eq 'BuildSystem::ToolData')
170		{
171	+	$self->updatetooltimestamp($dataobject, $toolname);
172	+	delete $self->{SETUP}->{$toolname};
173		$self->{SETUP}->{$toolname} = $dataobject;
174		}
175		else
#	Line 477 | Line 199 | sub toolsdata()
199		{
200		my $self = shift;
201		my $tooldata = [];
202	<	my $rawsel = $self->selected();
203	<
204	<	foreach my $tool ( sort { %{$rawsel}->{$a}
483	<	<=> %{$rawsel}->{$b}}
484	<	keys %{$rawsel} )
202	>	$self->{internal}{donetools}={};
203	>	$self->{internal}{scram_tools}={};
204	>	foreach my $tool (sort keys %{$self->{SETUP}})
205		{
206	<	# Return tool data objects of all set-up tools, skipping the tool "self":
207	<	if ($_ ne "self")
206	>	if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
207	>	elsif ($tool ne "self")
208		{
209	<	# Keep only tools that have really been set up:
210	<	if (exists $self->{SETUP}->{$tool})
209	>	$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	>	sub _parsetool()
230	>	{
231	>	my ($self,$filename)=@_;
232	>	my $p = BuildSystem::ToolParser->new($self->{internal}{path_variables});
233	>	$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	>	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		{
253	<	push(@tooldata,$self->{SETUP}->{$tool});
253	>	my $o=$self->_toolsdata(lc($use),$data);
254	>	if ($o>$order){$order=$o;}
255		}
256		}
257	+	$order++;
258	+	if(!defined $data->[$order]){$data->[$order]=[];}
259	+	push @{$data->[$order]},$self->{SETUP}{$tool};
260	+	$self->{internal}{donetools}{$tool}=$order;
261		}
262	<
497	<	# Return the array of tools, in order that they appear in RequirementsDoc:
498	<	return @tooldata;
262	>	return $order;
263		}
264
265	<	sub definedtool()
265	>	sub _toolsdata_scram()
266		{
267	<	my $self=shift;
268	<	my ($tool)=@_;
269	<
270	<	# Check to see if tool X is an external tool:
271	<	grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
272	<	: return 0;
267	>	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	>	print STDERR "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
281	>	return $order;
282	>	}
283	>	my $area=Configuration::ConfigArea->new();
284	>	$area->location($cache);
285	>	my $cachefile=$area->toolcachename();
286	>	if (!-f $cachefile)
287	>	{
288	>	print STDERR "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
289	>	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	<
308	>
309		sub checkifsetup()
310		{
311		my $self=shift;
#	Line 517 | Line 315 | sub checkifsetup()
315		: return undef;
316		}
317
520	–	sub cloned_tm()
521	–	{
522	–	my $self=shift;
523	–	# Has this area already been cloned and brought in-line with current location:
524	–	@_ ? $self->{CLONED} = $_[0]
525	–	: $self->{CLONED};
526	–	}
527	–
318		sub remove_tool()
319		{
320		my $self=shift;
321		my ($toolname)=@_;
322	<	my $tools = $self->{SETUP};
323	<	my $newtlist = {};
324	<
325	<	while (my ($tool, $tooldata) = each %$tools)
322	>	delete $self->{SETUP}{$toolname};
323	>	print "Deleting $toolname from cache.","\n";
324	>	$self->updatetooltimestamp (undef, $toolname);
325	>	$self->writecache();
326	>	my $file1=$self->{toolcache}."/selected/${toolname}.xml";
327	>	my $file2=$self->{toolcache}."/available/${toolname}.xml";
328	>	if ((!-f $file2) && (-f $file1))
329		{
330	<	if ($tool ne $toolname)
331	<	{
539	<	$newtlist->{$tool} = $tooldata;
540	<	}
541	<	else
542	<	{
543	<	# Is this tool a compiler?
544	<	if ($tooldata->scram_compiler() == 1)
545	<	{
546	<	# Also remove this from the compiler info if there happens to be an entry:
547	<	while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
548	<	{
549	<	if ($toolname eq $ctool->[0])
550	<	{
551	<	delete $self->{SCRAM_COMPILER}->{$langtype};
552	<	print "Deleting compiler $toolname from cache.","\n";
553	<	}
554	<	}
555	<	}
556	<	else
557	<	{
558	<	print "Deleting $toolname from cache.","\n";
559	<	}
560	<	}
330	>	use File::Copy;
331	>	copy ($file1,$file2);
332		}
333	<
563	<	$self->{SETUP} = $newtlist;
564	<
565	<	# Now remove from the RAW tool list:
566	<	$self->cleanup_raw($toolname);
567	<	print "ToolManager: Updating tool cache.","\n";
568	<	$self->writecache();
333	>	unlink ($file1);
334		}
335
336		sub scram_projects()
#	Line 583 | Line 348 | sub scram_projects()
348		return $scram_projects;
349		}
350
351	<	sub scram_compiler()
351	>	sub updatetooltimestamp ()
352		{
353		my $self=shift;
354	<	my ($langtype, $toolname, $compilername)=@_;
355	<
356	<	if ($langtype)
354	>	my $obj=shift;
355	>	my $toolname=shift;
356	>	my $samevalues=0;
357	>	my $stampdir = $self->{archstore}."/timestamps";
358	>	my $stampfile="${stampdir}/${toolname}";
359	>	if (exists $self->{SETUP}->{$toolname})
360		{
361	<	# Store the compiler info according to supported
594	<	# language types.
595	<	#
596	<	# ---------------------- e.g C++      cxxcompiler    gcc323
597	<	$self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
361	>	$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
362		}
363	<	else
363	>	if ($toolname ne "self")
364		{
365	<	return $self->{SCRAM_COMPILER};
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	<	}
604	<
605	<	sub updatetool()
606	<	{
607	<	my $self=shift;
608	<	my ($name, $obj) = @_;
609	<
610	<	# Replace the existing copy of the tool with the new one:
611	<	if (exists $self->{SETUP}->{$name})
376	>	if ((!$samevalues) || (!-f $stampfile))
377		{
378	<	# Check to make sure that we were really passed a compiler with
614	<	# the desired name:
615	<	if ($obj->toolname() eq $name)
616	<	{
617	<	print "ToolManager: Updating the cached copy of ".$name."\n";
618	<	delete $self->{SETUP}->{$name};
619	<	$self->{SETUP}->{$name} = $obj;
620	<	$self->writecache();
621	<	}
622	<	else
378	>	if (!-d $stampdir)
379		{
380	<	print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
625	<	print "         Not making any changes.","\n";
380	>	Utilities::AddDir::adddir($stampdir);
381		}
382	<	}
383	<	else
384	<	{
385	<	print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
382	>	my $ref;
383	>	open($ref,">$stampfile");
384	>	close($ref);
385	>	if (!$samevalues){$self->dirty();}
386		}
387		}
388
389	<	sub check_compatibility()
389	>	sub comparetoolsdata ()
390		{
391		my $self=shift;
392	<	my ($itoolmgr)=@_;
393	<	# Get the version of the toolmanager. If the project fails to return a version
394	<	# string we return 0 for no compatibility (in which case, all tools will be set
395	<	# up in the traditional way):
396	<	my $itm_configversion = $itoolmgr->configversion();
397	<	if ($itm_configversion)
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	<	# The configurations won't be identical. We must compare the digits:
401	<	my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
402	<	my $current_configversion = $self->configversion();
403	<	my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
404	<	($current_numeric_version == $numeric_version) && return 1; # OK, compatible;
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		}
650	–	# Project does not define configuration version so just return:
651	–	return 0;
652	–	}
653	–
654	–	sub configversion()
655	–	{
656	–	my $self=shift;
657	–	@_ ? $self->{CONFIGVERSION} = shift
658	–	: $self->{CONFIGVERSION};
455		}
456
457		1;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines