16 |
|
use BuildSystem::ToolCache; |
17 |
|
use BuildSystem::ToolParser; |
18 |
|
use Utilities::AddDir; |
19 |
– |
use URL::URLhandler; |
19 |
|
use Utilities::Verbose; |
20 |
+ |
use SCRAM::MsgLog; |
21 |
|
|
22 |
|
@ISA=qw(BuildSystem::ToolCache Utilities::Verbose); |
23 |
|
@EXPORT_OK=qw( ); |
24 |
|
# |
25 |
< |
# |
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 |
– |
############################################################### |
27 |
|
{ |
28 |
|
my $proto=shift; |
29 |
|
my $class=ref($proto) || $proto; |
30 |
|
my $self=$class->SUPER::new(); # Inherit from ToolCache |
40 |
– |
my $projectarea=shift; |
41 |
– |
|
31 |
|
bless $self,$class; |
32 |
< |
|
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 |
< |
|
32 |
> |
$self->init (shift); |
33 |
|
return $self; |
34 |
|
} |
35 |
|
|
36 |
< |
sub clone() |
36 |
> |
sub init () |
37 |
|
{ |
38 |
|
my $self=shift; |
39 |
|
my $projectarea=shift; |
72 |
– |
|
73 |
– |
# Change cache settings to reflect the new location: |
40 |
|
$self->{topdir}=$projectarea->location(); |
75 |
– |
|
41 |
|
$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir(); |
42 |
< |
$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools"; |
43 |
< |
$self->{datastore}=$self->{topdir}."/.SCRAM"; |
79 |
< |
$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH}; |
80 |
< |
|
81 |
< |
# Change the cache name: |
42 |
> |
$self->{archstore}=$projectarea->archdir(); |
43 |
> |
$self->{toolcache}=$self->{configdir}."/toolbox/".$projectarea->arch()."/tools"; |
44 |
|
$self->name($projectarea->toolcachename()); |
45 |
< |
$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); |
45 |
> |
$self->dirty(); |
46 |
|
} |
47 |
< |
|
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 |
< |
|
47 |
> |
|
48 |
|
sub setupalltools() |
49 |
|
{ |
50 |
|
my $self = shift; |
51 |
< |
my ($arealocation,$setupopt) = @_; |
52 |
< |
my (@localtools); |
53 |
< |
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)) |
51 |
> |
my @selected=(); |
52 |
> |
my $tooldir=$self->{toolcache}."/selected"; |
53 |
> |
foreach my $tool (@{&getfileslist($tooldir)}) |
54 |
|
{ |
55 |
< |
$selected = [ keys %{$sel} ]; |
55 |
> |
if ($tool=~/^(.+)\.xml$/) {push @selected,$1;} |
56 |
|
} |
57 |
< |
|
58 |
< |
# 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"; |
57 |
> |
foreach my $tool (@selected){$self->coresetup("${tooldir}/${tool}.xml");} |
58 |
> |
scramlogmsg("\n"); |
59 |
|
} |
60 |
|
|
61 |
|
sub coresetup() |
62 |
|
{ |
63 |
|
my $self=shift; |
64 |
< |
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; |
64 |
> |
my ($toolfile) = @_; |
65 |
|
|
66 |
< |
map |
67 |
< |
{ |
68 |
< |
if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;} |
69 |
< |
} $self->rawtools(); |
70 |
< |
|
71 |
< |
# Tool not known so we create a new ToolParser object and parse it: |
72 |
< |
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 |
< |
} |
66 |
> |
my $toolparser = BuildSystem::ToolParser->new(); |
67 |
> |
$toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">'); |
68 |
> |
$toolparser->filetail('</doc>'); |
69 |
> |
$toolparser->parse($toolfile); |
70 |
> |
my $toolname = $toolparser->toolname(); |
71 |
> |
my $toolversion = $toolparser->toolversion(); |
72 |
> |
scramlogmsg("\n",$::bold."Setting up ",$toolname," version ",$toolversion,": ".$::normal,"\n"); |
73 |
|
|
74 |
|
# Next, set up the tool: |
75 |
< |
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 |
< |
# Store the ToolData object in the cache: |
231 |
< |
$self->storeincache($toolparser->toolname(),$store); |
232 |
< |
return $self; |
233 |
< |
} |
75 |
> |
my $store = $toolparser->processrawtool(); |
76 |
|
|
77 |
< |
sub toolsetup() |
78 |
< |
{ |
79 |
< |
my $self=shift; |
80 |
< |
my ($arealocation, $toolname, $toolversion, $toolurl) = @_; |
81 |
< |
my ($urlcache, $url, $filename, $tfname); |
82 |
< |
my $toolfile; |
83 |
< |
|
84 |
< |
$toolname =~ tr[A-Z][a-z]; |
85 |
< |
$toolversion ||= $self->defaultversion($toolname); |
86 |
< |
$urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache |
87 |
< |
|
88 |
< |
# Check for the downloaded tools cache: |
89 |
< |
if (defined($urlcache)) |
90 |
< |
{ |
91 |
< |
$self->{urlhandler}=URL::URLhandler->new($urlcache); |
92 |
< |
} |
93 |
< |
|
94 |
< |
$url = $self->toolurls()->{$toolname}; |
95 |
< |
$filename = $self->{toolfiledir}."/".$toolname; |
96 |
< |
|
97 |
< |
# First, check to see if there was a tool URL given. If so, we might need to read |
98 |
< |
# from http or from a file: type URL: |
99 |
< |
if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/)) |
258 |
< |
{ |
259 |
< |
# See what kind of URL (file:, http:, cvs:, svn:, .. ): |
260 |
< |
if ($proto eq 'file') |
261 |
< |
{ |
262 |
< |
# If the tool url is a file and the file exists, |
263 |
< |
# copy it to .SCRAM/InstalledTools and set the |
264 |
< |
# filename accordingly: |
265 |
< |
if ( -f $urlv) |
266 |
< |
{ |
267 |
< |
use File::Copy; |
268 |
< |
copy($urlv, $filename); |
269 |
< |
$toolfile=$filename; |
270 |
< |
} |
271 |
< |
else |
272 |
< |
{ |
273 |
< |
$::scram->scramerror("Unable to set up $toolname from URL $toolurl-- $urlv does not exist!"); |
274 |
< |
} |
275 |
< |
} |
276 |
< |
elsif ($proto eq 'http') |
277 |
< |
{ |
278 |
< |
print "SCRAM: downloading $toolname from $toolurl","\n"; |
279 |
< |
# Download from WWW first: |
280 |
< |
use LWP::Simple qw(&getstore); |
281 |
< |
my $http_response_val = &getstore($toolurl, $filename); |
282 |
< |
|
283 |
< |
# Check the HTTP status. If doc not found, exit: |
284 |
< |
if ($http_response_val != 200) |
285 |
< |
{ |
286 |
< |
my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|); |
287 |
< |
$::scram->scramerror("Unable to set up $toolname: $doc not found on $server!"); |
288 |
< |
} |
289 |
< |
else |
290 |
< |
{ |
291 |
< |
$toolfile=$filename; |
292 |
< |
} |
293 |
< |
} |
294 |
< |
elsif ($proto eq 'cvs') |
295 |
< |
{ |
296 |
< |
print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n"; |
297 |
< |
print "[ not yet supported ]","\n"; |
298 |
< |
exit(0); |
299 |
< |
} |
300 |
< |
elsif ($proto eq 'svn') |
301 |
< |
{ |
302 |
< |
print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n"; |
303 |
< |
print "[ not yet supported ]","\n"; |
304 |
< |
exit(0); |
305 |
< |
} |
306 |
< |
else |
307 |
< |
{ |
308 |
< |
$::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye."); |
309 |
< |
} |
310 |
< |
} |
311 |
< |
else |
312 |
< |
{ |
313 |
< |
# Copy the downloaded tool file to InstalledTools directory: |
314 |
< |
if ( ! -f $filename ) |
315 |
< |
{ |
316 |
< |
$self->verbose("Attempting Download of $url"); |
317 |
< |
# Get file from download cache: |
318 |
< |
($url,$filename)=$self->{urlhandler}->get($url); |
319 |
< |
use File::Copy; |
320 |
< |
$tfname=$self->{toolfiledir}."/".$toolname; |
321 |
< |
copy($filename, $tfname); |
322 |
< |
$toolfile=$tfname; |
323 |
< |
} |
324 |
< |
else |
325 |
< |
{ |
326 |
< |
# File already exists in the .SCRAM/InstallTools directory: |
327 |
< |
$toolfile=$filename; |
77 |
> |
# Check to see if this tool is a compiler. If so, store it. |
78 |
> |
# Also store the language that this compiler supprots, and a |
79 |
> |
# compiler name (e.g. gcc323) which, in conjunction with a stem |
80 |
> |
# architecture name like slc3_ia32_, can be used to build a complete arch string: |
81 |
> |
if ($store->scram_compiler() == 1) |
82 |
> |
{ |
83 |
> |
my @supported_language = $store->flags("SCRAM_LANGUAGE_TYPE"); |
84 |
> |
my @compilername = $store->flags("SCRAM_COMPILER_NAME"); |
85 |
> |
$self->scram_compiler($supported_language[0],$toolname,$compilername[0]); |
86 |
> |
} |
87 |
> |
|
88 |
> |
# Store the ToolData object in the cache: |
89 |
> |
$self->storeincache($toolname,$store); |
90 |
> |
my $srcfile=Utilities::AddDir::fixpath($toolfile); |
91 |
> |
my $desfile=Utilities::AddDir::fixpath($self->{toolcache}."/selected/${toolname}.xml"); |
92 |
> |
use File::Copy; |
93 |
> |
if ($srcfile ne $desfile) |
94 |
> |
{ |
95 |
> |
use File::Copy; |
96 |
> |
my $desfile1=Utilities::AddDir::fixpath($self->{toolcache}."/available/${toolname}.xml"); |
97 |
> |
if ($srcfile ne $desfile1) |
98 |
> |
{ |
99 |
> |
copy($srcfile,$desfile1); |
100 |
|
} |
101 |
+ |
if (-e $desfile) { unlink($desfile);} |
102 |
+ |
symlink("../available/${toolname}.xml",$desfile); |
103 |
|
} |
104 |
< |
|
331 |
< |
# Run the core setup routine: |
332 |
< |
$self->coresetup($toolname, $toolversion, $toolfile); |
104 |
> |
scramlogclean(); |
105 |
|
return $self; |
106 |
|
} |
107 |
|
|
108 |
|
sub setupself() |
109 |
|
{ |
110 |
|
my $self=shift; |
339 |
– |
my ($location)=@_; |
111 |
|
# Process the file "Self" in local config directory. This is used to |
112 |
|
# set all the paths/runtime settings for this project: |
113 |
< |
my $filename=$location."/config/Self"; |
113 |
> |
my $filename=$self->{configdir}."/Self.xml"; |
114 |
|
|
115 |
|
if ( -f $filename ) |
116 |
|
{ |
117 |
< |
print "\n"; |
347 |
< |
print $::bold."Setting up SELF:".$::normal,"\n"; |
117 |
> |
scramlogmsg("\n",$::bold."Setting up SELF:".$::normal,"\n"); |
118 |
|
# Self file exists so process it: |
119 |
|
$selfparser = BuildSystem::ToolParser->new(); |
120 |
< |
$selfparser->parse('self','SELF',$filename); |
120 |
> |
$selfparser->filehead ('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">'); |
121 |
> |
$selfparser->filehead ('</doc>'); |
122 |
> |
$selfparser->parse($filename); |
123 |
|
|
124 |
|
# Next, set up the tool: |
125 |
< |
$store = $selfparser->processrawtool($self->interactive()); |
126 |
< |
|
125 |
> |
$store = $selfparser->processrawtool(); |
126 |
> |
|
127 |
|
# If we are in a developer area, also add RELEASETOP paths: |
128 |
|
if (exists($ENV{RELEASETOP})) |
129 |
|
{ |
133 |
|
|
134 |
|
# Store the ToolData object in the cache: |
135 |
|
$self->storeincache($selfparser->toolname(),$store); |
136 |
< |
print "\n"; |
136 |
> |
scramlogmsg("\n"); |
137 |
|
} |
138 |
|
else |
139 |
|
{ |
140 |
+ |
scramlogdump(); |
141 |
|
print "\n"; |
142 |
< |
print "SCRAM: No file config/Self...nothing to do."; |
142 |
> |
print "SCRAM: No file config/Self.xml...nothing to do."; |
143 |
|
print "\n"; |
144 |
|
return; |
145 |
|
} |
146 |
|
} |
147 |
|
|
148 |
< |
sub defaultversion() |
148 |
> |
sub update() |
149 |
|
{ |
150 |
< |
my $self = shift; |
151 |
< |
my ($tool) = @_; |
152 |
< |
# Return default versions as taken from configuration: |
153 |
< |
return (%{$self->defaultversions()}->{$tool}); |
150 |
> |
my $self=shift; |
151 |
> |
my $area=shift; |
152 |
> |
$self->init($area); |
153 |
> |
$self->setupself(); |
154 |
> |
$self->dirty () |
155 |
|
} |
156 |
< |
|
156 |
> |
|
157 |
|
sub storeincache() |
158 |
|
{ |
159 |
|
my $self=shift; |
162 |
|
# Store ToolData object (for a set-up tool) in cache: |
163 |
|
if (ref($dataobject) eq 'BuildSystem::ToolData') |
164 |
|
{ |
165 |
+ |
$self->updatetooltimestamp($dataobject, $toolname); |
166 |
+ |
delete $self->{SETUP}->{$toolname}; |
167 |
|
$self->{SETUP}->{$toolname} = $dataobject; |
168 |
|
} |
169 |
|
else |
193 |
|
{ |
194 |
|
my $self = shift; |
195 |
|
my $tooldata = []; |
196 |
< |
my $rawsel = $self->selected(); |
197 |
< |
|
198 |
< |
foreach my $tool ( sort { %{$rawsel}->{$a} |
423 |
< |
<=> %{$rawsel}->{$b}} |
424 |
< |
keys %{$rawsel} ) |
196 |
> |
$self->{internal}{donetools}={}; |
197 |
> |
$self->{internal}{scram_tools}={}; |
198 |
> |
foreach my $tool (sort keys %{$self->{SETUP}}) |
199 |
|
{ |
200 |
< |
# Return tool data objects of all set-up tools, skipping the tool "self": |
201 |
< |
if ($_ ne "self") |
200 |
> |
if ($self->{SETUP}{$tool}->scram_project()) {$self->{internal}{scram_tools}{$tool}=1;} |
201 |
> |
elsif ($tool ne "self") |
202 |
|
{ |
203 |
< |
# Keep only tools that have really been set up: |
204 |
< |
if (exists $self->{SETUP}->{$tool}) |
203 |
> |
$self->_toolsdata($tool,$tooldata); |
204 |
> |
} |
205 |
> |
} |
206 |
> |
foreach my $tool (keys %{$self->{internal}{scram_tools}}) |
207 |
> |
{ |
208 |
> |
$self->_toolsdata_scram($tool,$tooldata); |
209 |
> |
} |
210 |
> |
delete $self->{internal}{donetools}; |
211 |
> |
delete $self->{internal}{scram_tools}; |
212 |
> |
my $data=[]; |
213 |
> |
foreach my $d (@$tooldata) |
214 |
> |
{ |
215 |
> |
if (ref($d) eq "ARRAY") |
216 |
> |
{ |
217 |
> |
foreach my $t (@$d) {push @$data,$t;} |
218 |
> |
} |
219 |
> |
} |
220 |
> |
return $data; |
221 |
> |
} |
222 |
> |
|
223 |
> |
sub _toolsdata() |
224 |
> |
{ |
225 |
> |
my $self = shift; |
226 |
> |
my $tool=shift; |
227 |
> |
my $data=shift || []; |
228 |
> |
my $order=-1; |
229 |
> |
if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};} |
230 |
> |
$self->{internal}{donetools}{$tool}=$order; |
231 |
> |
if (exists $self->{SETUP}{$tool}) |
232 |
> |
{ |
233 |
> |
if (exists $self->{SETUP}{$tool}{USE}) |
234 |
> |
{ |
235 |
> |
foreach my $use (@{$self->{SETUP}{$tool}{USE}}) |
236 |
|
{ |
237 |
< |
push(@tooldata,$self->{SETUP}->{$tool}); |
237 |
> |
my $o=$self->_toolsdata(lc($use),$data); |
238 |
> |
if ($o>$order){$order=$o;} |
239 |
|
} |
240 |
|
} |
241 |
+ |
$order++; |
242 |
+ |
if(!defined $data->[$order]){$data->[$order]=[];} |
243 |
+ |
push @{$data->[$order]},$self->{SETUP}{$tool}; |
244 |
+ |
$self->{internal}{donetools}{$tool}=$order; |
245 |
|
} |
246 |
< |
|
437 |
< |
# Return the array of tools, in order that they appear in RequirementsDoc: |
438 |
< |
return @tooldata; |
246 |
> |
return $order; |
247 |
|
} |
248 |
|
|
249 |
< |
sub definedtool() |
249 |
> |
sub _toolsdata_scram() |
250 |
|
{ |
251 |
< |
my $self=shift; |
252 |
< |
my ($tool)=@_; |
253 |
< |
|
254 |
< |
# Check to see if tool X is an external tool: |
255 |
< |
grep ($_ eq $tool, keys %{$self->{SETUP}}) ? return 1 |
256 |
< |
: return 0; |
251 |
> |
my $self = shift; |
252 |
> |
my $tool=shift; |
253 |
> |
my $data=shift || []; |
254 |
> |
my $order=-1; |
255 |
> |
if(exists $self->{internal}{donetools}{$tool}){return $self->{internal}{donetools}{$tool};} |
256 |
> |
$self->{internal}{donetools}{$tool}=$order; |
257 |
> |
if(!exists $self->{internal}{scram_tools}{$tool}){return $order;} |
258 |
> |
use Configuration::ConfigArea; |
259 |
> |
use Cache::CacheUtilities; |
260 |
> |
my $cache=uc($tool)."_BASE"; |
261 |
> |
$cache=$self->{SETUP}{$tool}{$cache}; |
262 |
> |
if (!-d $cache) |
263 |
> |
{ |
264 |
> |
print "ERROR: Release area \"$cache\" for \"$tool\" is not available.\n"; |
265 |
> |
return $order; |
266 |
> |
} |
267 |
> |
my $area=Configuration::ConfigArea->new(); |
268 |
> |
$area->location($cache); |
269 |
> |
my $cachefile=$area->toolcachename(); |
270 |
> |
if (!-f $cachefile) |
271 |
> |
{ |
272 |
> |
print "ERROR: Tools cache file for release area \"$cache\" is not available.\n"; |
273 |
> |
return $order; |
274 |
> |
} |
275 |
> |
$cache=&Cache::CacheUtilities::read($cachefile); |
276 |
> |
my $tools=$cache->setup(); |
277 |
> |
$order=scalar(@$data)-1; |
278 |
> |
foreach my $use (keys %$tools) |
279 |
> |
{ |
280 |
> |
if ($tools->{$use}->scram_project() == 1) |
281 |
> |
{ |
282 |
> |
my $o=$self->_toolsdata_scram($use,$data); |
283 |
> |
if ($o>$order){$order=$o;} |
284 |
> |
} |
285 |
> |
} |
286 |
> |
$order++; |
287 |
> |
if(!defined $data->[$order]){$data->[$order]=[];} |
288 |
> |
push @{$data->[$order]},$self->{SETUP}{$tool}; |
289 |
> |
$self->{internal}{donetools}{$tool}=$order; |
290 |
> |
return $order; |
291 |
|
} |
292 |
< |
|
292 |
> |
|
293 |
|
sub checkifsetup() |
294 |
|
{ |
295 |
|
my $self=shift; |
299 |
|
: return undef; |
300 |
|
} |
301 |
|
|
460 |
– |
sub cloned_tm() |
461 |
– |
{ |
462 |
– |
my $self=shift; |
463 |
– |
# Has this area already been cloned and brought in-line with current location: |
464 |
– |
@_ ? $self->{CLONED} = $_[0] |
465 |
– |
: $self->{CLONED}; |
466 |
– |
} |
467 |
– |
|
302 |
|
sub remove_tool() |
303 |
|
{ |
304 |
|
my $self=shift; |
305 |
|
my ($toolname)=@_; |
306 |
< |
my $tools = $self->{SETUP}; |
307 |
< |
my $newtlist = {}; |
474 |
< |
|
475 |
< |
while (my ($tool, $tooldata) = each %$tools) |
306 |
> |
my $tool = $self->{SETUP}{$toolname}; |
307 |
> |
if ($tool->scram_compiler() == 1) |
308 |
|
{ |
309 |
< |
if ($tool ne $toolname) |
310 |
< |
{ |
311 |
< |
$newtlist->{$tool} = $tooldata; |
480 |
< |
} |
481 |
< |
else |
482 |
< |
{ |
483 |
< |
print "Deleting $toolname from cache.","\n"; |
309 |
> |
while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}}) |
310 |
> |
{ |
311 |
> |
if ($toolname eq $ctool->[0]){delete $self->{SCRAM_COMPILER}->{$langtype};} |
312 |
|
} |
313 |
|
} |
314 |
< |
|
315 |
< |
$self->{SETUP} = $newtlist; |
316 |
< |
|
489 |
< |
# Now remove from the RAW tool list: |
490 |
< |
$self->cleanup_raw($toolname); |
491 |
< |
|
492 |
< |
print "ToolManager: Updating tool cache.","\n"; |
314 |
> |
delete $self->{SETUP}{$toolname}; |
315 |
> |
print "Deleting $toolname from cache.","\n"; |
316 |
> |
$self->updatetooltimestamp (undef, $toolname); |
317 |
|
$self->writecache(); |
318 |
+ |
my $file1=$self->{toolcache}."/selected/${toolname}.xml"; |
319 |
+ |
my $file2=$self->{toolcache}."/available/${toolname}.xml"; |
320 |
+ |
if ((!-f $file2) && (-f $file1)) |
321 |
+ |
{ |
322 |
+ |
use File::Copy; |
323 |
+ |
copy ($file1,$file2); |
324 |
+ |
} |
325 |
+ |
unlink ($file1); |
326 |
|
} |
327 |
|
|
328 |
|
sub scram_projects() |
340 |
|
return $scram_projects; |
341 |
|
} |
342 |
|
|
343 |
+ |
sub scram_compiler() |
344 |
+ |
{ |
345 |
+ |
my $self=shift; |
346 |
+ |
my ($langtype, $toolname, $compilername)=@_; |
347 |
+ |
|
348 |
+ |
if ($langtype) |
349 |
+ |
{ |
350 |
+ |
# Store the compiler info according to supported |
351 |
+ |
# language types. |
352 |
+ |
# |
353 |
+ |
# ---------------------- e.g C++ cxxcompiler gcc323 |
354 |
+ |
$self->{SCRAM_COMPILER}->{$langtype}=[ $toolname, $compilername ]; |
355 |
+ |
} |
356 |
+ |
else |
357 |
+ |
{ |
358 |
+ |
return $self->{SCRAM_COMPILER}; |
359 |
+ |
} |
360 |
+ |
} |
361 |
+ |
|
362 |
+ |
sub updatetooltimestamp () |
363 |
+ |
{ |
364 |
+ |
my $self=shift; |
365 |
+ |
my $obj=shift; |
366 |
+ |
my $toolname=shift; |
367 |
+ |
my $samevalues=0; |
368 |
+ |
my $stampdir = $self->{archstore}."/timestamps"; |
369 |
+ |
my $stampfile="${stampdir}/${toolname}"; |
370 |
+ |
if (exists $self->{SETUP}->{$toolname}) |
371 |
+ |
{ |
372 |
+ |
$samevalues=$self->comparetoolsdata($self->{SETUP}->{$toolname},$obj); |
373 |
+ |
} |
374 |
+ |
if ($toolname ne "self") |
375 |
+ |
{ |
376 |
+ |
my $instdir = $self->{archstore}."/InstalledTools"; |
377 |
+ |
my $tfile = "${instdir}/${toolname}"; |
378 |
+ |
if ((!defined $obj) && (-f $tfile)) {unlink $tfile;} |
379 |
+ |
elsif ((defined $obj) && (!-f $tfile)) |
380 |
+ |
{ |
381 |
+ |
Utilities::AddDir::adddir($instdir); |
382 |
+ |
my $ref; |
383 |
+ |
open($ref,">$tfile"); |
384 |
+ |
close($ref); |
385 |
+ |
} |
386 |
+ |
} |
387 |
+ |
if ((!$samevalues) || (!-f $stampfile)) |
388 |
+ |
{ |
389 |
+ |
if (!-d $stampdir) |
390 |
+ |
{ |
391 |
+ |
Utilities::AddDir::adddir($stampdir); |
392 |
+ |
} |
393 |
+ |
my $ref; |
394 |
+ |
open($ref,">$stampfile"); |
395 |
+ |
close($ref); |
396 |
+ |
if (!$samevalues){$self->dirty();} |
397 |
+ |
} |
398 |
+ |
} |
399 |
+ |
|
400 |
+ |
sub comparetoolsdata () |
401 |
+ |
{ |
402 |
+ |
my $self=shift; |
403 |
+ |
my $data1=shift || (); |
404 |
+ |
my $data2=shift || (); |
405 |
+ |
|
406 |
+ |
my $ref1=ref($data1); |
407 |
+ |
my $ref2=ref($data2); |
408 |
+ |
|
409 |
+ |
if ($ref1 ne $ref2) |
410 |
+ |
{ |
411 |
+ |
return 0; |
412 |
+ |
} |
413 |
+ |
elsif ($ref1 eq "CODE") |
414 |
+ |
{ |
415 |
+ |
return 1; |
416 |
+ |
} |
417 |
+ |
elsif(($ref1 eq "SCALAR") || ($ref1 eq "")) |
418 |
+ |
{ |
419 |
+ |
if ($data1 eq $data2) |
420 |
+ |
{ |
421 |
+ |
return 1; |
422 |
+ |
} |
423 |
+ |
return 0; |
424 |
+ |
} |
425 |
+ |
elsif ($ref1 eq "ARRAY") |
426 |
+ |
{ |
427 |
+ |
my $count = scalar(@$data1); |
428 |
+ |
if ($count != scalar(@$data2)) |
429 |
+ |
{ |
430 |
+ |
return 0; |
431 |
+ |
} |
432 |
+ |
for (my $i=0; $i<$count; $i++) |
433 |
+ |
{ |
434 |
+ |
if (! $self->comparetoolsdata($data1->[$i],$data2->[$i])) |
435 |
+ |
{ |
436 |
+ |
return 0; |
437 |
+ |
} |
438 |
+ |
} |
439 |
+ |
return 1; |
440 |
+ |
} |
441 |
+ |
else |
442 |
+ |
{ |
443 |
+ |
foreach my $k (keys %{$data1}) |
444 |
+ |
{ |
445 |
+ |
if (! exists $data2->{$k}) |
446 |
+ |
{ |
447 |
+ |
return 0; |
448 |
+ |
} |
449 |
+ |
} |
450 |
+ |
foreach my $k (keys %{$data2}) |
451 |
+ |
{ |
452 |
+ |
if (! exists $data1->{$k}) |
453 |
+ |
{ |
454 |
+ |
return 0; |
455 |
+ |
} |
456 |
+ |
} |
457 |
+ |
foreach my $k (keys %{$data2}) |
458 |
+ |
{ |
459 |
+ |
if (! $self->comparetoolsdata($data1->{$k},$data2->{$k})) |
460 |
+ |
{ |
461 |
+ |
return 0; |
462 |
+ |
} |
463 |
+ |
} |
464 |
+ |
return 1; |
465 |
+ |
} |
466 |
+ |
} |
467 |
+ |
|
468 |
|
1; |