| 22 |
|
@ISA=qw(BuildSystem::ToolCache Utilities::Verbose); |
| 23 |
|
@EXPORT_OK=qw( ); |
| 24 |
|
# |
| 25 |
< |
# |
| 25 |
> |
|
| 26 |
|
sub new |
| 27 |
|
############################################################### |
| 28 |
|
# 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()); |
| 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); |
| 163 |
> |
# Copy needed content from toolmanager for scram-managed project only |
| 164 |
> |
# if the projects have compatible configurations (compare first set of |
| 165 |
> |
# digits): |
| 166 |
> |
if ($self->check_compatibility($satoolmanager)) |
| 167 |
> |
{ |
| 168 |
> |
$self->inheritcontent($satoolmanager); |
| 169 |
> |
} |
| 170 |
|
} |
| 171 |
|
} |
| 172 |
|
} |
| 212 |
|
sub coresetup() |
| 213 |
|
{ |
| 214 |
|
my $self=shift; |
| 215 |
< |
my ($toolname, $toolversion, $toolfile) = @_; |
| 215 |
> |
my ($toolname, $toolversion, $toolfile, $force) = @_; |
| 216 |
|
my ($toolcheck, $toolparser); |
| 217 |
|
|
| 218 |
|
print "\n"; |
| 228 |
|
} $self->rawtools(); |
| 229 |
|
|
| 230 |
|
# Tool not known so we create a new ToolParser object and parse it: |
| 231 |
< |
if ($toolcheck != 1) |
| 231 |
> |
if ($toolcheck != 1 || $force == 1) |
| 232 |
|
{ |
| 233 |
|
$toolparser = BuildSystem::ToolParser->new(); |
| 234 |
|
# We only want to store the stuff relevant for one particular version: |
| 235 |
|
$toolparser->parse($toolname, $toolversion, $toolfile); |
| 236 |
|
# Store the ToolParser object in the cache: |
| 237 |
|
$self->store($toolparser); |
| 238 |
+ |
print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG}); |
| 239 |
|
} |
| 240 |
|
|
| 241 |
|
# Next, set up the tool: |
| 243 |
|
# Make sure that we have this tool in the list of selected tools (just in case this tool was |
| 244 |
|
# set up by hand afterwards): |
| 245 |
|
$self->addtoselected($toolname); |
| 246 |
< |
# Store the ToolData object in the cache: |
| 246 |
> |
|
| 247 |
> |
# Check to see if this tool is a compiler. If so, store it. |
| 248 |
> |
# Also store the language that this compiler supprots, and a |
| 249 |
> |
# compiler name (e.g. gcc323) which, in conjunction with a stem |
| 250 |
> |
# architecture name like slc3_ia32_, can be used to build a complete arch string: |
| 251 |
> |
if ($store->scram_compiler() == 1) |
| 252 |
> |
{ |
| 253 |
> |
my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE"); |
| 254 |
> |
my @compilername = $store->flags("SCRAM_COMPILER_NAME"); |
| 255 |
> |
$self->scram_compiler($supported_language[0],$toolname,$compilername[0]); |
| 256 |
> |
} |
| 257 |
> |
|
| 258 |
> |
# Store the ToolData object in the cache: |
| 259 |
|
$self->storeincache($toolparser->toolname(),$store); |
| 260 |
|
return $self; |
| 261 |
|
} |
| 266 |
|
my ($arealocation, $toolname, $toolversion, $toolurl) = @_; |
| 267 |
|
my ($urlcache, $url, $filename, $tfname); |
| 268 |
|
my $toolfile; |
| 269 |
+ |
my $force = 0; # we may have to force a reparse of a tool file |
| 270 |
|
|
| 271 |
|
$toolname =~ tr[A-Z][a-z]; |
| 272 |
|
$toolversion ||= $self->defaultversion($toolname); |
| 277 |
|
{ |
| 278 |
|
$self->{urlhandler}=URL::URLhandler->new($urlcache); |
| 279 |
|
} |
| 280 |
< |
|
| 280 |
> |
|
| 281 |
|
$url = $self->toolurls()->{$toolname}; |
| 282 |
|
$filename = $self->{toolfiledir}."/".$toolname; |
| 283 |
|
|
| 284 |
+ |
# If .SCRAM/InstalledTools doesn't exist, create it: |
| 285 |
+ |
if (! -d $self->{toolfiledir}) |
| 286 |
+ |
{ |
| 287 |
+ |
AddDir::adddir($self->{toolfiledir}); |
| 288 |
+ |
} |
| 289 |
+ |
|
| 290 |
|
# First, check to see if there was a tool URL given. If so, we might need to read |
| 291 |
|
# from http or from a file: type URL: |
| 292 |
|
if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/)) |
| 294 |
|
# See what kind of URL (file:, http:, cvs:, svn:, .. ): |
| 295 |
|
if ($proto eq 'file') |
| 296 |
|
{ |
| 297 |
+ |
# Check to see if there is a ~ and substitute the user |
| 298 |
+ |
# home directory if there is (file:~/xyz): |
| 299 |
+ |
if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|)) |
| 300 |
+ |
{ |
| 301 |
+ |
$urlv = $ENV{HOME}."/".$urlpath; |
| 302 |
+ |
} |
| 303 |
+ |
elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|)) |
| 304 |
+ |
{ |
| 305 |
+ |
# Relative to current directory (file:./xyz): |
| 306 |
+ |
use Cwd qw(&cwd); |
| 307 |
+ |
$urlv = cwd()."/".$urlpath; |
| 308 |
+ |
} |
| 309 |
+ |
|
| 310 |
|
# If the tool url is a file and the file exists, |
| 311 |
|
# copy it to .SCRAM/InstalledTools and set the |
| 312 |
|
# filename accordingly: |
| 314 |
|
{ |
| 315 |
|
use File::Copy; |
| 316 |
|
copy($urlv, $filename); |
| 317 |
+ |
my $mode = 0644; chmod $mode, $filename; |
| 318 |
|
$toolfile=$filename; |
| 319 |
+ |
# Here we must account for the fact that the file tool doc may be |
| 320 |
+ |
# a modified version of an existing tool in the current config. we |
| 321 |
+ |
# make sure that this file is reparsed, even if there is already a |
| 322 |
+ |
# ToolParser object for the tool: |
| 323 |
+ |
$force = 1; |
| 324 |
|
} |
| 325 |
|
else |
| 326 |
|
{ |
| 327 |
< |
$::scram->scramerror("Unable to set up $toolname from URL $toolurl-- $urlv does not exist!"); |
| 327 |
> |
$::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!"); |
| 328 |
|
} |
| 329 |
|
} |
| 330 |
|
elsif ($proto eq 'http') |
| 333 |
|
# Download from WWW first: |
| 334 |
|
use LWP::Simple qw(&getstore); |
| 335 |
|
my $http_response_val = &getstore($toolurl, $filename); |
| 336 |
< |
|
| 336 |
> |
|
| 337 |
|
# Check the HTTP status. If doc not found, exit: |
| 338 |
|
if ($http_response_val != 200) |
| 339 |
|
{ |
| 367 |
|
# Copy the downloaded tool file to InstalledTools directory: |
| 368 |
|
if ( ! -f $filename ) |
| 369 |
|
{ |
| 370 |
< |
$self->verbose("Attempting Download of $url"); |
| 371 |
< |
# Get file from download cache: |
| 372 |
< |
($url,$filename)=$self->{urlhandler}->get($url); |
| 373 |
< |
use File::Copy; |
| 374 |
< |
$tfname=$self->{toolfiledir}."/".$toolname; |
| 375 |
< |
copy($filename, $tfname); |
| 376 |
< |
$toolfile=$tfname; |
| 370 |
> |
# If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools. |
| 371 |
> |
# We signal an error and exit: |
| 372 |
> |
if ($url eq '') |
| 373 |
> |
{ |
| 374 |
> |
$::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!"); |
| 375 |
> |
} |
| 376 |
> |
else |
| 377 |
> |
{ |
| 378 |
> |
# Otherwise, we try to download it: |
| 379 |
> |
$self->verbose("Attempting Download of $url"); |
| 380 |
> |
# Get file from download cache: |
| 381 |
> |
($url,$filename)=$self->{urlhandler}->get($url); |
| 382 |
> |
use File::Copy; |
| 383 |
> |
$tfname=$self->{toolfiledir}."/".$toolname; |
| 384 |
> |
copy($filename, $tfname); |
| 385 |
> |
my $mode = 0644; chmod $mode, $tfname; |
| 386 |
> |
$toolfile=$tfname; |
| 387 |
> |
} |
| 388 |
|
} |
| 389 |
|
else |
| 390 |
|
{ |
| 394 |
|
} |
| 395 |
|
|
| 396 |
|
# Run the core setup routine: |
| 397 |
< |
$self->coresetup($toolname, $toolversion, $toolfile); |
| 397 |
> |
$self->coresetup($toolname, $toolversion, $toolfile,$force); |
| 398 |
|
return $self; |
| 399 |
|
} |
| 400 |
|
|
| 404 |
|
my ($location)=@_; |
| 405 |
|
# Process the file "Self" in local config directory. This is used to |
| 406 |
|
# set all the paths/runtime settings for this project: |
| 407 |
< |
my $filename=$location."/config/Self"; |
| 407 |
> |
my $filename=$location."/config/Self.xml"; |
| 408 |
|
|
| 409 |
|
if ( -f $filename ) |
| 410 |
|
{ |
| 431 |
|
else |
| 432 |
|
{ |
| 433 |
|
print "\n"; |
| 434 |
< |
print "SCRAM: No file config/Self...nothing to do."; |
| 434 |
> |
print "SCRAM: No file config/Self.xml...nothing to do."; |
| 435 |
|
print "\n"; |
| 436 |
|
return; |
| 437 |
|
} |
| 453 |
|
# Store ToolData object (for a set-up tool) in cache: |
| 454 |
|
if (ref($dataobject) eq 'BuildSystem::ToolData') |
| 455 |
|
{ |
| 456 |
+ |
$self->updatetooltimestamp($dataobject, $toolname); |
| 457 |
|
$self->{SETUP}->{$toolname} = $dataobject; |
| 458 |
|
} |
| 459 |
|
else |
| 546 |
|
} |
| 547 |
|
else |
| 548 |
|
{ |
| 549 |
< |
print "Deleting $toolname from cache.","\n"; |
| 549 |
> |
# Is this tool a compiler? |
| 550 |
> |
if ($tooldata->scram_compiler() == 1) |
| 551 |
> |
{ |
| 552 |
> |
# Also remove this from the compiler info if there happens to be an entry: |
| 553 |
> |
while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}}) |
| 554 |
> |
{ |
| 555 |
> |
if ($toolname eq $ctool->[0]) |
| 556 |
> |
{ |
| 557 |
> |
delete $self->{SCRAM_COMPILER}->{$langtype}; |
| 558 |
> |
print "Deleting compiler $toolname from cache.","\n"; |
| 559 |
> |
} |
| 560 |
> |
} |
| 561 |
> |
} |
| 562 |
> |
else |
| 563 |
> |
{ |
| 564 |
> |
print "Deleting $toolname from cache.","\n"; |
| 565 |
> |
} |
| 566 |
|
} |
| 567 |
|
} |
| 568 |
|
|
| 569 |
|
$self->{SETUP} = $newtlist; |
| 570 |
< |
|
| 570 |
> |
$self->updatetooltimestamp ("", $toolname); |
| 571 |
|
# Now remove from the RAW tool list: |
| 572 |
|
$self->cleanup_raw($toolname); |
| 491 |
– |
|
| 573 |
|
print "ToolManager: Updating tool cache.","\n"; |
| 574 |
|
$self->writecache(); |
| 575 |
|
} |
| 589 |
|
return $scram_projects; |
| 590 |
|
} |
| 591 |
|
|
| 592 |
+ |
sub scram_compiler() |
| 593 |
+ |
{ |
| 594 |
+ |
my $self=shift; |
| 595 |
+ |
my ($langtype, $toolname, $compilername)=@_; |
| 596 |
+ |
|
| 597 |
+ |
if ($langtype) |
| 598 |
+ |
{ |
| 599 |
+ |
# Store the compiler info according to supported |
| 600 |
+ |
# language types. |
| 601 |
+ |
# |
| 602 |
+ |
# ---------------------- e.g C++ cxxcompiler gcc323 |
| 603 |
+ |
$self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ]; |
| 604 |
+ |
} |
| 605 |
+ |
else |
| 606 |
+ |
{ |
| 607 |
+ |
return $self->{SCRAM_COMPILER}; |
| 608 |
+ |
} |
| 609 |
+ |
} |
| 610 |
+ |
|
| 611 |
+ |
sub updatetool() |
| 612 |
+ |
{ |
| 613 |
+ |
my $self=shift; |
| 614 |
+ |
my ($name, $obj) = @_; |
| 615 |
+ |
|
| 616 |
+ |
# Replace the existing copy of the tool with the new one: |
| 617 |
+ |
if (exists $self->{SETUP}->{$name}) |
| 618 |
+ |
{ |
| 619 |
+ |
# Check to make sure that we were really passed a compiler with |
| 620 |
+ |
# the desired name: |
| 621 |
+ |
if ($obj->toolname() eq $name) |
| 622 |
+ |
{ |
| 623 |
+ |
$self->updatetooltimestamp ($obj, $name); |
| 624 |
+ |
print "ToolManager: Updating the cached copy of ".$name."\n"; |
| 625 |
+ |
delete $self->{SETUP}->{$name}; |
| 626 |
+ |
$self->{SETUP}->{$name} = $obj; |
| 627 |
+ |
$self->writecache(); |
| 628 |
+ |
} |
| 629 |
+ |
else |
| 630 |
+ |
{ |
| 631 |
+ |
print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n"; |
| 632 |
+ |
print " Not making any changes.","\n"; |
| 633 |
+ |
} |
| 634 |
+ |
} |
| 635 |
+ |
else |
| 636 |
+ |
{ |
| 637 |
+ |
print "WARNING: No entry in cache for ".$name.". Not making any updates.\n"; |
| 638 |
+ |
} |
| 639 |
+ |
} |
| 640 |
+ |
|
| 641 |
+ |
sub check_compatibility() |
| 642 |
+ |
{ |
| 643 |
+ |
my $self=shift; |
| 644 |
+ |
my ($itoolmgr)=@_; |
| 645 |
+ |
# Get the version of the toolmanager. If the project fails to return a version |
| 646 |
+ |
# string we return 0 for no compatibility (in which case, all tools will be set |
| 647 |
+ |
# up in the traditional way): |
| 648 |
+ |
my $itm_configversion = $itoolmgr->configversion(); |
| 649 |
+ |
if ($itm_configversion) |
| 650 |
+ |
{ |
| 651 |
+ |
# The configurations won't be identical. We must compare the digits: |
| 652 |
+ |
my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/); |
| 653 |
+ |
my $current_configversion = $self->configversion(); |
| 654 |
+ |
my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/); |
| 655 |
+ |
($current_numeric_version == $numeric_version) && return 1; # OK, compatible; |
| 656 |
+ |
} |
| 657 |
+ |
# Project does not define configuration version so just return: |
| 658 |
+ |
return 0; |
| 659 |
+ |
} |
| 660 |
+ |
|
| 661 |
+ |
sub configversion() |
| 662 |
+ |
{ |
| 663 |
+ |
my $self=shift; |
| 664 |
+ |
@_ ? $self->{CONFIGVERSION} = shift |
| 665 |
+ |
: $self->{CONFIGVERSION}; |
| 666 |
+ |
} |
| 667 |
+ |
|
| 668 |
+ |
sub updatetooltimestamp () |
| 669 |
+ |
{ |
| 670 |
+ |
my $self=shift; |
| 671 |
+ |
my $obj=shift; |
| 672 |
+ |
my $toolname=shift; |
| 673 |
+ |
my $samevalues=0; |
| 674 |
+ |
if (exists $self->{SETUP}->{$toolname}) |
| 675 |
+ |
{ |
| 676 |
+ |
$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj); |
| 677 |
+ |
} |
| 678 |
+ |
if (!$samevalues) |
| 679 |
+ |
{ |
| 680 |
+ |
if (!-d $self->{tooltimestamp}) |
| 681 |
+ |
{ |
| 682 |
+ |
AddDir::adddir($self->{tooltimestamp}); |
| 683 |
+ |
} |
| 684 |
+ |
open(TIMESTAMPFILE,">".$self->{tooltimestamp}."/$toolname"); |
| 685 |
+ |
close(TIMESTAMPFILE); |
| 686 |
+ |
} |
| 687 |
+ |
} |
| 688 |
+ |
|
| 689 |
+ |
sub comparetoolsdata () |
| 690 |
+ |
{ |
| 691 |
+ |
my $self=shift; |
| 692 |
+ |
my $data1=shift || (); |
| 693 |
+ |
my $data2=shift || (); |
| 694 |
+ |
|
| 695 |
+ |
my $ref1=ref($data1); |
| 696 |
+ |
my $ref2=ref($data2); |
| 697 |
+ |
|
| 698 |
+ |
if ($ref1 ne $ref2) |
| 699 |
+ |
{ |
| 700 |
+ |
return 0; |
| 701 |
+ |
} |
| 702 |
+ |
elsif ($ref1 eq "CODE") |
| 703 |
+ |
{ |
| 704 |
+ |
return 1; |
| 705 |
+ |
} |
| 706 |
+ |
elsif(($ref1 eq "SCALAR") || ($ref1 eq "")) |
| 707 |
+ |
{ |
| 708 |
+ |
if ($data1 eq $data2) |
| 709 |
+ |
{ |
| 710 |
+ |
return 1; |
| 711 |
+ |
} |
| 712 |
+ |
return 0; |
| 713 |
+ |
} |
| 714 |
+ |
elsif ($ref1 eq "ARRAY") |
| 715 |
+ |
{ |
| 716 |
+ |
my $count = scalar(@$data1); |
| 717 |
+ |
if ($count != scalar(@$data2)) |
| 718 |
+ |
{ |
| 719 |
+ |
return 0; |
| 720 |
+ |
} |
| 721 |
+ |
for (my $i=0; $i<$count; $i++) |
| 722 |
+ |
{ |
| 723 |
+ |
if (! $self->comparetoolsdata($data1->[$i],$data2->[$i])) |
| 724 |
+ |
{ |
| 725 |
+ |
return 0; |
| 726 |
+ |
} |
| 727 |
+ |
} |
| 728 |
+ |
return 1; |
| 729 |
+ |
} |
| 730 |
+ |
else |
| 731 |
+ |
{ |
| 732 |
+ |
foreach my $k (keys %{$data1}) |
| 733 |
+ |
{ |
| 734 |
+ |
if (! exists $data2->{$k}) |
| 735 |
+ |
{ |
| 736 |
+ |
return 0; |
| 737 |
+ |
} |
| 738 |
+ |
} |
| 739 |
+ |
foreach my $k (keys %{$data2}) |
| 740 |
+ |
{ |
| 741 |
+ |
if (! exists $data1->{$k}) |
| 742 |
+ |
{ |
| 743 |
+ |
return 0; |
| 744 |
+ |
} |
| 745 |
+ |
} |
| 746 |
+ |
foreach my $k (keys %{$data2}) |
| 747 |
+ |
{ |
| 748 |
+ |
if (! $self->comparetoolsdata($data1->{$k},$data2->{$k})) |
| 749 |
+ |
{ |
| 750 |
+ |
return 0; |
| 751 |
+ |
} |
| 752 |
+ |
} |
| 753 |
+ |
return 1; |
| 754 |
+ |
} |
| 755 |
+ |
} |
| 756 |
+ |
|
| 757 |
|
1; |
