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.5 by sashby, Wed Feb 2 20:16:45 2005 UTC vs.
Revision 1.17 by sashby, Thu Mar 29 12:43:52 2007 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 48 | Line 48 | sub new
48     $self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
49     $self->{datastore}=$self->{topdir}."/.SCRAM";
50     $self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
51 +
52 +   if (exists $ENV{SCRAM_TOOL_TIMESTAMP_DIR})
53 +      {
54 +      $self->{tooltimestamp}=$ENV{SCRAM_TOOL_TIMESTAMP_DIR};
55 +      }
56 +   else
57 +      {
58 +      $self->{tooltimestamp}=$self->{archstore}."/timestamps";
59 +      }
60    
61     # Make sure our tool download dir exists:
62     AddDir::adddir($self->{toolfiledir});
63     AddDir::adddir($self->{archstore});
64 +   AddDir::adddir($self->{tooltimestamp});
65    
66     # Set the tool cache file to read/write:
67     $self->name($projectarea->toolcachename());
# Line 131 | Line 141 | sub setupalltools()
141        my $scramprojects = $::scram->_loadscramdb();
142        
143        # Look for a match in the scram db:
144 <      foreach my $S (@$selected)
145 <         {
146 <         if (exists ($scramprojects->{$S}))
147 <            {
148 <            # Now check the version required exists in
149 <            # list of scram projects with this name:
150 <            while (my ($pdata,$plocation) = each %{$scramprojects->{$S}})
151 <               {
152 <               # Split the $pdata string to get the real name and the version:
153 <               my ($pname,$pversion) = split(":",$pdata);
154 <               if ($pversion eq $self->defaultversion($S))
155 <                  {
156 <                  # Get the tool manager for the scram project:
157 <                  my $sa=$::scram->scramfunctions()->scramprojectdb()->getarea($pname,$pversion);
158 <                  # Load the tool cache:
159 <                  if ( -r $sa->toolcachename())
160 <                     {
161 <                     use Cache::CacheUtilities;
162 <                     my $satoolmanager=&Cache::CacheUtilities::read($sa->toolcachename());
163 <                     # Copy needed content from toolmanager for scram-managed project:
164 <                     $self->inheritcontent($satoolmanager);
165 <                     }
144 >      foreach my $S (@$selected) {
145 >          if (exists ($scramprojects->{$S})) {
146 >              # Check for environment SCRAM_INHERIT_COMPAT_CONFIG:
147 >              if (exists($ENV{SCRAM_INHERIT_COMPAT_CONFIG})) {
148 >                  # Now check the version required exists in
149 >                  # list of scram projects with this name:
150 >                  while (my ($pdata,$plocation) = each %{$scramprojects->{$S}}) {
151 >                      # Split the $pdata string to get the real name and the version:
152 >                      my ($pname,$pversion) = split(":",$pdata);
153 >                      if ($pversion eq $self->defaultversion($S)) {
154 >                          # Get the tool manager for the scram project:
155 >                          my $sa=$::scram->scramfunctions()->scramprojectdb()->getarea($pname,$pversion);
156 >                          # Load the tool cache:
157 >                          if ( -r $sa->toolcachename()) {
158 >                              use Cache::CacheUtilities;
159 >                              my $satoolmanager=&Cache::CacheUtilities::read($sa->toolcachename());
160 >                              # Copy needed content from toolmanager for scram-managed project only
161 >                              # if the projects have compatible configurations (compare first set of
162 >                              # digits):
163 >                              if ($self->check_compatibility($satoolmanager)) {
164 >                                  $self->inheritcontent($satoolmanager);
165 >                              }
166 >                          }
167 >                      }
168                    }
169 <               }
170 <            # Also add this scram-managed project to list of tools to set up:
171 <            push(@localtools,$S);
172 <            }
173 <         else
174 <            {
175 <            # Store other tools in ReqDoc in separate array. We will set up these tools later:
176 <            push(@localtools,$S);
165 <            }
166 <         }
169 >              }
170 >              # Also add this scram-managed project to list of tools to set up:
171 >              push(@localtools,$S);
172 >          } else {
173 >              # Store other tools in ReqDoc in separate array. We will set up these tools later:
174 >              push(@localtools,$S);
175 >          }
176 >      }
177        
178        # Set up extra tools required in this project, in addition to
179        # any scram-managed projects
# 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 <   # Store the ToolData object in the cache:
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;
256     }
# Line 238 | Line 261 | sub toolsetup()
261     my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
262     my ($urlcache, $url, $filename, $tfname);
263     my $toolfile;
264 <
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);
268     $urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
269 <
269 >  
270     # Check for the downloaded tools cache:
271     if (defined($urlcache))
272        {
273        $self->{urlhandler}=URL::URLhandler->new($urlcache);
274        }
275 <  
275 >
276     $url = $self->toolurls()->{$toolname};
277     $filename = $self->{toolfiledir}."/".$toolname;
278    
# Line 265 | 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 274 | Line 311 | sub toolsetup()
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 286 | 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 320 | 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 <         my $mode = 0644; chmod $mode, $tfname;
372 <         $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 337 | 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 347 | Line 399 | sub setupself()
399     my ($location)=@_;
400     # Process the file "Self" in local config directory. This is used to
401     # set all the paths/runtime settings for this project:
402 <   my $filename=$location."/config/Self";
402 >   my $filename=$location."/config/Self.xml";
403  
404     if ( -f $filename )
405        {
# Line 374 | Line 426 | sub setupself()
426     else
427        {
428        print "\n";
429 <      print "SCRAM: No file config/Self...nothing to do.";
429 >      print "SCRAM: No file config/Self.xml...nothing to do.";
430        print "\n";
431        return;
432        }
# Line 396 | Line 448 | sub storeincache()
448     # Store ToolData object (for a set-up tool) in cache:
449     if (ref($dataobject) eq 'BuildSystem::ToolData')
450        {
451 +      $self->updatetooltimestamp($dataobject, $toolname);
452        $self->{SETUP}->{$toolname} = $dataobject;
453        }
454     else
# Line 488 | Line 541 | sub remove_tool()
541           }
542        else
543           {
544 <         print "Deleting $toolname from cache.","\n";
544 >         # Is this tool a compiler?
545 >         if ($tooldata->scram_compiler() == 1)
546 >            {
547 >            # Also remove this from the compiler info if there happens to be an entry:
548 >            while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}})
549 >               {
550 >               if ($toolname eq $ctool->[0])
551 >                  {
552 >                  delete $self->{SCRAM_COMPILER}->{$langtype};
553 >                  print "Deleting compiler $toolname from cache.","\n";
554 >                  }
555 >               }
556 >            }
557 >         else
558 >            {
559 >            print "Deleting $toolname from cache.","\n";
560 >            }
561           }
562        }
563    
564     $self->{SETUP} = $newtlist;
565 <
565 >   $self->updatetooltimestamp ("", $toolname);
566     # Now remove from the RAW tool list:
567     $self->cleanup_raw($toolname);
499  
568     print "ToolManager: Updating tool cache.","\n";
569     $self->writecache();
570     }
# Line 516 | Line 584 | sub scram_projects()
584     return $scram_projects;
585     }
586  
587 + sub scram_compiler()
588 +   {
589 +   my $self=shift;
590 +   my ($langtype, $toolname, $compilername)=@_;
591 +
592 +   if ($langtype)
593 +      {
594 +      # Store the compiler info according to supported
595 +      # language types.
596 +      #
597 +      # ---------------------- e.g C++      cxxcompiler    gcc323
598 +      $self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
599 +      }
600 +   else
601 +      {
602 +      return $self->{SCRAM_COMPILER};
603 +      }
604 +   }
605 +
606 + sub updatetool()
607 +   {
608 +   my $self=shift;
609 +   my ($name, $obj) = @_;
610 +
611 +   # Replace the existing copy of the tool with the new one:
612 +   if (exists $self->{SETUP}->{$name})
613 +      {
614 +      # Check to make sure that we were really passed a compiler with
615 +      # the desired name:
616 +      if ($obj->toolname() eq $name)
617 +         {
618 +         $self->updatetooltimestamp ($obj, $name);
619 +         print "ToolManager: Updating the cached copy of ".$name."\n";
620 +         delete $self->{SETUP}->{$name};
621 +         $self->{SETUP}->{$name} = $obj;
622 +         $self->writecache();
623 +         }
624 +      else
625 +         {
626 +         print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n";
627 +         print "         Not making any changes.","\n";
628 +         }
629 +      }
630 +   else
631 +      {
632 +      print "WARNING: No entry in cache for ".$name.". Not making any updates.\n";
633 +      }
634 +   }
635 +
636 + sub check_compatibility()
637 +   {
638 +   my $self=shift;
639 +   my ($itoolmgr)=@_;
640 +   # Get the version of the toolmanager. If the project fails to return a version
641 +   # string we return 0 for no compatibility (in which case, all tools will be set
642 +   # up in the traditional way):
643 +   my $itm_configversion = $itoolmgr->configversion();
644 +   if ($itm_configversion)
645 +      {
646 +      # The configurations won't be identical. We must compare the digits:
647 +      my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
648 +      my $current_configversion = $self->configversion();
649 +      my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/);
650 +      ($current_numeric_version == $numeric_version) && return 1; # OK, compatible;
651 +      }
652 +   # Project does not define configuration version so just return:
653 +   return 0;
654 +   }
655 +
656 + sub configversion()
657 +   {
658 +   my $self=shift;
659 +   @_ ? $self->{CONFIGVERSION} = shift
660 +      : $self->{CONFIGVERSION};
661 +   }
662 +
663 + sub updatetooltimestamp ()
664 +   {
665 +   my $self=shift;
666 +   my $obj=shift;
667 +   my $toolname=shift;
668 +   my $samevalues=0;
669 +   if (exists $self->{SETUP}->{$toolname})
670 +      {
671 +      $samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
672 +      }
673 +   if (!$samevalues)
674 +      {
675 +      if (!-d $self->{tooltimestamp})
676 +         {
677 +         AddDir::adddir($self->{tooltimestamp});
678 +         }
679 +      open(TIMESTAMPFILE,">".$self->{tooltimestamp}."/$toolname");
680 +      close(TIMESTAMPFILE);
681 +      }
682 +   }
683 +
684 + sub comparetoolsdata ()
685 +   {
686 +   my $self=shift;
687 +   my $data1=shift || ();
688 +   my $data2=shift || ();
689 +  
690 +   my $ref1=ref($data1);
691 +   my $ref2=ref($data2);
692 +  
693 +   if ($ref1 ne $ref2)
694 +      {
695 +      return 0;
696 +      }
697 +   elsif ($ref1 eq "CODE")
698 +      {
699 +      return 1;
700 +      }
701 +   elsif(($ref1 eq "SCALAR") || ($ref1 eq ""))
702 +      {
703 +      if ($data1 eq $data2)
704 +         {
705 +         return 1;
706 +         }
707 +      return 0;
708 +      }
709 +   elsif ($ref1 eq "ARRAY")
710 +      {
711 +      my $count = scalar(@$data1);
712 +      if ($count != scalar(@$data2))
713 +         {
714 +         return 0;
715 +         }
716 +      for (my $i=0; $i<$count; $i++)
717 +          {
718 +          if (! $self->comparetoolsdata($data1->[$i],$data2->[$i]))
719 +             {
720 +             return 0;
721 +             }
722 +          }
723 +      return 1;
724 +      }
725 +   else
726 +      {
727 +      foreach my $k (keys %{$data1})
728 +         {
729 +         if (! exists $data2->{$k})
730 +            {
731 +            return 0;
732 +            }
733 +         }
734 +      foreach my $k (keys %{$data2})
735 +         {
736 +         if (! exists $data1->{$k})
737 +            {
738 +            return 0;
739 +            }
740 +         }
741 +      foreach my $k (keys %{$data2})
742 +         {
743 +         if (! $self->comparetoolsdata($data1->{$k},$data2->{$k}))
744 +            {
745 +            return 0;
746 +            }
747 +         }
748 +      return 1;
749 +      }
750 +   }
751 +
752   1;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines