ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolManager.pm
Revision: 1.24
Committed: Tue Jun 12 15:54:23 2012 UTC (12 years, 10 months ago) by muzaffar
Content type: text/plain
Branch: MAIN
CVS Tags: V2_2_4_pre9, V2_2_4_pre8, V2_2_4_pre7
Changes since 1.23: +0 -38 lines
Log Message:
updated for new compiler support

File Contents

# User Rev Content
1 sashby 1.2 #____________________________________________________________________
2     # File: ToolManager.pm
3     #____________________________________________________________________
4     #
5     # Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6     # Copyright: 2003 (C) Shaun Ashby
7     #
8     #--------------------------------------------------------------------
9     package BuildSystem::ToolManager;
10     require 5.004;
11    
12     use Exporter;
13     use BuildSystem::ToolCache;
14     use BuildSystem::ToolParser;
15     use Utilities::AddDir;
16     use Utilities::Verbose;
17 muzaffar 1.19 use SCRAM::MsgLog;
18 sashby 1.2
19     @ISA=qw(BuildSystem::ToolCache Utilities::Verbose);
20     @EXPORT_OK=qw( );
21     #
22 sashby 1.9
23 sashby 1.2 sub new
24     {
25     my $proto=shift;
26     my $class=ref($proto) || $proto;
27     my $self=$class->SUPER::new(); # Inherit from ToolCache
28     bless $self,$class;
29 muzaffar 1.20 $self->init (shift);
30 sashby 1.2 return $self;
31     }
32    
33 muzaffar 1.20 sub init ()
34 sashby 1.2 {
35     my $self=shift;
36     my $projectarea=shift;
37     $self->{topdir}=$projectarea->location();
38     $self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir();
39 muzaffar 1.20 $self->{archstore}=$projectarea->archdir();
40 muzaffar 1.21 $self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools";
41 sashby 1.2 $self->name($projectarea->toolcachename());
42 muzaffar 1.20 $self->dirty();
43 sashby 1.2 }
44 muzaffar 1.20
45 sashby 1.2 sub setupalltools()
46     {
47     my $self = shift;
48 muzaffar 1.20 my @selected=();
49     my $tooldir=$self->{toolcache}."/selected";
50     foreach my $tool (@{&getfileslist($tooldir)})
51 sashby 1.2 {
52 muzaffar 1.20 if ($tool=~/^(.+)\.xml$/) {push @selected,$1;}
53 sashby 1.2 }
54 muzaffar 1.20 foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");}
55 muzaffar 1.19 scramlogmsg("\n");
56 sashby 1.2 }
57    
58     sub coresetup()
59     {
60     my $self=shift;
61 muzaffar 1.20 my ($toolfile) = @_;
62 sashby 1.2
63 muzaffar 1.20 my $toolparser = BuildSystem::ToolParser->new();
64     $toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
65     $toolparser->filetail('</doc>');
66     $toolparser->parse($toolfile);
67     my $toolname = $toolparser->toolname();
68     my $toolversion = $toolparser->toolversion();
69 muzaffar 1.19 scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,": ".$::normal,"\n");
70 sashby 1.2
71     # Next, set up the tool:
72 muzaffar 1.20 my $store = $toolparser->processrawtool();
73 sashby 1.8
74 sashby 1.16 # Store the ToolData object in the cache:
75 muzaffar 1.20 $self->storeincache($toolname,$store);
76     my $srcfile=Utilities::AddDir::fixpath($toolfile);
77     my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml");
78     use File::Copy;
79     if ($srcfile ne $desfile)
80     {
81     use File::Copy;
82     my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml");
83     if ($srcfile ne $desfile1)
84     {
85     copy($srcfile,$desfile1);
86 sashby 1.2 }
87 muzaffar 1.20 if (-e $desfile) { unlink($desfile);}
88     symlink("../available/${toolname}.xml",$desfile);
89 sashby 1.2 }
90 muzaffar 1.20 scramlogclean();
91 sashby 1.2 return $self;
92     }
93    
94     sub setupself()
95     {
96     my $self=shift;
97     # Process the file "Self" in local config directory. This is used to
98     # set all the paths/runtime settings for this project:
99 muzaffar 1.20 my $filename=$self->{configdir}."/Self.xml";
100 sashby 1.16
101 sashby 1.2 if ( -f $filename )
102     {
103 muzaffar 1.19 scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n");
104 sashby 1.2 # Self file exists so process it:
105     $selfparser = BuildSystem::ToolParser->new();
106 muzaffar 1.18 $selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">');
107     $selfparser->filehead ('</doc>');
108 muzaffar 1.20 $selfparser->parse($filename);
109 sashby 1.2
110     # Next, set up the tool:
111 muzaffar 1.20 $store = $selfparser->processrawtool();
112 muzaffar 1.19
113 sashby 1.2 # If we are in a developer area, also add RELEASETOP paths:
114     if (exists($ENV{RELEASETOP}))
115     {
116     print "\nAdding RELEASE area settings to self....OK","\n", if ($ENV{SCRAM_DEBUG});
117     $store->addreleasetoself();
118     }
119    
120     # Store the ToolData object in the cache:
121     $self->storeincache($selfparser->toolname(),$store);
122 muzaffar 1.19 scramlogmsg("\n");
123 sashby 1.2 }
124     else
125     {
126 muzaffar 1.19 scramlogdump();
127 muzaffar 1.23 print STDERR "\n";
128     print STDERR "SCRAM: No file config/Self.xml...nothing to do.";
129     print STDERR "\n";
130 sashby 1.2 return;
131     }
132     }
133    
134 muzaffar 1.20 sub update()
135 sashby 1.2 {
136 muzaffar 1.20 my $self=shift;
137     my $area=shift;
138     $self->init($area);
139     $self->setupself();
140     $self->dirty ()
141 sashby 1.2 }
142 muzaffar 1.20
143 sashby 1.2 sub storeincache()
144     {
145     my $self=shift;
146     my ($toolname,$dataobject)=@_;
147    
148     # Store ToolData object (for a set-up tool) in cache:
149     if (ref($dataobject) eq 'BuildSystem::ToolData')
150     {
151 sashby 1.16 $self->updatetooltimestamp($dataobject, $toolname);
152 muzaffar 1.20 delete $self->{SETUP}->{$toolname};
153 sashby 1.2 $self->{SETUP}->{$toolname} = $dataobject;
154     }
155     else
156     {
157     $::scram->scramerror("ToolManager: BuildSystem::ToolData object reference expected.")
158     }
159     }
160    
161     sub tools()
162     {
163     my $self = shift;
164     my @tools;
165    
166     map
167     {
168     if ($_ ne "self")
169     {
170     push(@tools, $_);
171     }
172     } keys %{$self->{SETUP}};
173    
174     # Return list of set-up tools:
175     return @tools;
176     }
177    
178     sub toolsdata()
179     {
180     my $self = shift;
181     my $tooldata = [];
182 muzaffar 1.20 $self->{internal}{donetools}={};
183     $self->{internal}{scram_tools}={};
184     foreach my $tool (sort keys %{$self->{SETUP}})
185 sashby 1.2 {
186 muzaffar 1.20 if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;}
187     elsif ($tool ne "self")
188 sashby 1.2 {
189 muzaffar 1.20 $self->_toolsdata($tool,$tooldata);
190     }
191     }
192     foreach my $tool (keys %{$self->{internal}{scram_tools}})
193     {
194     $self->_toolsdata_scram($tool,$tooldata);
195     }
196     delete $self->{internal}{donetools};
197     delete $self->{internal}{scram_tools};
198     my $data=[];
199     foreach my $d (@$tooldata)
200     {
201     if (ref($d) eq "ARRAY")
202     {
203     foreach my $t (@$d) {push @$data,$t;}
204     }
205     }
206     return $data;
207     }
208    
209     sub _toolsdata()
210     {
211     my $self = shift;
212     my $tool=shift;
213     my $data=shift || [];
214     my $order=-1;
215     if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
216     $self->{internal}{donetools}{$tool}=$order;
217     if (exists $self->{SETUP}{$tool})
218     {
219     if (exists $self->{SETUP}{$tool}{USE})
220     {
221     foreach my $use (@{$self->{SETUP}{$tool}{USE}})
222 sashby 1.2 {
223 muzaffar 1.20 my $o=$self->_toolsdata(lc($use),$data);
224     if ($o>$order){$order=$o;}
225 sashby 1.2 }
226     }
227 muzaffar 1.20 $order++;
228     if(!defined $data->[$order]){$data->[$order]=[];}
229     push @{$data->[$order]},$self->{SETUP}{$tool};
230     $self->{internal}{donetools}{$tool}=$order;
231 sashby 1.2 }
232 muzaffar 1.20 return $order;
233 sashby 1.2 }
234    
235 muzaffar 1.20 sub _toolsdata_scram()
236 sashby 1.2 {
237 muzaffar 1.20 my $self = shift;
238     my $tool=shift;
239     my $data=shift || [];
240     my $order=-1;
241     if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};}
242     $self->{internal}{donetools}{$tool}=$order;
243     if(!exists $self->{internal}{scram_tools}{$tool}){return $order;}
244     use Configuration::ConfigArea;
245     use Cache::CacheUtilities;
246     my $cache=uc($tool)."_BASE";
247     $cache=$self->{SETUP}{$tool}{$cache};
248     if (!-d $cache)
249     {
250 muzaffar 1.23 print STDERR "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n";
251 muzaffar 1.20 return $order;
252     }
253     my $area=Configuration::ConfigArea->new();
254     $area->location($cache);
255     my $cachefile=$area->toolcachename();
256     if (!-f $cachefile)
257     {
258 muzaffar 1.23 print STDERR "ERROR: Tools cache file for release area \"$cache\" is not available.\n";
259 muzaffar 1.20 return $order;
260     }
261     $cache=&Cache::CacheUtilities::read($cachefile);
262     my $tools=$cache->setup();
263     $order=scalar(@$data)-1;
264     foreach my $use (keys %$tools)
265     {
266     if ($tools->{$use}->scram_project() == 1)
267     {
268     my $o=$self->_toolsdata_scram($use,$data);
269     if ($o>$order){$order=$o;}
270     }
271     }
272     $order++;
273     if(!defined $data->[$order]){$data->[$order]=[];}
274     push @{$data->[$order]},$self->{SETUP}{$tool};
275     $self->{internal}{donetools}{$tool}=$order;
276     return $order;
277     }
278 sashby 1.2
279     sub checkifsetup()
280     {
281     my $self=shift;
282     my ($tool)=@_;
283     # Return the ToolData object if the tool has been set up:
284     (exists $self->{SETUP}->{$tool}) ? return ($self->{SETUP}->{$tool})
285     : return undef;
286     }
287    
288     sub remove_tool()
289     {
290     my $self=shift;
291     my ($toolname)=@_;
292 muzaffar 1.20 delete $self->{SETUP}{$toolname};
293     print "Deleting $toolname from cache.","\n";
294     $self->updatetooltimestamp (undef, $toolname);
295 sashby 1.2 $self->writecache();
296 muzaffar 1.20 my $file1=$self->{toolcache}."/selected/${toolname}.xml";
297     my $file2=$self->{toolcache}."/available/${toolname}.xml";
298     if ((!-f $file2) && (-f $file1))
299     {
300     use File::Copy;
301     copy ($file1,$file2);
302     }
303     unlink ($file1);
304 sashby 1.2 }
305    
306     sub scram_projects()
307     {
308     my $self=shift;
309     my $scram_projects={};
310    
311     foreach my $t ($self->tools())
312     {
313     # Get the ToolData object:
314     my $td=$self->{SETUP}->{$t};
315     $scram_projects->{$t}=$td->variable_data(uc($t)."_BASE"), if ($td->scram_project());
316     }
317    
318     return $scram_projects;
319     }
320    
321 sashby 1.16 sub updatetooltimestamp ()
322     {
323     my $self=shift;
324     my $obj=shift;
325     my $toolname=shift;
326     my $samevalues=0;
327 muzaffar 1.18 my $stampdir = $self->{archstore}."/timestamps";
328     my $stampfile="${stampdir}/${toolname}";
329 sashby 1.16 if (exists $self->{SETUP}->{$toolname})
330     {
331     $samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj);
332     }
333 muzaffar 1.20 if ($toolname ne "self")
334     {
335     my $instdir = $self->{archstore}."/InstalledTools";
336     my $tfile = "${instdir}/${toolname}";
337     if ((!defined $obj) && (-f $tfile)) {unlink $tfile;}
338     elsif ((defined $obj) && (!-f $tfile))
339     {
340     Utilities::AddDir::adddir($instdir);
341     my $ref;
342     open($ref,">$tfile");
343     close($ref);
344     }
345     }
346 muzaffar 1.18 if ((!$samevalues) || (!-f $stampfile))
347 sashby 1.16 {
348 muzaffar 1.18 if (!-d $stampdir)
349 sashby 1.16 {
350 muzaffar 1.20 Utilities::AddDir::adddir($stampdir);
351 sashby 1.16 }
352 muzaffar 1.20 my $ref;
353     open($ref,">$stampfile");
354     close($ref);
355     if (!$samevalues){$self->dirty();}
356 sashby 1.16 }
357     }
358    
359     sub comparetoolsdata ()
360     {
361     my $self=shift;
362     my $data1=shift || ();
363     my $data2=shift || ();
364    
365     my $ref1=ref($data1);
366     my $ref2=ref($data2);
367    
368     if ($ref1 ne $ref2)
369     {
370     return 0;
371     }
372     elsif ($ref1 eq "CODE")
373     {
374     return 1;
375     }
376     elsif(($ref1 eq "SCALAR") || ($ref1 eq ""))
377     {
378     if ($data1 eq $data2)
379     {
380     return 1;
381     }
382     return 0;
383     }
384     elsif ($ref1 eq "ARRAY")
385     {
386     my $count = scalar(@$data1);
387     if ($count != scalar(@$data2))
388     {
389     return 0;
390     }
391     for (my $i=0; $i<$count; $i++)
392     {
393     if (! $self->comparetoolsdata($data1->[$i],$data2->[$i]))
394     {
395     return 0;
396     }
397     }
398     return 1;
399     }
400     else
401     {
402     foreach my $k (keys %{$data1})
403     {
404     if (! exists $data2->{$k})
405     {
406     return 0;
407     }
408     }
409     foreach my $k (keys %{$data2})
410     {
411     if (! exists $data1->{$k})
412     {
413     return 0;
414     }
415     }
416     foreach my $k (keys %{$data2})
417     {
418     if (! $self->comparetoolsdata($data1->{$k},$data2->{$k}))
419     {
420     return 0;
421     }
422     }
423     return 1;
424     }
425     }
426    
427 sashby 1.2 1;