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.2 by sashby, Fri Dec 10 13:41:37 2004 UTC vs.
Revision 1.20 by muzaffar, Fri Jan 14 17:36: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 < #
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/".$projectarea->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);
45 >   $self->dirty();
46     }
47 <
100 < sub interactive()
101 <   {
102 <   my $self=shift;
103 <   # Interactive mode on/off:
104 <   @_ ? $self->{interactive} = shift
105 <      : ((defined $self->{interactive}) ? $self->{interactive} : 0);
106 <   }
107 <
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))
51 >   my @selected=();
52 >   my $tooldir=$self->{toolcache}."/selected";
53 >   foreach my $tool (@{&getfileslist($tooldir)})
54        {
55 <      $selected = [ keys %{$sel} ];
55 >      if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
56        }
57 <  
58 <   # 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
186 <      {
187 <      # Just loop over all tools and setup again:
188 <      foreach my $localtool (@{$selected})
189 <         {
190 <         $self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool));  
191 <         }
192 <      }
193 <  
194 <   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) = @_;
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;
64 >   my ($toolfile) = @_;
65    
66 <   map
67 <      {
68 <      if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
69 <      } $self->rawtools();
70 <  
71 <   # Tool not known so we create a new ToolParser object and parse it:
72 <   if ($toolcheck != 1)
217 <      {
218 <      $toolparser = BuildSystem::ToolParser->new();
219 <      # We only want to store the stuff relevant for one particular version:
220 <      $toolparser->parse($toolname, $toolversion, $toolfile);
221 <      # Store the ToolParser object in the cache:
222 <      $self->store($toolparser);
223 <      }
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());
227 <   # Make sure that we have this tool in the list of selected tools (just in case this tool was
228 <   # set up by hand afterwards):
229 <   $self->addtoselected($toolname);
230 <   # Store the ToolData object in the cache:
231 <   $self->storeincache($toolparser->toolname(),$store);
232 <   return $self;
233 <   }
75 >   my $store = $toolparser->processrawtool();
76  
77 < sub toolsetup()
78 <   {
79 <   my $self=shift;
80 <   my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
81 <   my ($urlcache, $url, $filename, $tfname);
82 <   my $toolfile;
83 <  
84 <   $toolname =~ tr[A-Z][a-z];
85 <   $toolversion ||= $self->defaultversion($toolname);
86 <   $urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
87 <  
88 <   # Check for the downloaded tools cache:
89 <   if (defined($urlcache))
90 <      {
91 <      $self->{urlhandler}=URL::URLhandler->new($urlcache);
92 <      }
93 <  
94 <   $url = $self->toolurls()->{$toolname};
95 <   $filename = $self->{toolfiledir}."/".$toolname;
96 <  
97 <   # First, check to see if there was a tool URL given. If so, we might need to read
98 <   # from http or from a file: type URL:
99 <   if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
258 <      {      
259 <      # See what kind of URL (file:, http:, cvs:, svn:, .. ):
260 <      if ($proto eq 'file')
261 <         {
262 <         # If the tool url is a file and the file exists,
263 <         # copy it to .SCRAM/InstalledTools and set the
264 <         # filename accordingly:
265 <         if ( -f $urlv)
266 <            {
267 <            use File::Copy;
268 <            copy($urlv, $filename);
269 <            $toolfile=$filename;
270 <            }
271 <         else
272 <            {
273 <            $::scram->scramerror("Unable to set up $toolname from URL $toolurl-- $urlv does not exist!");                  
274 <            }
275 <         }
276 <      elsif ($proto eq 'http')
277 <         {
278 <         print "SCRAM: downloading $toolname from $toolurl","\n";
279 <         # Download from WWW first:
280 <         use LWP::Simple qw(&getstore);
281 <         my $http_response_val = &getstore($toolurl, $filename);
282 <
283 <         # Check the HTTP status. If doc not found, exit:
284 <         if ($http_response_val != 200)
285 <            {
286 <            my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|);        
287 <            $::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
288 <            }
289 <         else
290 <            {
291 <            $toolfile=$filename;
292 <            }
293 <         }
294 <      elsif ($proto eq 'cvs')
295 <         {
296 <         print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
297 <         print "[ not yet supported ]","\n";
298 <         exit(0);
299 <         }
300 <      elsif ($proto eq 'svn')
301 <         {
302 <         print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
303 <         print "[ not yet supported ]","\n";
304 <         exit(0);
305 <         }
306 <      else
307 <         {
308 <         $::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
309 <         }
310 <      }
311 <   else
312 <      {
313 <      # Copy the downloaded tool file to InstalledTools directory:
314 <      if ( ! -f $filename )
315 <         {
316 <         $self->verbose("Attempting Download of $url");
317 <         # Get file from download cache:
318 <         ($url,$filename)=$self->{urlhandler}->get($url);
319 <         use File::Copy;
320 <         $tfname=$self->{toolfiledir}."/".$toolname;
321 <         copy($filename, $tfname);
322 <         $toolfile=$tfname;
323 <         }
324 <      else
325 <         {
326 <         # File already exists in the .SCRAM/InstallTools directory:
327 <         $toolfile=$filename;
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
79 >   # compiler name (e.g. gcc323) which, in conjunction with a stem
80 >   # architecture name like slc3_ia32_, can be used to build a complete arch string:
81 >   if ($store->scram_compiler() == 1)
82 >      {
83 >      my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
84 >      my @compilername = $store->flags("SCRAM_COMPILER_NAME");
85 >      $self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
86 >      }
87 >  
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 <  
331 <   # Run the core setup routine:
332 <   $self->coresetup($toolname, $toolversion, $toolfile);
104 >   scramlogclean();
105     return $self;
106     }
107  
108   sub setupself()
109     {
110     my $self=shift;
339   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";
347 <      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 361 | 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 388 | 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 417 | 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}
423 <                             <=> %{$rawsel}->{$b}}
424 <                      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 <  
437 <   # Return the array of tools, in order that they appear in RequirementsDoc:
438 <   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 457 | Line 299 | sub checkifsetup()
299        : return undef;
300     }
301  
460 sub cloned_tm()
461   {
462   my $self=shift;
463   # Has this area already been cloned and brought in-line with current location:
464   @_ ? $self->{CLONED} = $_[0]
465      : $self->{CLONED};
466   }
467
302   sub remove_tool()
303     {
304     my $self=shift;
305     my ($toolname)=@_;
306 <   my $tools = $self->{SETUP};
307 <   my $newtlist = {};
474 <  
475 <   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;
480 <         }
481 <      else
482 <         {
483 <         print "Deleting $toolname from cache.","\n";
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 <
489 <   # Now remove from the RAW tool list:
490 <   $self->cleanup_raw($toolname);
491 <  
492 <   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 508 | Line 340 | sub scram_projects()
340     return $scram_projects;
341     }
342  
343 + sub scram_compiler()
344 +   {
345 +   my $self=shift;
346 +   my ($langtype, $toolname, $compilername)=@_;
347 +
348 +   if ($langtype)
349 +      {
350 +      # Store the compiler info according to supported
351 +      # language types.
352 +      #
353 +      # ---------------------- e.g C++      cxxcompiler    gcc323
354 +      $self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
355 +      }
356 +   else
357 +      {
358 +      return $self->{SCRAM_COMPILER};
359 +      }
360 +   }
361 +
362 + sub updatetooltimestamp ()
363 +   {
364 +   my $self=shift;
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 +      $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 +      }
387 +   if ((!$samevalues) || (!-f $stampfile))
388 +      {
389 +      if (!-d $stampdir)
390 +         {
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 +      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 +
468   1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines