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.19 by muzaffar, Fri Dec 14 09:03:47 2007 UTC vs.
Revision 1.24 by muzaffar, Tue Jun 12 15:54:23 2012 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
#	Line 25 | Line 21 | use SCRAM::MsgLog;
21		#
22
23		sub new
28	–	###############################################################
29	–	# new                                                         #
30	–	###############################################################
31	–	# modified : Wed Nov 12 10:34:10 2003 / SFA                   #
32	–	# params   :                                                  #
33	–	#          :                                                  #
34	–	# function :                                                  #
35	–	#          :                                                  #
36	–	###############################################################
24		{
25		my $proto=shift;
26		my $class=ref($proto) || $proto;
27		my $self=$class->SUPER::new();    # Inherit from ToolCache
41	–	my $projectarea=shift;
42	–
28		bless $self,$class;
29	<
45	<	$self->{arch}=shift;
46	<	$self->{topdir}=$projectarea->location();
47	<	$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
48	<	$self->{cache}=$projectarea->cache();    # Download tool cache
49	<	$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
50	<	$self->{datastore}=$self->{topdir}."/.SCRAM";
51	<	$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
52	<	$self->{tooltimestamp}="timestamps";
53	<
54	<	# Make sure our tool download dir exists:
55	<	AddDir::adddir($self->{toolfiledir});
56	<	AddDir::adddir($self->{archstore});
57	<
58	<	# Set the tool cache file to read/write:
59	<	$self->name($projectarea->toolcachename());
60	<
61	<	# Check for the downloaded tools cache:
62	<	if (exists($self->{cache}))
63	<	{
64	<	$self->{urlhandler}=URL::URLhandler->new($self->{cache});
65	<	}
66	<
29	>	$self->init (shift);
30		return $self;
31		}
32
33	<	sub clone()
33	>	sub init ()
34		{
35		my $self=shift;
36		my $projectarea=shift;
74	–
75	–	# Change cache settings to reflect the new location:
37		$self->{topdir}=$projectarea->location();
77	–
38		$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
39	<	$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
40	<	$self->{datastore}=$self->{topdir}."/.SCRAM";
81	<	$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
82	<
83	<	# Change the cache name:
39	>	$self->{archstore}=$projectarea->archdir();
40	>	$self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools";
41		$self->name($projectarea->toolcachename());
42	<	$self->cloned_tm(1);
86	<
87	<	return $self;
88	<	}
89	<
90	<	sub arch_change_after_copy()
91	<	{
92	<	my $self=shift;
93	<	my ($newarch, $cachename)=@_;
94	<	# Make changes to arch-specific settings when copying tool manager
95	<	# object to another arch during setup:
96	<	$self->{arch} = $newarch;
97	<	$self->{archstore} = $self->{topdir}."/.SCRAM/".$newarch;
98	<	# Change the name of the cache to reflect new (arch-specific) location:
99	<	$self->name($cachename);
100	<	}
101	<
102	<	sub interactive()
103	<	{
104	<	my $self=shift;
105	<	# Interactive mode on/off:
106	<	@_ ? $self->{interactive} = shift
107	<	: ((defined $self->{interactive}) ? $self->{interactive} : 0);
42	>	$self->dirty();
43		}
44	<
44	>
45		sub setupalltools()
46		{
47		my $self = shift;
48	<	my ($arealocation,$setupopt) = @_;
49	<	my (@localtools);
50	<	my $selected;
116	<
117	<	# Get the selected tool list. Handle the case where there might not be
118	<	# any selected tools: //FIXME: need to handle case where there are no
119	<	# selected tools (not very often but a possibility):
120	<	my $sel = $self->selected();
121	<
122	<	if (defined ($sel))
48	>	my @selected=();
49	>	my $tooldir=$self->{toolcache}."/selected";
50	>	foreach my $tool (@{&getfileslist($tooldir)})
51		{
52	<	$selected = [ keys %{$sel} ];
125	<	}
126	<
127	<	# Setup option "setupopt" directs the setup: 1 is for booting from
128	<	# scratch, 0 is when just doing "scram setup" (in this case we don't
129	<	# want to pick up everything from any scram-managed projects):
130	<	if ($setupopt == 1) # We're booting from scratch
131	<	{
132	<	# Look for a match in the scram db:
133	<	foreach my $S (@$selected)
134	<	{
135	<	# Store other tools in ReqDoc in separate array. We will set up these tools later:
136	<	push(@localtools,$S);
137	<	}
138	<
139	<	# Set up extra tools required in this project, in addition to
140	<	# any scram-managed projects
141	<	foreach my $localtool (@localtools)
142	<	{
143	<	# First check to see if it's already set up (i.e., was contained
144	<	# in list of requirements for scram project):
145	<	if (! $self->definedtool($localtool))
146	<	{
147	<	$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
148	<	$self->addtoselected($localtool);
149	<	}
150	<	else
151	<	{
152	<	scramlogmsg($localtool," already set up.","\n"),if ($ENV{SCRAM_DEBUG});
153	<	}
154	<	}
155	<	}
156	<	else
157	<	{
158	<	# Just loop over all tools and setup again:
159	<	foreach my $localtool (@{$selected})
160	<	{
161	<	$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
162	<	}
52	>	if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
53		}
54	<
54	>	foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");}
55		scramlogmsg("\n");
56		}
57
58		sub coresetup()
59		{
60		my $self=shift;
61	<	my ($toolname, $toolversion, $toolfile, $force) = @_;
172	<	my ($toolcheck, $toolparser);
61	>	my ($toolfile) = @_;
62
63	+	my $toolparser = BuildSystem::ToolParser->new();
64	+	$toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
65	+	$toolparser->filetail('</doc>');
66	+	$toolparser->parse($toolfile);
67	+	my $toolname = $toolparser->toolname();
68	+	my $toolversion = $toolparser->toolversion();
69		scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n");
70
176	–	# New ToolParser object for this tool if there isn't one already.
177	–	# Look in array of raw tools to see if this tool has a ToolParser object:
178	–	$toolcheck=0;
179	–
180	–	map
181	–	{
182	–	if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
183	–	} $self->rawtools();
184	–
185	–	# Tool not known so we create a new ToolParser object and parse it:
186	–	if ($toolcheck != 1 || $force == 1)
187	–	{
188	–	$toolparser = BuildSystem::ToolParser->new();
189	–	$toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
190	–	$toolparser->filetail('</doc>');
191	–	# We only want to store the stuff relevant for one particular version:
192	–	$toolparser->parse($toolname, $toolversion, $toolfile);
193	–	# Store the ToolParser object in the cache:
194	–	$self->store($toolparser);
195	–	print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG});
196	–	}
197	–
71		# Next, set up the tool:
72	<	my $store = $toolparser->processrawtool($self->interactive());
200	<	# Make sure that we have this tool in the list of selected tools (just in case this tool was
201	<	# set up by hand afterwards):
202	<	$self->addtoselected($toolname);
203	<
204	<	# Check to see if this tool is a compiler. If so, store it.
205	<	# Also store the language that this compiler supprots, and a
206	<	# compiler name (e.g. gcc323) which, in conjunction with a stem
207	<	# architecture name like slc3_ia32_, can be used to build a complete arch string:
208	<	if ($store->scram_compiler() == 1)
209	<	{
210	<	my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
211	<	my @compilername = $store->flags("SCRAM_COMPILER_NAME");
212	<	$self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
213	<	}
214	<
215	<	# Store the ToolData object in the cache:
216	<	$self->storeincache($toolparser->toolname(),$store);
217	<	return $self;
218	<	}
72	>	my $store = $toolparser->processrawtool();
73
74	<	sub toolsetup()
75	<	{
76	<	my $self=shift;
77	<	my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
78	<	my ($urlcache, $url, $filename, $tfname);
79	<	my $toolfile;
80	<	my $force = 0; # we may have to force a reparse of a tool file
81	<
82	<	$toolname =~ tr[A-Z][a-z];
83	<	$toolversion ||= $self->defaultversion($toolname);
84	<	$urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
85	<
232	<	# Check for the downloaded tools cache:
233	<	if (defined($urlcache))
234	<	{
235	<	$self->{urlhandler}=URL::URLhandler->new($urlcache);
236	<	}
237	<
238	<	$url = $self->toolurls()->{$toolname};
239	<	$filename = $self->{toolfiledir}."/".$toolname;
240	<
241	<	# If .SCRAM/InstalledTools doesn't exist, create it:
242	<	if (! -d $self->{toolfiledir})
243	<	{
244	<	AddDir::adddir($self->{toolfiledir});
245	<	}
246	<
247	<	# First, check to see if there was a tool URL given. If so, we might need to read
248	<	# from http or from a file: type URL:
249	<	if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
250	<	{
251	<	# See what kind of URL (file:, http:, cvs:, svn:, .. ):
252	<	if ($proto eq 'file')
253	<	{
254	<	# Check to see if there is a ~ and substitute the user
255	<	# home directory if there is (file:~/xyz):
256	<	if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|))
257	<	{
258	<	$urlv = $ENV{HOME}."/".$urlpath;
259	<	}
260	<	elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|))
261	<	{
262	<	# Relative to current directory (file:./xyz):
263	<	use Cwd qw(&cwd);
264	<	$urlv = cwd()."/".$urlpath;
265	<	}
266	<
267	<	# If the tool url is a file and the file exists,
268	<	# copy it to .SCRAM/InstalledTools and set the
269	<	# filename accordingly:
270	<	if ( -f $urlv)
271	<	{
272	<	use File::Copy;
273	<	copy($urlv, $filename);
274	<	my $mode = 0644; chmod $mode, $filename;
275	<	$toolfile=$filename;
276	<	# Here we must account for the fact that the file tool doc may be
277	<	# a modified version of an existing tool in the current config. we
278	<	# make sure that this file is reparsed, even if there is already a
279	<	# ToolParser object for the tool:
280	<	$force = 1;
281	<	}
282	<	else
283	<	{
284	<	$::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!");
285	<	}
286	<	}
287	<	elsif ($proto eq 'http')
288	<	{
289	<	print "SCRAM: downloading $toolname from $toolurl","\n";
290	<	# Download from WWW first:
291	<	use LWP::Simple qw(&getstore);
292	<	my $http_response_val = &getstore($toolurl, $filename);
293	<
294	<	# Check the HTTP status. If doc not found, exit:
295	<	if ($http_response_val != 200)
296	<	{
297	<	my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|);
298	<	$::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
299	<	}
300	<	else
301	<	{
302	<	$toolfile=$filename;
303	<	}
304	<	}
305	<	elsif ($proto eq 'cvs')
306	<	{
307	<	print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
308	<	print "[ not yet supported ]","\n";
309	<	exit(0);
310	<	}
311	<	elsif ($proto eq 'svn')
312	<	{
313	<	print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
314	<	print "[ not yet supported ]","\n";
315	<	exit(0);
316	<	}
317	<	else
318	<	{
319	<	$::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
320	<	}
321	<	}
322	<	else
323	<	{
324	<	# Copy the downloaded tool file to InstalledTools directory:
325	<	if ( ! -f $filename )
326	<	{
327	<	# If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
328	<	# We signal an error and exit:
329	<	if ($url eq '')
330	<	{
331	<	$::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
332	<	}
333	<	else
334	<	{
335	<	# Otherwise, we try to download it:
336	<	$self->verbose("Attempting Download of $url");
337	<	# Get file from download cache:
338	<	($url,$filename)=$self->{urlhandler}->get($url);
339	<	use File::Copy;
340	<	$tfname=$self->{toolfiledir}."/".$toolname;
341	<	copy($filename, $tfname);
342	<	my $mode = 0644; chmod $mode, $tfname;
343	<	$toolfile=$tfname;
344	<	}
345	<	}
346	<	else
347	<	{
348	<	# File already exists in the .SCRAM/InstallTools directory:
349	<	$toolfile=$filename;
74	>	# Store the ToolData object in the cache:
75	>	$self->storeincache($toolname,$store);
76	>	my $srcfile=Utilities::AddDir::fixpath($toolfile);
77	>	my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml");
78	>	use File::Copy;
79	>	if ($srcfile ne $desfile)
80	>	{
81	>	use File::Copy;
82	>	my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml");
83	>	if ($srcfile ne $desfile1)
84	>	{
85	>	copy($srcfile,$desfile1);
86		}
87	+	if (-e $desfile) { unlink($desfile);}
88	+	symlink("../available/${toolname}.xml",$desfile);
89		}
90	<
353	<	# Run the core setup routine:
354	<	$self->coresetup($toolname, $toolversion, $toolfile,$force);
90	>	scramlogclean();
91		return $self;
92		}
93
94		sub setupself()
95		{
96		my $self=shift;
361	–	my ($location)=@_;
97		# Process the file "Self" in local config directory. This is used to
98		# set all the paths/runtime settings for this project:
99	<	my $filename=$location."/config/Self.xml";
99	>	my $filename=$self->{configdir}."/Self.xml";
100
101		if ( -f $filename )
102		{
#	Line 370 | Line 105 | sub setupself()
105		$selfparser = BuildSystem::ToolParser->new();
106		$selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
107		$selfparser->filehead ('</doc>');
108	<	$selfparser->parse('self','SELF',$filename);
108	>	$selfparser->parse($filename);
109
110		# Next, set up the tool:
111	<	$store = $selfparser->processrawtool($self->interactive());
111	>	$store = $selfparser->processrawtool();
112
113		# If we are in a developer area, also add RELEASETOP paths:
114		if (exists($ENV{RELEASETOP}))
#	Line 389 | Line 124 | sub setupself()
124		else
125		{
126		scramlogdump();
127	<	print "\n";
128	<	print "SCRAM: No file config/Self.xml...nothing to do.";
129	<	print "\n";
127	>	print STDERR "\n";
128	>	print STDERR "SCRAM: No file config/Self.xml...nothing to do.";
129	>	print STDERR "\n";
130		return;
131		}
132		}
133
134	<	sub defaultversion()
134	>	sub update()
135		{
136	<	my $self = shift;
137	<	my ($tool) = @_;
138	<	# Return default versions as taken from configuration:
139	<	return (%{$self->defaultversions()}->{$tool});
136	>	my $self=shift;
137	>	my $area=shift;
138	>	$self->init($area);
139	>	$self->setupself();
140	>	$self->dirty ()
141		}
142	<
142	>
143		sub storeincache()
144		{
145		my $self=shift;
#	Line 413 | Line 149 | sub storeincache()
149		if (ref($dataobject) eq 'BuildSystem::ToolData')
150		{
151		$self->updatetooltimestamp($dataobject, $toolname);
152	+	delete $self->{SETUP}->{$toolname};
153		$self->{SETUP}->{$toolname} = $dataobject;
154		}
155		else
#	Line 442 | Line 179 | sub toolsdata()
179		{
180		my $self = shift;
181		my $tooldata = [];
182	<	my $rawsel = $self->selected();
183	<
184	<	foreach my $tool ( sort { %{$rawsel}->{$a}
448	<	<=> %{$rawsel}->{$b}}
449	<	keys %{$rawsel} )
182	>	$self->{internal}{donetools}={};
183	>	$self->{internal}{scram_tools}={};
184	>	foreach my $tool (sort keys %{$self->{SETUP}})
185		{
186	<	# Return tool data objects of all set-up tools, skipping the tool "self":
187	<	if ($_ ne "self")
186	>	if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
187	>	elsif ($tool ne "self")
188		{
189	<	# Keep only tools that have really been set up:
190	<	if (exists $self->{SETUP}->{$tool})
189	>	$self->_toolsdata($tool,$tooldata);
190	>	}
191	>	}
192	>	foreach my $tool (keys %{$self->{internal}{scram_tools}})
193	>	{
194	>	$self->_toolsdata_scram($tool,$tooldata);
195	>	}
196	>	delete $self->{internal}{donetools};
197	>	delete $self->{internal}{scram_tools};
198	>	my $data=[];
199	>	foreach my $d (@$tooldata)
200	>	{
201	>	if (ref($d) eq "ARRAY")
202	>	{
203	>	foreach my $t (@$d) {push @$data,$t;}
204	>	}
205	>	}
206	>	return $data;
207	>	}
208	>
209	>	sub _toolsdata()
210	>	{
211	>	my $self = shift;
212	>	my $tool=shift;
213	>	my $data=shift || [];
214	>	my $order=-1;
215	>	if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
216	>	$self->{internal}{donetools}{$tool}=$order;
217	>	if (exists $self->{SETUP}{$tool})
218	>	{
219	>	if (exists $self->{SETUP}{$tool}{USE})
220	>	{
221	>	foreach my $use (@{$self->{SETUP}{$tool}{USE}})
222		{
223	<	push(@tooldata,$self->{SETUP}->{$tool});
223	>	my $o=$self->_toolsdata(lc($use),$data);
224	>	if ($o>$order){$order=$o;}
225		}
226		}
227	+	$order++;
228	+	if(!defined $data->[$order]){$data->[$order]=[];}
229	+	push @{$data->[$order]},$self->{SETUP}{$tool};
230	+	$self->{internal}{donetools}{$tool}=$order;
231		}
232	<
462	<	# Return the array of tools, in order that they appear in RequirementsDoc:
463	<	return @tooldata;
232	>	return $order;
233		}
234
235	<	sub definedtool()
235	>	sub _toolsdata_scram()
236		{
237	<	my $self=shift;
238	<	my ($tool)=@_;
239	<
240	<	# Check to see if tool X is an external tool:
241	<	grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
242	<	: return 0;
237	>	my $self = shift;
238	>	my $tool=shift;
239	>	my $data=shift || [];
240	>	my $order=-1;
241	>	if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
242	>	$self->{internal}{donetools}{$tool}=$order;
243	>	if(!exists $self->{internal}{scram_tools}{$tool}){return $order;}
244	>	use Configuration::ConfigArea;
245	>	use Cache::CacheUtilities;
246	>	my $cache=uc($tool)."_BASE";
247	>	$cache=$self->{SETUP}{$tool}{$cache};
248	>	if (!-d $cache)
249	>	{
250	>	print STDERR "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
251	>	return $order;
252	>	}
253	>	my $area=Configuration::ConfigArea->new();
254	>	$area->location($cache);
255	>	my $cachefile=$area->toolcachename();
256	>	if (!-f $cachefile)
257	>	{
258	>	print STDERR "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
259	>	return $order;
260	>	}
261	>	$cache=&Cache::CacheUtilities::read($cachefile);
262	>	my $tools=$cache->setup();
263	>	$order=scalar(@$data)-1;
264	>	foreach my $use (keys %$tools)
265	>	{
266	>	if ($tools->{$use}->scram_project() == 1)
267	>	{
268	>	my $o=$self->_toolsdata_scram($use,$data);
269	>	if ($o>$order){$order=$o;}
270	>	}
271	>	}
272	>	$order++;
273	>	if(!defined $data->[$order]){$data->[$order]=[];}
274	>	push @{$data->[$order]},$self->{SETUP}{$tool};
275	>	$self->{internal}{donetools}{$tool}=$order;
276	>	return $order;
277		}
278	<
278	>
279		sub checkifsetup()
280		{
281		my $self=shift;
#	Line 482 | Line 285 | sub checkifsetup()
285		: return undef;
286		}
287
485	–	sub cloned_tm()
486	–	{
487	–	my $self=shift;
488	–	# Has this area already been cloned and brought in-line with current location:
489	–	@_ ? $self->{CLONED} = $_[0]
490	–	: $self->{CLONED};
491	–	}
492	–
288		sub remove_tool()
289		{
290		my $self=shift;
291		my ($toolname)=@_;
292	<	my $tools = $self->{SETUP};
293	<	my $newtlist = {};
294	<
295	<	while (my ($tool, $tooldata) = each %$tools)
292	>	delete $self->{SETUP}{$toolname};
293	>	print "Deleting $toolname from cache.","\n";
294	>	$self->updatetooltimestamp (undef, $toolname);
295	>	$self->writecache();
296	>	my $file1=$self->{toolcache}."/selected/${toolname}.xml";
297	>	my $file2=$self->{toolcache}."/available/${toolname}.xml";
298	>	if ((!-f $file2) && (-f $file1))
299		{
300	<	if ($tool ne $toolname)
301	<	{
504	<	$newtlist->{$tool} = $tooldata;
505	<	}
506	<	else
507	<	{
508	<	# Is this tool a compiler?
509	<	if ($tooldata->scram_compiler() == 1)
510	<	{
511	<	# Also remove this from the compiler info if there happens to be an entry:
512	<	while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
513	<	{
514	<	if ($toolname eq $ctool->[0])
515	<	{
516	<	delete $self->{SCRAM_COMPILER}->{$langtype};
517	<	print "Deleting compiler $toolname from cache.","\n";
518	<	}
519	<	}
520	<	}
521	<	else
522	<	{
523	<	print "Deleting $toolname from cache.","\n";
524	<	}
525	<	}
300	>	use File::Copy;
301	>	copy ($file1,$file2);
302		}
303	<
528	<	$self->{SETUP} = $newtlist;
529	<	$self->updatetooltimestamp ("", $toolname);
530	<	# Now remove from the RAW tool list:
531	<	$self->cleanup_raw($toolname);
532	<	print "ToolManager: Updating tool cache.","\n";
533	<	$self->writecache();
303	>	unlink ($file1);
304		}
305
306		sub scram_projects()
#	Line 548 | Line 318 | sub scram_projects()
318		return $scram_projects;
319		}
320
551	–	sub scram_compiler()
552	–	{
553	–	my $self=shift;
554	–	my ($langtype, $toolname, $compilername)=@_;
555	–
556	–	if ($langtype)
557	–	{
558	–	# Store the compiler info according to supported
559	–	# language types.
560	–	#
561	–	# ---------------------- e.g C++      cxxcompiler    gcc323
562	–	$self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
563	–	}
564	–	else
565	–	{
566	–	return $self->{SCRAM_COMPILER};
567	–	}
568	–	}
569	–
570	–	sub updatetool()
571	–	{
572	–	my $self=shift;
573	–	my ($name, $obj) = @_;
574	–
575	–	# Replace the existing copy of the tool with the new one:
576	–	if (exists $self->{SETUP}->{$name})
577	–	{
578	–	# Check to make sure that we were really passed a compiler with
579	–	# the desired name:
580	–	if ($obj->toolname() eq $name)
581	–	{
582	–	$self->updatetooltimestamp ($obj, $name);
583	–	print "ToolManager: Updating the cached copy of ".$name."\n";
584	–	delete $self->{SETUP}->{$name};
585	–	$self->{SETUP}->{$name} = $obj;
586	–	$self->writecache();
587	–	}
588	–	else
589	–	{
590	–	print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
591	–	print "         Not making any changes.","\n";
592	–	}
593	–	}
594	–	else
595	–	{
596	–	print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
597	–	}
598	–	}
599	–
600	–	sub check_compatibility()
601	–	{
602	–	my $self=shift;
603	–	my ($itoolmgr)=@_;
604	–	# Get the version of the toolmanager. If the project fails to return a version
605	–	# string we return 0 for no compatibility (in which case, all tools will be set
606	–	# up in the traditional way):
607	–	my $itm_configversion = $itoolmgr->configversion();
608	–	if ($itm_configversion)
609	–	{
610	–	# The configurations won't be identical. We must compare the digits:
611	–	my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
612	–	my $current_configversion = $self->configversion();
613	–	my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
614	–	($current_numeric_version == $numeric_version) && return 1; # OK, compatible;
615	–	}
616	–	# Project does not define configuration version so just return:
617	–	return 0;
618	–	}
619	–
620	–	sub configversion()
621	–	{
622	–	my $self=shift;
623	–	@_ ? $self->{CONFIGVERSION} = shift
624	–	: $self->{CONFIGVERSION};
625	–	}
626	–
321		sub updatetooltimestamp ()
322		{
323		my $self=shift;
#	Line 636 | Line 330 | sub updatetooltimestamp ()
330		{
331		$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
332		}
333	+	if ($toolname ne "self")
334	+	{
335	+	my $instdir = $self->{archstore}."/InstalledTools";
336	+	my $tfile = "${instdir}/${toolname}";
337	+	if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
338	+	elsif ((defined $obj) && (!-f $tfile))
339	+	{
340	+	Utilities::AddDir::adddir($instdir);
341	+	my $ref;
342	+	open($ref,">$tfile");
343	+	close($ref);
344	+	}
345	+	}
346		if ((!$samevalues) || (!-f $stampfile))
347		{
348		if (!-d $stampdir)
349		{
350	<	AddDir::adddir($stampdir);
350	>	Utilities::AddDir::adddir($stampdir);
351		}
352	<	open(TIMESTAMPFILE,">$stampfile");
353	<	close(TIMESTAMPFILE);
352	>	my $ref;
353	>	open($ref,">$stampfile");
354	>	close($ref);
355	>	if (!$samevalues){$self->dirty();}
356		}
357		}
358

Diff Legend

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