ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolManager.pm
(Generate patch)

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.22 by muzaffar, Tue Oct 18 14:59:27 2011 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))
123 <      {
124 <      $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
48 >   my @selected=();
49 >   my $tooldir=$self->{toolcache}."/selected";
50 >   foreach my $tool (@{&getfileslist($tooldir)})
51        {
52 <      # 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);
72 >   my $store = $toolparser->processrawtool();
73  
74     # Check to see if this tool is a compiler. If so, store it.
75     # Also store the language that this compiler supprots, and a
# Line 213 | Line 83 | sub coresetup()
83        }
84    
85     # Store the ToolData object in the cache:  
86 <   $self->storeincache($toolparser->toolname(),$store);
87 <   return $self;
88 <   }
89 <
90 < sub toolsetup()
91 <   {
92 <   my $self=shift;
93 <   my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
94 <   my ($urlcache, $url, $filename, $tfname);
95 <   my $toolfile;
96 <   my $force = 0; # we may have to force a reparse of a tool file
227 <  
228 <   $toolname =~ tr[A-Z][a-z];
229 <   $toolversion ||= $self->defaultversion($toolname);
230 <   $urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
231 <  
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.");
86 >   $self->storeincache($toolname,$store);
87 >   my $srcfile=Utilities::AddDir::fixpath($toolfile);
88 >   my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml");
89 >   use File::Copy;
90 >   if ($srcfile ne $desfile)
91 >      {
92 >      use File::Copy;
93 >      my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml");
94 >      if ($srcfile ne $desfile1)
95 >         {
96 >         copy($srcfile,$desfile1);
97           }
98 +      if (-e $desfile) { unlink($desfile);}
99 +      symlink("../available/${toolname}.xml",$desfile);
100        }
101 <   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;
350 <         }
351 <      }
352 <  
353 <   # Run the core setup routine:
354 <   $self->coresetup($toolname, $toolversion, $toolfile,$force);
101 >   scramlogclean();
102     return $self;
103     }
104  
105   sub setupself()
106     {
107     my $self=shift;
361   my ($location)=@_;
108     # Process the file "Self" in local config directory. This is used to
109     # set all the paths/runtime settings for this project:
110 <   my $filename=$location."/config/Self.xml";
110 >   my $filename=$self->{configdir}."/Self.xml";
111  
112     if ( -f $filename )
113        {
# Line 370 | Line 116 | sub setupself()
116        $selfparser = BuildSystem::ToolParser->new();
117        $selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
118        $selfparser->filehead ('</doc>');
119 <      $selfparser->parse('self','SELF',$filename);
119 >      $selfparser->parse($filename);
120  
121        # Next, set up the tool:
122 <      $store = $selfparser->processrawtool($self->interactive());
122 >      $store = $selfparser->processrawtool();
123  
124        # If we are in a developer area, also add RELEASETOP paths:
125        if (exists($ENV{RELEASETOP}))
# Line 396 | Line 142 | sub setupself()
142        }
143     }
144  
145 < sub defaultversion()
145 > sub update()
146     {
147 <   my $self = shift;
148 <   my ($tool) = @_;
149 <   # Return default versions as taken from configuration:
150 <   return (%{$self->defaultversions()}->{$tool});
147 >   my $self=shift;
148 >   my $area=shift;
149 >   $self->init($area);
150 >   $self->setupself();
151 >   $self->dirty ()
152     }
153 <
153 >  
154   sub storeincache()
155     {
156     my $self=shift;
# Line 413 | Line 160 | sub storeincache()
160     if (ref($dataobject) eq 'BuildSystem::ToolData')
161        {
162        $self->updatetooltimestamp($dataobject, $toolname);
163 +      delete $self->{SETUP}->{$toolname};
164        $self->{SETUP}->{$toolname} = $dataobject;
165        }
166     else
# Line 442 | Line 190 | sub toolsdata()
190     {
191     my $self = shift;
192     my $tooldata = [];
193 <   my $rawsel = $self->selected();
194 <  
195 <   foreach my $tool ( sort { %{$rawsel}->{$a}
448 <                             <=> %{$rawsel}->{$b}}
449 <                      keys %{$rawsel} )
193 >   $self->{internal}{donetools}={};
194 >   $self->{internal}{scram_tools}={};
195 >   foreach my $tool (sort keys %{$self->{SETUP}})
196        {
197 <      # Return tool data objects of all set-up tools, skipping the tool "self":
198 <      if ($_ ne "self")
197 >      if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
198 >      elsif ($tool ne "self")
199           {
200 <         # Keep only tools that have really been set up:
201 <         if (exists $self->{SETUP}->{$tool})
200 >         $self->_toolsdata($tool,$tooldata);
201 >         }
202 >      }
203 >   foreach my $tool (keys %{$self->{internal}{scram_tools}})
204 >      {
205 >      $self->_toolsdata_scram($tool,$tooldata);
206 >      }
207 >   delete $self->{internal}{donetools};
208 >   delete $self->{internal}{scram_tools};
209 >   my $data=[];
210 >   foreach my $d (@$tooldata)
211 >      {
212 >      if (ref($d) eq "ARRAY")
213 >         {
214 >         foreach my $t (@$d) {push @$data,$t;}
215 >         }
216 >      }
217 >   return $data;
218 >   }
219 >
220 > sub _toolsdata()
221 >   {
222 >   my $self = shift;
223 >   my $tool=shift;
224 >   my $data=shift || [];
225 >   my $order=-1;
226 >   if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
227 >   $self->{internal}{donetools}{$tool}=$order;
228 >   if (exists $self->{SETUP}{$tool})
229 >      {
230 >      if (exists $self->{SETUP}{$tool}{USE})
231 >         {
232 >         foreach my $use (@{$self->{SETUP}{$tool}{USE}})
233              {
234 <            push(@tooldata,$self->{SETUP}->{$tool});
234 >            my $o=$self->_toolsdata(lc($use),$data);
235 >            if ($o>$order){$order=$o;}
236              }
237           }
238 +      $order++;
239 +      if(!defined $data->[$order]){$data->[$order]=[];}
240 +      push @{$data->[$order]},$self->{SETUP}{$tool};
241 +      $self->{internal}{donetools}{$tool}=$order;
242        }
243 <  
462 <   # Return the array of tools, in order that they appear in RequirementsDoc:
463 <   return @tooldata;
243 >   return $order;
244     }
245  
246 < sub definedtool()
246 > sub _toolsdata_scram()
247     {
248 <   my $self=shift;
249 <   my ($tool)=@_;
250 <  
251 <   # Check to see if tool X is an external tool:
252 <   grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
253 <      : return 0;
248 >   my $self = shift;
249 >   my $tool=shift;
250 >   my $data=shift || [];
251 >   my $order=-1;
252 >   if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
253 >   $self->{internal}{donetools}{$tool}=$order;
254 >   if(!exists $self->{internal}{scram_tools}{$tool}){return $order;}
255 >   use Configuration::ConfigArea;
256 >   use Cache::CacheUtilities;
257 >   my $cache=uc($tool)."_BASE";
258 >   $cache=$self->{SETUP}{$tool}{$cache};
259 >   if (!-d $cache)
260 >      {
261 >      print "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
262 >      return $order;
263 >      }
264 >   my $area=Configuration::ConfigArea->new();
265 >   $area->location($cache);
266 >   my $cachefile=$area->toolcachename();
267 >   if (!-f $cachefile)
268 >      {
269 >      print "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
270 >      return $order;
271 >      }
272 >   $cache=&Cache::CacheUtilities::read($cachefile);
273 >   my $tools=$cache->setup();
274 >   $order=scalar(@$data)-1;
275 >   foreach my $use (keys %$tools)
276 >      {
277 >      if ($tools->{$use}->scram_project() == 1)
278 >         {
279 >         my $o=$self->_toolsdata_scram($use,$data);
280 >         if ($o>$order){$order=$o;}
281 >         }
282 >      }
283 >   $order++;
284 >   if(!defined $data->[$order]){$data->[$order]=[];}
285 >   push @{$data->[$order]},$self->{SETUP}{$tool};
286 >   $self->{internal}{donetools}{$tool}=$order;
287 >   return $order;
288     }
289 <
289 >  
290   sub checkifsetup()
291     {
292     my $self=shift;
# Line 482 | Line 296 | sub checkifsetup()
296        : return undef;
297     }
298  
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
299   sub remove_tool()
300     {
301     my $self=shift;
302     my ($toolname)=@_;
303 <   my $tools = $self->{SETUP};
304 <   my $newtlist = {};
499 <  
500 <   while (my ($tool, $tooldata) = each %$tools)
303 >   my $tool = $self->{SETUP}{$toolname};
304 >   if ($tool->scram_compiler() == 1)
305        {
306 <      if ($tool ne $toolname)
307 <         {
308 <         $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 <            }
306 >      while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
307 >         {
308 >         if ($toolname eq $ctool->[0]){delete $self->{SCRAM_COMPILER}->{$langtype};}
309           }
310        }
311 <  
312 <   $self->{SETUP} = $newtlist;
313 <   $self->updatetooltimestamp ("", $toolname);
530 <   # Now remove from the RAW tool list:
531 <   $self->cleanup_raw($toolname);
532 <   print "ToolManager: Updating tool cache.","\n";
311 >   delete $self->{SETUP}{$toolname};
312 >   print "Deleting $toolname from cache.","\n";
313 >   $self->updatetooltimestamp (undef, $toolname);
314     $self->writecache();
315 +   my $file1=$self->{toolcache}."/selected/${toolname}.xml";
316 +   my $file2=$self->{toolcache}."/available/${toolname}.xml";
317 +   if ((!-f $file2) && (-f $file1))
318 +      {
319 +      use File::Copy;
320 +      copy ($file1,$file2);
321 +      }
322 +   unlink ($file1);
323     }
324  
325   sub scram_projects()
# Line 567 | Line 356 | sub scram_compiler()
356        }
357     }
358  
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
359   sub updatetooltimestamp ()
360     {
361     my $self=shift;
# Line 636 | Line 368 | sub updatetooltimestamp ()
368        {
369        $samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
370        }
371 +   if ($toolname ne "self")
372 +      {
373 +      my $instdir = $self->{archstore}."/InstalledTools";
374 +      my $tfile = "${instdir}/${toolname}";
375 +      if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
376 +      elsif ((defined $obj) && (!-f $tfile))
377 +         {
378 +         Utilities::AddDir::adddir($instdir);
379 +         my $ref;
380 +         open($ref,">$tfile");
381 +         close($ref);
382 +         }
383 +      }
384     if ((!$samevalues) || (!-f $stampfile))
385        {
386        if (!-d $stampdir)
387           {
388 <         AddDir::adddir($stampdir);
388 >         Utilities::AddDir::adddir($stampdir);
389           }
390 <      open(TIMESTAMPFILE,">$stampfile");
391 <      close(TIMESTAMPFILE);
390 >      my $ref;
391 >      open($ref,">$stampfile");
392 >      close($ref);
393 >      if (!$samevalues){$self->dirty();}
394        }
395     }
396  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines