ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolManager.pm
Revision: 1.8
Committed: Wed Apr 13 16:45:36 2005 UTC (20 years, 1 month ago) by sashby
Content type: text/plain
Branch: MAIN
Changes since 1.7: +32 -1 lines
Log Message:
Start to add support for user interaction with compiler meta.

File Contents

# Content
1 #____________________________________________________________________
2 # File: ToolManager.pm
3 #____________________________________________________________________
4 #
5 # Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6 # Update: 2003-11-12 15:04:16+0100
7 # Revision: $Id: ToolManager.pm,v 1.7 2005/04/06 18:17:15 sashby Exp $
8 #
9 # Copyright: 2003 (C) Shaun Ashby
10 #
11 #--------------------------------------------------------------------
12 package BuildSystem::ToolManager;
13 require 5.004;
14
15 use Exporter;
16 use BuildSystem::ToolCache;
17 use BuildSystem::ToolParser;
18 use Utilities::AddDir;
19 use URL::URLhandler;
20 use Utilities::Verbose;
21
22 @ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
23 @EXPORT_OK=qw( );
24 #
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 ###############################################################
36 {
37 my $proto=shift;
38 my $class=ref($proto) || $proto;
39 my $self=$class->SUPER::new(); # Inherit from ToolCache
40 my $projectarea=shift;
41
42 bless $self,$class;
43
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
65 return $self;
66 }
67
68 sub clone()
69 {
70 my $self=shift;
71 my $projectarea=shift;
72
73 # Change cache settings to reflect the new location:
74 $self->{topdir}=$projectarea->location();
75
76 $self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
77 $self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools";
78 $self->{datastore}=$self->{topdir}."/.SCRAM";
79 $self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH};
80
81 # Change the cache name:
82 $self->name($projectarea->toolcachename());
83 $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);
98 }
99
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
108 sub setupalltools()
109 {
110 my $self = shift;
111 my ($arealocation,$setupopt) = @_;
112 my (@localtools);
113 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))
121 {
122 $selected = [ keys %{$sel} ];
123 }
124
125 # 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";
195 }
196
197 sub coresetup()
198 {
199 my $self=shift;
200 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;
209
210 map
211 {
212 if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;}
213 } $self->rawtools();
214
215 # Tool not known so we create a new ToolParser object and parse it:
216 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 }
224
225 # Next, set up the tool:
226 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
231 # Check to see if this tool is a compiler. If so, store it.
232 # Also store the language that this compiler supprots, and a
233 # compiler name (e.g. gcc323) which, in conjunction with a stem
234 # architecture name like slc3_ia32_, can be used to build a complete arch string:
235 if ($store->scram_compiler() == 1)
236 {
237 my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE");
238 my @compilername = $store->flags("SCRAM_COMPILER_NAME");
239 $self->scram_compiler($supported_language[0],$toolname,$compilername[0]);
240 }
241
242 # Store the ToolData object in the cache:
243 $self->storeincache($toolparser->toolname(),$store);
244 return $self;
245 }
246
247 sub toolsetup()
248 {
249 my $self=shift;
250 my ($arealocation, $toolname, $toolversion, $toolurl) = @_;
251 my ($urlcache, $url, $filename, $tfname);
252 my $toolfile;
253
254 $toolname =~ tr[A-Z][a-z];
255 $toolversion ||= $self->defaultversion($toolname);
256 $urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache
257
258 # Check for the downloaded tools cache:
259 if (defined($urlcache))
260 {
261 $self->{urlhandler}=URL::URLhandler->new($urlcache);
262 }
263
264 $url = $self->toolurls()->{$toolname};
265 $filename = $self->{toolfiledir}."/".$toolname;
266
267 # If .SCRAM/InstalledTools doesn't exist, create it:
268 if (! -d $self->{toolfiledir})
269 {
270 AddDir::adddir($self->{toolfiledir});
271 }
272
273 # First, check to see if there was a tool URL given. If so, we might need to read
274 # from http or from a file: type URL:
275 if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/))
276 {
277 # See what kind of URL (file:, http:, cvs:, svn:, .. ):
278 if ($proto eq 'file')
279 {
280 # If the tool url is a file and the file exists,
281 # copy it to .SCRAM/InstalledTools and set the
282 # filename accordingly:
283 if ( -f $urlv)
284 {
285 use File::Copy;
286 copy($urlv, $filename);
287 my $mode = 0644; chmod $mode, $filename;
288 $toolfile=$filename;
289 }
290 else
291 {
292 $::scram->scramerror("Unable to set up $toolname from URL $toolurl-- $urlv does not exist!");
293 }
294 }
295 elsif ($proto eq 'http')
296 {
297 print "SCRAM: downloading $toolname from $toolurl","\n";
298 # Download from WWW first:
299 use LWP::Simple qw(&getstore);
300 my $http_response_val = &getstore($toolurl, $filename);
301
302 # Check the HTTP status. If doc not found, exit:
303 if ($http_response_val != 200)
304 {
305 my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|);
306 $::scram->scramerror("Unable to set up $toolname: $doc not found on $server!");
307 }
308 else
309 {
310 $toolfile=$filename;
311 }
312 }
313 elsif ($proto eq 'cvs')
314 {
315 print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
316 print "[ not yet supported ]","\n";
317 exit(0);
318 }
319 elsif ($proto eq 'svn')
320 {
321 print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n";
322 print "[ not yet supported ]","\n";
323 exit(0);
324 }
325 else
326 {
327 $::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye.");
328 }
329 }
330 else
331 {
332 # Copy the downloaded tool file to InstalledTools directory:
333 if ( ! -f $filename )
334 {
335 # If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools.
336 # We signal an error and exit:
337 if ($url eq '')
338 {
339 $::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!");
340 }
341 else
342 {
343 # Otherwise, we try to download it:
344 $self->verbose("Attempting Download of $url");
345 # Get file from download cache:
346 ($url,$filename)=$self->{urlhandler}->get($url);
347 use File::Copy;
348 $tfname=$self->{toolfiledir}."/".$toolname;
349 copy($filename, $tfname);
350 my $mode = 0644; chmod $mode, $tfname;
351 $toolfile=$tfname;
352 }
353 }
354 else
355 {
356 # File already exists in the .SCRAM/InstallTools directory:
357 $toolfile=$filename;
358 }
359 }
360
361 # Run the core setup routine:
362 $self->coresetup($toolname, $toolversion, $toolfile);
363 return $self;
364 }
365
366 sub setupself()
367 {
368 my $self=shift;
369 my ($location)=@_;
370 # Process the file "Self" in local config directory. This is used to
371 # set all the paths/runtime settings for this project:
372 my $filename=$location."/config/Self";
373
374 if ( -f $filename )
375 {
376 print "\n";
377 print $::bold."Setting up SELF:".$::normal,"\n";
378 # Self file exists so process it:
379 $selfparser = BuildSystem::ToolParser->new();
380 $selfparser->parse('self','SELF',$filename);
381
382 # Next, set up the tool:
383 $store = $selfparser->processrawtool($self->interactive());
384
385 # If we are in a developer area, also add RELEASETOP paths:
386 if (exists($ENV{RELEASETOP}))
387 {
388 print "\nAdding RELEASE area settings to self....OK","\n", if ($ENV{SCRAM_DEBUG});
389 $store->addreleasetoself();
390 }
391
392 # Store the ToolData object in the cache:
393 $self->storeincache($selfparser->toolname(),$store);
394 print "\n";
395 }
396 else
397 {
398 print "\n";
399 print "SCRAM: No file config/Self...nothing to do.";
400 print "\n";
401 return;
402 }
403 }
404
405 sub defaultversion()
406 {
407 my $self = shift;
408 my ($tool) = @_;
409 # Return default versions as taken from configuration:
410 return (%{$self->defaultversions()}->{$tool});
411 }
412
413 sub storeincache()
414 {
415 my $self=shift;
416 my ($toolname,$dataobject)=@_;
417
418 # Store ToolData object (for a set-up tool) in cache:
419 if (ref($dataobject) eq 'BuildSystem::ToolData')
420 {
421 $self->{SETUP}->{$toolname} = $dataobject;
422 }
423 else
424 {
425 $::scram->scramerror("ToolManager: BuildSystem::ToolData object reference expected.")
426 }
427 }
428
429 sub tools()
430 {
431 my $self = shift;
432 my @tools;
433
434 map
435 {
436 if ($_ ne "self")
437 {
438 push(@tools, $_);
439 }
440 } keys %{$self->{SETUP}};
441
442 # Return list of set-up tools:
443 return @tools;
444 }
445
446 sub toolsdata()
447 {
448 my $self = shift;
449 my $tooldata = [];
450 my $rawsel = $self->selected();
451
452 foreach my $tool ( sort { %{$rawsel}->{$a}
453 <=> %{$rawsel}->{$b}}
454 keys %{$rawsel} )
455 {
456 # Return tool data objects of all set-up tools, skipping the tool "self":
457 if ($_ ne "self")
458 {
459 # Keep only tools that have really been set up:
460 if (exists $self->{SETUP}->{$tool})
461 {
462 push(@tooldata,$self->{SETUP}->{$tool});
463 }
464 }
465 }
466
467 # Return the array of tools, in order that they appear in RequirementsDoc:
468 return @tooldata;
469 }
470
471 sub definedtool()
472 {
473 my $self=shift;
474 my ($tool)=@_;
475
476 # Check to see if tool X is an external tool:
477 grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1
478 : return 0;
479 }
480
481 sub checkifsetup()
482 {
483 my $self=shift;
484 my ($tool)=@_;
485 # Return the ToolData object if the tool has been set up:
486 (exists $self->{SETUP}->{$tool}) ? return ($self->{SETUP}->{$tool})
487 : return undef;
488 }
489
490 sub cloned_tm()
491 {
492 my $self=shift;
493 # Has this area already been cloned and brought in-line with current location:
494 @_ ? $self->{CLONED} = $_[0]
495 : $self->{CLONED};
496 }
497
498 sub remove_tool()
499 {
500 my $self=shift;
501 my ($toolname)=@_;
502 my $tools = $self->{SETUP};
503 my $newtlist = {};
504
505 while (my ($tool, $tooldata) = each %$tools)
506 {
507 if ($tool ne $toolname)
508 {
509 $newtlist->{$tool} = $tooldata;
510 }
511 else
512 {
513 print "Deleting $toolname from cache.","\n";
514 }
515 }
516
517 $self->{SETUP} = $newtlist;
518
519 # Now remove from the RAW tool list:
520 $self->cleanup_raw($toolname);
521
522 print "ToolManager: Updating tool cache.","\n";
523 $self->writecache();
524 }
525
526 sub scram_projects()
527 {
528 my $self=shift;
529 my $scram_projects={};
530
531 foreach my $t ($self->tools())
532 {
533 # Get the ToolData object:
534 my $td=$self->{SETUP}->{$t};
535 $scram_projects->{$t}=$td->variable_data(uc($t)."_BASE"), if ($td->scram_project());
536 }
537
538 return $scram_projects;
539 }
540
541 sub scram_compiler()
542 {
543 my $self=shift;
544 my ($langtype, $toolname, $compilername)=@_;
545
546 if ($langtype)
547 {
548 # Store the compiler info according to supported
549 # language types.
550 #
551 # ---------------------- e.g C++ cxxcompiler gcc323
552 $self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ];
553 }
554 else
555 {
556 return $self->{SCRAM_COMPILER};
557 }
558 }
559
560 1;