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.18 by muzaffar, Tue Nov 6 14:13:49 2007 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 <   $self->{tooltimestamp}="timestamps";
52 <  
53 <   # Make sure our tool download dir exists:
54 <   AddDir::adddir($self->{toolfiledir});
55 <   AddDir::adddir($self->{archstore});
56 <  
57 <   # Set the tool cache file to read/write:
58 <   $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        }
65  
66   return $self;
61     }
62  
63 < sub clone()
63 > sub init ()
64     {
65     my $self=shift;
66     my $projectarea=shift;
73
74   # Change cache settings to reflect the new location:
67     $self->{topdir}=$projectarea->location();
76
68     $self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
69 <   $self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
70 <   $self->{datastore}=$self->{topdir}."/.SCRAM";
80 <   $self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
81 <
82 <   # 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 <  
86 <   return $self;
87 <   }
88 <
89 < sub arch_change_after_copy()
90 <   {
91 <   my $self=shift;
92 <   my ($newarch, $cachename)=@_;
93 <   # Make changes to arch-specific settings when copying tool manager
94 <   # object to another arch during setup:
95 <   $self->{arch} = $newarch;
96 <   $self->{archstore} = $self->{topdir}."/.SCRAM/".$newarch;
97 <   # Change the name of the cache to reflect new (arch-specific) location:
98 <   $self->name($cachename);
72 >   $self->initpathvars();
73 >   $self->dirty();
74     }
75 <
101 < sub interactive()
102 <   {
103 <   my $self=shift;
104 <   # Interactive mode on/off:
105 <   @_ ? $self->{interactive} = shift
106 <      : ((defined $self->{interactive}) ? $self->{interactive} : 0);
107 <   }
108 <
75 >  
76   sub setupalltools()
77     {
78     my $self = shift;
79 <   my ($arealocation,$setupopt) = @_;
80 <   my (@localtools);
81 <   my $selected;
115 <  
116 <   # Get the selected tool list. Handle the case where there might not be
117 <   # any selected tools: //FIXME: need to handle case where there are no
118 <   # selected tools (not very often but a possibility):
119 <   my $sel = $self->selected();
120 <  
121 <   if (defined ($sel))
122 <      {
123 <      $selected = [ keys %{$sel} ];
124 <      }
125 <  
126 <   # Setup option "setupopt" directs the setup: 1 is for booting from
127 <   # scratch, 0 is when just doing "scram setup" (in this case we don't
128 <   # want to pick up everything from any scram-managed projects):
129 <   if ($setupopt == 1) # We're booting from scratch
130 <      {
131 <      # Look for a match in the scram db:
132 <      foreach my $S (@$selected)
133 <         {
134 <            # Store other tools in ReqDoc in separate array. We will set up these tools later:
135 <            push(@localtools,$S);
136 <         }
137 <      
138 <      # Set up extra tools required in this project, in addition to
139 <      # any scram-managed projects
140 <      foreach my $localtool (@localtools)
141 <         {
142 <         # First check to see if it's already set up (i.e., was contained
143 <         # in list of requirements for scram project):
144 <         if (! $self->definedtool($localtool))
145 <            {
146 <            $self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));
147 <            $self->addtoselected($localtool);
148 <            }
149 <         else
150 <            {
151 <            print $localtool," already set up.","\n",if ($ENV{SCRAM_DEBUG});
152 <            }
153 <         }
154 <      }
155 <   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:
158 <      foreach my $localtool (@{$selected})
159 <         {
160 <         $self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));  
161 <         }
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) = @_;
171 <   my ($toolcheck, $toolparser);
172 <  
173 <   print "\n";
174 <   print $::bold."Setting up ",$toolname," version ",$toolversion,":  ".$::normal,"\n";
175 <  
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 <  
198 <   # Next, set up the tool:
199 <   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 <   }
219 <
220 < sub toolsetup()
221 <   {
222 <   my $self=shift;
223 <   my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
224 <   my ($urlcache, $url, $filename, $tfname);
225 <   my $toolfile;
226 <   my $force = 0; # we may have to force a reparse of a tool file
92 >   my ($toolfile) = @_;
93    
94 <   $toolname =~ tr[A-Z][a-z];
95 <   $toolversion ||= $self->defaultversion($toolname);
96 <   $urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
97 <  
98 <   # Check for the downloaded tools cache:
233 <   if (defined($urlcache))
234 <      {
235 <      $self->{urlhandler}=URL::URLhandler->new($urlcache);
236 <      }
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 <   $url = $self->toolurls()->{$toolname};
101 <   $filename = $self->{toolfiledir}."/".$toolname;
102 <  
103 <   # If .SCRAM/InstalledTools doesn't exist, create it:
104 <   if (! -d $self->{toolfiledir})
105 <      {
106 <      AddDir::adddir($self->{toolfiledir});
107 <      }
108 <  
109 <   # First, check to see if there was a tool URL given. If so, we might need to read
110 <   # from http or from a file: type URL:
111 <   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;
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 <  
353 <   # Run the core setup routine:
354 <   $self->coresetup($toolname, $toolversion, $toolfile,$force);
116 >   scramlogclean();
117     return $self;
118     }
119  
120   sub setupself()
121     {
122     my $self=shift;
361   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.xml";
125 >   my $filename=$self->{configdir}."/Self.xml";
126  
127     if ( -f $filename )
128        {
129 <      print "\n";
369 <      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->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
373 <      $selfparser->filehead ('</doc>');
374 <      $selfparser->parse('self','SELF',$filename);
375 <
376 <      # Next, set up the tool:
377 <      $store = $selfparser->processrawtool($self->interactive());
378 <      
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 385 | 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.xml...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 413 | Line 169 | sub storeincache()
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 442 | 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}
448 <                             <=> %{$rawsel}->{$b}}
449 <                      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 <  
462 <   # Return the array of tools, in order that they appear in RequirementsDoc:
463 <   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 482 | Line 315 | sub checkifsetup()
315        : return undef;
316     }
317  
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
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 <         {
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 <         }
330 >      use File::Copy;
331 >      copy ($file1,$file2);
332        }
333 <  
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();
333 >   unlink ($file1);
334     }
335  
336   sub scram_projects()
# Line 548 | Line 348 | sub scram_projects()
348     return $scram_projects;
349     }
350  
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
351   sub updatetooltimestamp ()
352     {
353     my $self=shift;
# Line 636 | Line 360 | sub updatetooltimestamp ()
360        {
361        $samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
362        }
363 +   if ($toolname ne "self")
364 +      {
365 +      my $instdir = $self->{archstore}."/InstalledTools";
366 +      my $tfile = "${instdir}/${toolname}";
367 +      if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
368 +      elsif ((defined $obj) && (!-f $tfile))
369 +         {
370 +         Utilities::AddDir::adddir($instdir);
371 +         my $ref;
372 +         open($ref,">$tfile");
373 +         close($ref);
374 +         }
375 +      }
376     if ((!$samevalues) || (!-f $stampfile))
377        {
378        if (!-d $stampdir)
379           {
380 <         AddDir::adddir($stampdir);
380 >         Utilities::AddDir::adddir($stampdir);
381           }
382 <      open(TIMESTAMPFILE,">$stampfile");
383 <      close(TIMESTAMPFILE);
382 >      my $ref;
383 >      open($ref,">$stampfile");
384 >      close($ref);
385 >      if (!$samevalues){$self->dirty();}
386        }
387     }
388  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines