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.13 by sashby, Fri Oct 7 16:05:44 2005 UTC vs.
Revision 1.21 by muzaffar, Fri Oct 14 14:11:42 2011 UTC

#	Line 16 | Line 16 | use Exporter;
16		use BuildSystem::ToolCache;
17		use BuildSystem::ToolParser;
18		use Utilities::AddDir;
19	–	use URL::URLhandler;
19		use Utilities::Verbose;
20	+	use SCRAM::MsgLog;
21
22		@ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
23		@EXPORT_OK=qw( );
24		#
25
26		sub new
27	–	###############################################################
28	–	# new                                                         #
29	–	###############################################################
30	–	# modified : Wed Nov 12 10:34:10 2003 / SFA                   #
31	–	# params   :                                                  #
32	–	#          :                                                  #
33	–	# function :                                                  #
34	–	#          :                                                  #
35	–	###############################################################
27		{
28		my $proto=shift;
29		my $class=ref($proto) || $proto;
30		my $self=$class->SUPER::new();    # Inherit from ToolCache
40	–	my $projectarea=shift;
41	–
31		bless $self,$class;
32	<
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	<
32	>	$self->init (shift);
33		return $self;
34		}
35
36	<	sub clone()
36	>	sub init ()
37		{
38		my $self=shift;
39		my $projectarea=shift;
72	–
73	–	# Change cache settings to reflect the new location:
40		$self->{topdir}=$projectarea->location();
75	–
41		$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
42	<	$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
43	<	$self->{datastore}=$self->{topdir}."/.SCRAM";
79	<	$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
80	<
81	<	# Change the cache name:
42	>	$self->{archstore}=$projectarea->archdir();
43	>	$self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools";
44		$self->name($projectarea->toolcachename());
45	<	$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);
45	>	$self->dirty();
46		}
47	<
47	>
48		sub setupalltools()
49		{
50		my $self = shift;
51	<	my ($arealocation,$setupopt) = @_;
52	<	my (@localtools);
53	<	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:
154	<	$self->inheritcontent($satoolmanager);
155	<	}
156	<	}
157	<	}
158	<	# Also add this scram-managed project to list of tools to set up:
159	<	push(@localtools,$S);
160	<	}
161	<	else
162	<	{
163	<	# Store other tools in ReqDoc in separate array. We will set up these tools later:
164	<	push(@localtools,$S);
165	<	}
166	<	}
167	<
168	<	# Set up extra tools required in this project, in addition to
169	<	# any scram-managed projects
170	<	foreach my $localtool (@localtools)
171	<	{
172	<	# First check to see if it's already set up (i.e., was contained
173	<	# in list of requirements for scram project):
174	<	if (! $self->definedtool($localtool))
175	<	{
176	<	$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
177	<	$self->addtoselected($localtool);
178	<	}
179	<	else
180	<	{
181	<	print $localtool," already set up.","\n",if ($ENV{SCRAM_DEBUG});
182	<	}
183	<	}
184	<	}
185	<	else
51	>	my @selected=();
52	>	my $tooldir=$self->{toolcache}."/selected";
53	>	foreach my $tool (@{&getfileslist($tooldir)})
54		{
55	<	# Just loop over all tools and setup again:
188	<	foreach my $localtool (@{$selected})
189	<	{
190	<	$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
191	<	}
55	>	if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
56		}
57	<
58	<	print "\n";
57	>	foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");}
58	>	scramlogmsg("\n");
59		}
60
61		sub coresetup()
62		{
63		my $self=shift;
64	<	my ($toolname, $toolversion, $toolfile, $force) = @_;
201	<	my ($toolcheck, $toolparser);
202	<
203	<	print "\n";
204	<	print $::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n";
205	<
206	<	# New ToolParser object for this tool if there isn't one already.
207	<	# Look in array of raw tools to see if this tool has a ToolParser object:
208	<	$toolcheck=0;
209	<
210	<	map
211	<	{
212	<	if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
213	<	} $self->rawtools();
64	>	my ($toolfile) = @_;
65
66	<	# Tool not known so we create a new ToolParser object and parse it:
67	<	if ($toolcheck != 1 || $force == 1)
68	<	{
69	<	$toolparser = BuildSystem::ToolParser->new();
70	<	# We only want to store the stuff relevant for one particular version:
71	<	$toolparser->parse($toolname, $toolversion, $toolfile);
72	<	# Store the ToolParser object in the cache:
222	<	$self->store($toolparser);
223	<	print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG});
224	<	}
66	>	my $toolparser = BuildSystem::ToolParser->new();
67	>	$toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
68	>	$toolparser->filetail('</doc>');
69	>	$toolparser->parse($toolfile);
70	>	my $toolname = $toolparser->toolname();
71	>	my $toolversion = $toolparser->toolversion();
72	>	scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n");
73
74		# Next, set up the tool:
75	<	my $store = $toolparser->processrawtool($self->interactive());
228	<	# Make sure that we have this tool in the list of selected tools (just in case this tool was
229	<	# set up by hand afterwards):
230	<	$self->addtoselected($toolname);
75	>	my $store = $toolparser->processrawtool();
76
77		# Check to see if this tool is a compiler. If so, store it.
78		# Also store the language that this compiler supprots, and a
#	Line 240 | Line 85 | sub coresetup()
85		$self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
86		}
87
88	<	# Store the ToolData object in the cache:
89	<	$self->storeincache($toolparser->toolname(),$store);
90	<	return $self;
91	<	}
92	<
93	<	sub toolsetup()
94	<	{
95	<	my $self=shift;
96	<	my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
97	<	my ($urlcache, $url, $filename, $tfname);
98	<	my $toolfile;
99	<	my $force = 0; # we may have to force a reparse of a tool file
255	<
256	<	$toolname =~ tr[A-Z][a-z];
257	<	$toolversion ||= $self->defaultversion($toolname);
258	<	$urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
259	<
260	<	# Check for the downloaded tools cache:
261	<	if (defined($urlcache))
262	<	{
263	<	$self->{urlhandler}=URL::URLhandler->new($urlcache);
264	<	}
265	<
266	<	$url = $self->toolurls()->{$toolname};
267	<	$filename = $self->{toolfiledir}."/".$toolname;
268	<
269	<	# If .SCRAM/InstalledTools doesn't exist, create it:
270	<	if (! -d $self->{toolfiledir})
271	<	{
272	<	AddDir::adddir($self->{toolfiledir});
273	<	}
274	<
275	<	# First, check to see if there was a tool URL given. If so, we might need to read
276	<	# from http or from a file: type URL:
277	<	if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
278	<	{
279	<	# See what kind of URL (file:, http:, cvs:, svn:, .. ):
280	<	if ($proto eq 'file')
281	<	{
282	<	# Check to see if there is a ~ and substitute the user
283	<	# home directory if there is (file:~/xyz):
284	<	if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|))
285	<	{
286	<	$urlv = $ENV{HOME}."/".$urlpath;
287	<	}
288	<	elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|))
289	<	{
290	<	# Relative to current directory (file:./xyz):
291	<	use Cwd qw(&cwd);
292	<	$urlv = cwd()."/".$urlpath;
293	<	}
294	<
295	<	# If the tool url is a file and the file exists,
296	<	# copy it to .SCRAM/InstalledTools and set the
297	<	# filename accordingly:
298	<	if ( -f $urlv)
299	<	{
300	<	use File::Copy;
301	<	copy($urlv, $filename);
302	<	my $mode = 0644; chmod $mode, $filename;
303	<	$toolfile=$filename;
304	<	# Here we must account for the fact that the file tool doc may be
305	<	# a modified version of an existing tool in the current config. we
306	<	# make sure that this file is reparsed, even if there is already a
307	<	# ToolParser object for the tool:
308	<	$force = 1;
309	<	}
310	<	else
311	<	{
312	<	$::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!");
313	<	}
314	<	}
315	<	elsif ($proto eq 'http')
316	<	{
317	<	print "SCRAM: downloading $toolname from $toolurl","\n";
318	<	# Download from WWW first:
319	<	use LWP::Simple qw(&getstore);
320	<	my $http_response_val = &getstore($toolurl, $filename);
321	<
322	<	# Check the HTTP status. If doc not found, exit:
323	<	if ($http_response_val != 200)
324	<	{
325	<	my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|);
326	<	$::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
327	<	}
328	<	else
329	<	{
330	<	$toolfile=$filename;
331	<	}
332	<	}
333	<	elsif ($proto eq 'cvs')
334	<	{
335	<	print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
336	<	print "[ not yet supported ]","\n";
337	<	exit(0);
338	<	}
339	<	elsif ($proto eq 'svn')
340	<	{
341	<	print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
342	<	print "[ not yet supported ]","\n";
343	<	exit(0);
344	<	}
345	<	else
346	<	{
347	<	$::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
348	<	}
349	<	}
350	<	else
351	<	{
352	<	# Copy the downloaded tool file to InstalledTools directory:
353	<	if ( ! -f $filename )
354	<	{
355	<	# If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
356	<	# We signal an error and exit:
357	<	if ($url eq '')
358	<	{
359	<	$::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
360	<	}
361	<	else
362	<	{
363	<	# Otherwise, we try to download it:
364	<	$self->verbose("Attempting Download of $url");
365	<	# Get file from download cache:
366	<	($url,$filename)=$self->{urlhandler}->get($url);
367	<	use File::Copy;
368	<	$tfname=$self->{toolfiledir}."/".$toolname;
369	<	copy($filename, $tfname);
370	<	my $mode = 0644; chmod $mode, $tfname;
371	<	$toolfile=$tfname;
372	<	}
373	<	}
374	<	else
375	<	{
376	<	# File already exists in the .SCRAM/InstallTools directory:
377	<	$toolfile=$filename;
88	>	# Store the ToolData object in the cache:
89	>	$self->storeincache($toolname,$store);
90	>	my $srcfile=Utilities::AddDir::fixpath($toolfile);
91	>	my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml");
92	>	use File::Copy;
93	>	if ($srcfile ne $desfile)
94	>	{
95	>	use File::Copy;
96	>	my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml");
97	>	if ($srcfile ne $desfile1)
98	>	{
99	>	copy($srcfile,$desfile1);
100		}
101	+	if (-e $desfile) { unlink($desfile);}
102	+	symlink("../available/${toolname}.xml",$desfile);
103		}
104	<
381	<	# Run the core setup routine:
382	<	$self->coresetup($toolname, $toolversion, $toolfile,$force);
104	>	scramlogclean();
105		return $self;
106		}
107
108		sub setupself()
109		{
110		my $self=shift;
389	–	my ($location)=@_;
111		# Process the file "Self" in local config directory. This is used to
112		# set all the paths/runtime settings for this project:
113	<	my $filename=$location."/config/Self";
113	>	my $filename=$self->{configdir}."/Self.xml";
114
115		if ( -f $filename )
116		{
117	<	print "\n";
397	<	print $::bold."Setting up SELF:".$::normal,"\n";
117	>	scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
118		# Self file exists so process it:
119		$selfparser = BuildSystem::ToolParser->new();
120	<	$selfparser->parse('self','SELF',$filename);
120	>	$selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
121	>	$selfparser->filehead ('</doc>');
122	>	$selfparser->parse($filename);
123
124		# Next, set up the tool:
125	<	$store = $selfparser->processrawtool($self->interactive());
126	<
125	>	$store = $selfparser->processrawtool();
126	>
127		# If we are in a developer area, also add RELEASETOP paths:
128		if (exists($ENV{RELEASETOP}))
129		{
#	Line 411 | Line 133 | sub setupself()
133
134		# Store the ToolData object in the cache:
135		$self->storeincache($selfparser->toolname(),$store);
136	<	print "\n";
136	>	scramlogmsg("\n");
137		}
138		else
139		{
140	+	scramlogdump();
141		print "\n";
142	<	print "SCRAM: No file config/Self...nothing to do.";
142	>	print "SCRAM: No file config/Self.xml...nothing to do.";
143		print "\n";
144		return;
145		}
146		}
147
148	<	sub defaultversion()
148	>	sub update()
149		{
150	<	my $self = shift;
151	<	my ($tool) = @_;
152	<	# Return default versions as taken from configuration:
153	<	return (%{$self->defaultversions()}->{$tool});
150	>	my $self=shift;
151	>	my $area=shift;
152	>	$self->init($area);
153	>	$self->setupself();
154	>	$self->dirty ()
155		}
156	<
156	>
157		sub storeincache()
158		{
159		my $self=shift;
#	Line 438 | Line 162 | sub storeincache()
162		# Store ToolData object (for a set-up tool) in cache:
163		if (ref($dataobject) eq 'BuildSystem::ToolData')
164		{
165	+	$self->updatetooltimestamp($dataobject, $toolname);
166	+	delete $self->{SETUP}->{$toolname};
167		$self->{SETUP}->{$toolname} = $dataobject;
168		}
169		else
#	Line 467 | Line 193 | sub toolsdata()
193		{
194		my $self = shift;
195		my $tooldata = [];
196	<	my $rawsel = $self->selected();
197	<
198	<	foreach my $tool ( sort { %{$rawsel}->{$a}
473	<	<=> %{$rawsel}->{$b}}
474	<	keys %{$rawsel} )
196	>	$self->{internal}{donetools}={};
197	>	$self->{internal}{scram_tools}={};
198	>	foreach my $tool (sort keys %{$self->{SETUP}})
199		{
200	<	# Return tool data objects of all set-up tools, skipping the tool "self":
201	<	if ($_ ne "self")
200	>	if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
201	>	elsif ($tool ne "self")
202		{
203	<	# Keep only tools that have really been set up:
204	<	if (exists $self->{SETUP}->{$tool})
203	>	$self->_toolsdata($tool,$tooldata);
204	>	}
205	>	}
206	>	foreach my $tool (keys %{$self->{internal}{scram_tools}})
207	>	{
208	>	$self->_toolsdata_scram($tool,$tooldata);
209	>	}
210	>	delete $self->{internal}{donetools};
211	>	delete $self->{internal}{scram_tools};
212	>	my $data=[];
213	>	foreach my $d (@$tooldata)
214	>	{
215	>	if (ref($d) eq "ARRAY")
216	>	{
217	>	foreach my $t (@$d) {push @$data,$t;}
218	>	}
219	>	}
220	>	return $data;
221	>	}
222	>
223	>	sub _toolsdata()
224	>	{
225	>	my $self = shift;
226	>	my $tool=shift;
227	>	my $data=shift || [];
228	>	my $order=-1;
229	>	if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
230	>	$self->{internal}{donetools}{$tool}=$order;
231	>	if (exists $self->{SETUP}{$tool})
232	>	{
233	>	if (exists $self->{SETUP}{$tool}{USE})
234	>	{
235	>	foreach my $use (@{$self->{SETUP}{$tool}{USE}})
236		{
237	<	push(@tooldata,$self->{SETUP}->{$tool});
237	>	my $o=$self->_toolsdata(lc($use),$data);
238	>	if ($o>$order){$order=$o;}
239		}
240		}
241	+	$order++;
242	+	if(!defined $data->[$order]){$data->[$order]=[];}
243	+	push @{$data->[$order]},$self->{SETUP}{$tool};
244	+	$self->{internal}{donetools}{$tool}=$order;
245		}
246	<
487	<	# Return the array of tools, in order that they appear in RequirementsDoc:
488	<	return @tooldata;
246	>	return $order;
247		}
248
249	<	sub definedtool()
249	>	sub _toolsdata_scram()
250		{
251	<	my $self=shift;
252	<	my ($tool)=@_;
253	<
254	<	# Check to see if tool X is an external tool:
255	<	grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
256	<	: return 0;
251	>	my $self = shift;
252	>	my $tool=shift;
253	>	my $data=shift || [];
254	>	my $order=-1;
255	>	if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
256	>	$self->{internal}{donetools}{$tool}=$order;
257	>	if(!exists $self->{internal}{scram_tools}{$tool}){return $order;}
258	>	use Configuration::ConfigArea;
259	>	use Cache::CacheUtilities;
260	>	my $cache=uc($tool)."_BASE";
261	>	$cache=$self->{SETUP}{$tool}{$cache};
262	>	if (!-d $cache)
263	>	{
264	>	print "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
265	>	return $order;
266	>	}
267	>	my $area=Configuration::ConfigArea->new();
268	>	$area->location($cache);
269	>	my $cachefile=$area->toolcachename();
270	>	if (!-f $cachefile)
271	>	{
272	>	print "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
273	>	return $order;
274	>	}
275	>	$cache=&Cache::CacheUtilities::read($cachefile);
276	>	my $tools=$cache->setup();
277	>	$order=scalar(@$data)-1;
278	>	foreach my $use (keys %$tools)
279	>	{
280	>	if ($tools->{$use}->scram_project() == 1)
281	>	{
282	>	my $o=$self->_toolsdata_scram($use,$data);
283	>	if ($o>$order){$order=$o;}
284	>	}
285	>	}
286	>	$order++;
287	>	if(!defined $data->[$order]){$data->[$order]=[];}
288	>	push @{$data->[$order]},$self->{SETUP}{$tool};
289	>	$self->{internal}{donetools}{$tool}=$order;
290	>	return $order;
291		}
292	<
292	>
293		sub checkifsetup()
294		{
295		my $self=shift;
#	Line 507 | Line 299 | sub checkifsetup()
299		: return undef;
300		}
301
510	–	sub cloned_tm()
511	–	{
512	–	my $self=shift;
513	–	# Has this area already been cloned and brought in-line with current location:
514	–	@_ ? $self->{CLONED} = $_[0]
515	–	: $self->{CLONED};
516	–	}
517	–
302		sub remove_tool()
303		{
304		my $self=shift;
305		my ($toolname)=@_;
306	<	my $tools = $self->{SETUP};
307	<	my $newtlist = {};
524	<
525	<	while (my ($tool, $tooldata) = each %$tools)
306	>	my $tool = $self->{SETUP}{$toolname};
307	>	if ($tool->scram_compiler() == 1)
308		{
309	<	if ($tool ne $toolname)
310	<	{
311	<	$newtlist->{$tool} = $tooldata;
530	<	}
531	<	else
532	<	{
533	<	# Is this tool a compiler?
534	<	if ($tooldata->scram_compiler() == 1)
535	<	{
536	<	# Also remove this from the compiler info if there happens to be an entry:
537	<	while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
538	<	{
539	<	if ($toolname eq $ctool->[0])
540	<	{
541	<	delete $self->{SCRAM_COMPILER}->{$langtype};
542	<	print "Deleting compiler $toolname from cache.","\n";
543	<	}
544	<	}
545	<	}
546	<	else
547	<	{
548	<	print "Deleting $toolname from cache.","\n";
549	<	}
309	>	while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
310	>	{
311	>	if ($toolname eq $ctool->[0]){delete $self->{SCRAM_COMPILER}->{$langtype};}
312		}
313		}
314	<
315	<	$self->{SETUP} = $newtlist;
316	<
555	<	# Now remove from the RAW tool list:
556	<	$self->cleanup_raw($toolname);
557	<	print "ToolManager: Updating tool cache.","\n";
314	>	delete $self->{SETUP}{$toolname};
315	>	print "Deleting $toolname from cache.","\n";
316	>	$self->updatetooltimestamp (undef, $toolname);
317		$self->writecache();
318	+	my $file1=$self->{toolcache}."/selected/${toolname}.xml";
319	+	my $file2=$self->{toolcache}."/available/${toolname}.xml";
320	+	if ((!-f $file2) && (-f $file1))
321	+	{
322	+	use File::Copy;
323	+	copy ($file1,$file2);
324	+	}
325	+	unlink ($file1);
326		}
327
328		sub scram_projects()
#	Line 592 | Line 359 | sub scram_compiler()
359		}
360		}
361
362	<	sub updatetool()
362	>	sub updatetooltimestamp ()
363		{
364		my $self=shift;
365	<	my ($name, $obj) = @_;
366	<
367	<	# Replace the existing copy of the tool with the new one:
368	<	if (exists $self->{SETUP}->{$name})
365	>	my $obj=shift;
366	>	my $toolname=shift;
367	>	my $samevalues=0;
368	>	my $stampdir = $self->{archstore}."/timestamps";
369	>	my $stampfile="${stampdir}/${toolname}";
370	>	if (exists $self->{SETUP}->{$toolname})
371		{
372	<	# Check to make sure that we were really passed a compiler with
373	<	# the desired name:
374	<	if ($obj->toolname() eq $name)
375	<	{
376	<	print "ToolManager: Updating the cached copy of ".$name."\n";
377	<	delete $self->{SETUP}->{$name};
378	<	$self->{SETUP}->{$name} = $obj;
379	<	$self->writecache();
372	>	$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
373	>	}
374	>	if ($toolname ne "self")
375	>	{
376	>	my $instdir = $self->{archstore}."/InstalledTools";
377	>	my $tfile = "${instdir}/${toolname}";
378	>	if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
379	>	elsif ((defined $obj) && (!-f $tfile))
380	>	{
381	>	Utilities::AddDir::adddir($instdir);
382	>	my $ref;
383	>	open($ref,">$tfile");
384	>	close($ref);
385		}
386	<	else
386	>	}
387	>	if ((!$samevalues) || (!-f $stampfile))
388	>	{
389	>	if (!-d $stampdir)
390		{
391	<	print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
615	<	print "         Not making any changes.","\n";
391	>	Utilities::AddDir::adddir($stampdir);
392		}
393	+	my $ref;
394	+	open($ref,">$stampfile");
395	+	close($ref);
396	+	if (!$samevalues){$self->dirty();}
397	+	}
398	+	}
399	+
400	+	sub comparetoolsdata ()
401	+	{
402	+	my $self=shift;
403	+	my $data1=shift || ();
404	+	my $data2=shift || ();
405	+
406	+	my $ref1=ref($data1);
407	+	my $ref2=ref($data2);
408	+
409	+	if ($ref1 ne $ref2)
410	+	{
411	+	return 0;
412	+	}
413	+	elsif ($ref1 eq "CODE")
414	+	{
415	+	return 1;
416	+	}
417	+	elsif(($ref1 eq "SCALAR") || ($ref1 eq ""))
418	+	{
419	+	if ($data1 eq $data2)
420	+	{
421	+	return 1;
422	+	}
423	+	return 0;
424	+	}
425	+	elsif ($ref1 eq "ARRAY")
426	+	{
427	+	my $count = scalar(@$data1);
428	+	if ($count != scalar(@$data2))
429	+	{
430	+	return 0;
431	+	}
432	+	for (my $i=0; $i<$count; $i++)
433	+	{
434	+	if (! $self->comparetoolsdata($data1->[$i],$data2->[$i]))
435	+	{
436	+	return 0;
437	+	}
438	+	}
439	+	return 1;
440		}
441		else
442		{
443	<	print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
443	>	foreach my $k (keys %{$data1})
444	>	{
445	>	if (! exists $data2->{$k})
446	>	{
447	>	return 0;
448	>	}
449	>	}
450	>	foreach my $k (keys %{$data2})
451	>	{
452	>	if (! exists $data1->{$k})
453	>	{
454	>	return 0;
455	>	}
456	>	}
457	>	foreach my $k (keys %{$data2})
458	>	{
459	>	if (! $self->comparetoolsdata($data1->{$k},$data2->{$k}))
460	>	{
461	>	return 0;
462	>	}
463	>	}
464	>	return 1;
465		}
466		}
467

Diff Legend

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