22 |
|
@ISA=qw(BuildSystem::ToolCache Utilities::Verbose); |
23 |
|
@EXPORT_OK=qw( ); |
24 |
|
# |
25 |
< |
# |
25 |
> |
|
26 |
|
sub new |
27 |
|
############################################################### |
28 |
|
# new # |
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 |
|
} |
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"; |
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: |
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; |
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); |
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 =~ /(.*):(.*)/)) |
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: |
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') |
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 |
|
{ |
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 |
|
{ |
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 |
|
|
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 |
|
} |
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; |