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.3 by sashby, Wed Feb 2 17:41:41 2005 UTC vs.
Revision 1.14 by sashby, Wed May 17 12:21:57 2006 UTC

# Line 22 | Line 22 | use Utilities::Verbose;
22   @ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
23   @EXPORT_OK=qw( );
24   #
25 < #
25 >
26   sub new
27     ###############################################################
28     # new                                                         #
# Line 150 | Line 150 | sub setupalltools()
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);
153 >                     # Copy needed content from toolmanager for scram-managed project only
154 >                     # if the projects have compatible configurations (compare first set of
155 >                     # digits):
156 >                     if ($self->check_compatibility($satoolmanager))
157 >                        {
158 >                        print "DEBUG: $pname and current project have compatible configurations.\n";
159 >                        $self->inheritcontent($satoolmanager);
160 >                        }
161 >                     else
162 >                        {                      
163 >                        print "DEBUG: $pname and current project do NOT have compatible configurations. Skipping...\n";
164 >                        }
165                       }
166                    }
167                 }
# Line 197 | Line 207 | sub setupalltools()
207   sub coresetup()
208     {
209     my $self=shift;
210 <   my ($toolname, $toolversion, $toolfile) = @_;
210 >   my ($toolname, $toolversion, $toolfile, $force) = @_;
211     my ($toolcheck, $toolparser);
212    
213     print "\n";
# Line 213 | Line 223 | sub coresetup()
223        } $self->rawtools();
224    
225     # Tool not known so we create a new ToolParser object and parse it:
226 <   if ($toolcheck != 1)
226 >   if ($toolcheck != 1 || $force == 1)
227        {
228        $toolparser = BuildSystem::ToolParser->new();
229        # We only want to store the stuff relevant for one particular version:
230        $toolparser->parse($toolname, $toolversion, $toolfile);
231        # Store the ToolParser object in the cache:
232        $self->store($toolparser);
233 +      print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG});
234        }
235    
236     # Next, set up the tool:
# Line 227 | Line 238 | sub coresetup()
238     # Make sure that we have this tool in the list of selected tools (just in case this tool was
239     # set up by hand afterwards):
240     $self->addtoselected($toolname);
241 +
242 +   # Check to see if this tool is a compiler. If so, store it.
243 +   # Also store the language that this compiler supprots, and a
244 +   # compiler name (e.g. gcc323) which, in conjunction with a stem
245 +   # architecture name like slc3_ia32_, can be used to build a complete arch string:
246 +   if ($store->scram_compiler() == 1)
247 +      {
248 +      my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
249 +      my @compilername = $store->flags("SCRAM_COMPILER_NAME");
250 +      $self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
251 +      }
252 +  
253     # Store the ToolData object in the cache:
254     $self->storeincache($toolparser->toolname(),$store);
255     return $self;
# Line 238 | Line 261 | sub toolsetup()
261     my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
262     my ($urlcache, $url, $filename, $tfname);
263     my $toolfile;
264 +   my $force = 0; # we may have to force a reparse of a tool file
265    
266     $toolname =~ tr[A-Z][a-z];
267     $toolversion ||= $self->defaultversion($toolname);
# Line 248 | Line 272 | sub toolsetup()
272        {
273        $self->{urlhandler}=URL::URLhandler->new($urlcache);
274        }
275 <  
275 >
276     $url = $self->toolurls()->{$toolname};
277     $filename = $self->{toolfiledir}."/".$toolname;
278    
279 +   # If .SCRAM/InstalledTools doesn't exist, create it:
280 +   if (! -d $self->{toolfiledir})
281 +      {
282 +      AddDir::adddir($self->{toolfiledir});
283 +      }
284 +  
285     # First, check to see if there was a tool URL given. If so, we might need to read
286     # from http or from a file: type URL:
287     if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
# Line 259 | Line 289 | sub toolsetup()
289        # See what kind of URL (file:, http:, cvs:, svn:, .. ):
290        if ($proto eq 'file')
291           {
292 +         # Check to see if there is a ~ and substitute the user
293 +         # home directory if there is (file:~/xyz):      
294 +         if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|))
295 +            {
296 +            $urlv = $ENV{HOME}."/".$urlpath;
297 +            }
298 +         elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|))
299 +            {
300 +            # Relative to current directory (file:./xyz):
301 +            use Cwd qw(&cwd);
302 +            $urlv = cwd()."/".$urlpath;
303 +            }
304 +        
305           # If the tool url is a file and the file exists,
306           # copy it to .SCRAM/InstalledTools and set the
307           # filename accordingly:
# Line 266 | Line 309 | sub toolsetup()
309              {
310              use File::Copy;
311              copy($urlv, $filename);
312 +            my $mode = 0644; chmod $mode, $filename;
313              $toolfile=$filename;
314 +            # Here we must account for the fact that the file tool doc may be
315 +            # a modified version of an existing tool in the current config. we
316 +            # make sure that this file is reparsed, even if there is already a
317 +            # ToolParser object for the tool:
318 +            $force = 1;
319              }
320           else
321              {
322 <            $::scram->scramerror("Unable to set up $toolname from URL $toolurl-- $urlv does not exist!");                  
322 >            $::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!");              
323              }
324           }
325        elsif ($proto eq 'http')
# Line 279 | Line 328 | sub toolsetup()
328           # Download from WWW first:
329           use LWP::Simple qw(&getstore);
330           my $http_response_val = &getstore($toolurl, $filename);
331 <
331 >        
332           # Check the HTTP status. If doc not found, exit:
333           if ($http_response_val != 200)
334              {
# Line 313 | Line 362 | sub toolsetup()
362        # Copy the downloaded tool file to InstalledTools directory:
363        if ( ! -f $filename )
364           {
365 <         $self->verbose("Attempting Download of $url");
366 <         # Get file from download cache:
367 <         ($url,$filename)=$self->{urlhandler}->get($url);
368 <         use File::Copy;
369 <         $tfname=$self->{toolfiledir}."/".$toolname;
370 <         copy($filename, $tfname);
371 <         $toolfile=$tfname;
365 >         # If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
366 >         # We signal an error and exit:
367 >         if ($url eq '')
368 >            {
369 >            $::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
370 >            }
371 >         else
372 >            {
373 >            # Otherwise, we try to download it:
374 >            $self->verbose("Attempting Download of $url");
375 >            # Get file from download cache:
376 >            ($url,$filename)=$self->{urlhandler}->get($url);                
377 >            use File::Copy;
378 >            $tfname=$self->{toolfiledir}."/".$toolname;  
379 >            copy($filename, $tfname);
380 >            my $mode = 0644; chmod $mode, $tfname;
381 >            $toolfile=$tfname;
382 >            }
383           }
384        else
385           {
# Line 329 | Line 389 | sub toolsetup()
389        }
390    
391     # Run the core setup routine:
392 <   $self->coresetup($toolname, $toolversion, $toolfile);
392 >   $self->coresetup($toolname, $toolversion, $toolfile,$force);
393     return $self;
394     }
395  
# Line 480 | Line 540 | sub remove_tool()
540           }
541        else
542           {
543 <         print "Deleting $toolname from cache.","\n";
543 >         # Is this tool a compiler?
544 >         if ($tooldata->scram_compiler() == 1)
545 >            {
546 >            # Also remove this from the compiler info if there happens to be an entry:
547 >            while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
548 >               {
549 >               if ($toolname eq $ctool->[0])
550 >                  {
551 >                  delete $self->{SCRAM_COMPILER}->{$langtype};
552 >                  print "Deleting compiler $toolname from cache.","\n";
553 >                  }
554 >               }
555 >            }
556 >         else
557 >            {
558 >            print "Deleting $toolname from cache.","\n";
559 >            }
560           }
561        }
562    
563     $self->{SETUP} = $newtlist;
564 <
564 >  
565     # Now remove from the RAW tool list:
566     $self->cleanup_raw($toolname);
491  
567     print "ToolManager: Updating tool cache.","\n";
568     $self->writecache();
569     }
# Line 508 | Line 583 | sub scram_projects()
583     return $scram_projects;
584     }
585  
586 + sub scram_compiler()
587 +   {
588 +   my $self=shift;
589 +   my ($langtype, $toolname, $compilername)=@_;
590 +
591 +   if ($langtype)
592 +      {
593 +      # Store the compiler info according to supported
594 +      # language types.
595 +      #
596 +      # ---------------------- e.g C++      cxxcompiler    gcc323
597 +      $self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
598 +      }
599 +   else
600 +      {
601 +      return $self->{SCRAM_COMPILER};
602 +      }
603 +   }
604 +
605 + sub updatetool()
606 +   {
607 +   my $self=shift;
608 +   my ($name, $obj) = @_;
609 +
610 +   # Replace the existing copy of the tool with the new one:
611 +   if (exists $self->{SETUP}->{$name})
612 +      {
613 +      # Check to make sure that we were really passed a compiler with
614 +      # the desired name:
615 +      if ($obj->toolname() eq $name)
616 +         {
617 +         print "ToolManager: Updating the cached copy of ".$name."\n";
618 +         delete $self->{SETUP}->{$name};
619 +         $self->{SETUP}->{$name} = $obj;
620 +         $self->writecache();
621 +         }
622 +      else
623 +         {
624 +         print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
625 +         print "         Not making any changes.","\n";
626 +         }
627 +      }
628 +   else
629 +      {
630 +      print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
631 +      }
632 +   }
633 +
634 + sub check_compatibility()
635 +   {
636 +   my $self=shift;
637 +   my ($itoolmgr)=@_;
638 +   # Get the version of the toolmanager. If the project fails to return a version
639 +   # string we return 0 for no compatibility (in which case, all tools will be set
640 +   # up in the traditional way):
641 +   my $itm_configversion = $itoolmgr->configversion();
642 +   if ($itm_configversion)
643 +      {
644 +      # The configurations won't be identical. We must compare the digits:
645 +      my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
646 +      my $current_configversion = $self->configversion();
647 +      my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
648 +      ($current_numeric_version == $numeric_version) && return 1; # OK, compatible;
649 +      }
650 +   # Project does not define configuration version so just return:
651 +   return 0;
652 +   }
653 +
654 + sub configversion()
655 +   {
656 +   my $self=shift;
657 +   @_ ? $self->{CONFIGVERSION} = shift
658 +      : $self->{CONFIGVERSION};
659 +   }
660 +
661   1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines