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 |
|
|
24 |
|
# |
25 |
|
|
26 |
|
sub new |
28 |
– |
############################################################### |
29 |
– |
# new # |
30 |
– |
############################################################### |
31 |
– |
# modified : Wed Nov 12 10:34:10 2003 / SFA # |
32 |
– |
# params : # |
33 |
– |
# : # |
34 |
– |
# function : # |
35 |
– |
# : # |
36 |
– |
############################################################### |
27 |
|
{ |
28 |
|
my $proto=shift; |
29 |
|
my $class=ref($proto) || $proto; |
30 |
|
my $self=$class->SUPER::new(); # Inherit from ToolCache |
41 |
– |
my $projectarea=shift; |
42 |
– |
|
31 |
|
bless $self,$class; |
32 |
< |
|
45 |
< |
$self->{arch}=shift; |
46 |
< |
$self->{topdir}=$projectarea->location(); |
47 |
< |
$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir(); |
48 |
< |
$self->{cache}=$projectarea->cache(); # Download tool cache |
49 |
< |
$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools"; |
50 |
< |
$self->{datastore}=$self->{topdir}."/.SCRAM"; |
51 |
< |
$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH}; |
52 |
< |
$self->{tooltimestamp}="timestamps"; |
53 |
< |
|
54 |
< |
# Make sure our tool download dir exists: |
55 |
< |
AddDir::adddir($self->{toolfiledir}); |
56 |
< |
AddDir::adddir($self->{archstore}); |
57 |
< |
|
58 |
< |
# Set the tool cache file to read/write: |
59 |
< |
$self->name($projectarea->toolcachename()); |
60 |
< |
|
61 |
< |
# Check for the downloaded tools cache: |
62 |
< |
if (exists($self->{cache})) |
63 |
< |
{ |
64 |
< |
$self->{urlhandler}=URL::URLhandler->new($self->{cache}); |
65 |
< |
} |
66 |
< |
|
32 |
> |
$self->init (shift); |
33 |
|
return $self; |
34 |
|
} |
35 |
|
|
36 |
< |
sub clone() |
36 |
> |
sub init () |
37 |
|
{ |
38 |
|
my $self=shift; |
39 |
|
my $projectarea=shift; |
74 |
– |
|
75 |
– |
# Change cache settings to reflect the new location: |
40 |
|
$self->{topdir}=$projectarea->location(); |
77 |
– |
|
41 |
|
$self->{configdir}=$self->{topdir}."/".$projectarea->configurationdir(); |
42 |
< |
$self->{toolfiledir}=$self->{topdir}."/.SCRAM/InstalledTools"; |
43 |
< |
$self->{datastore}=$self->{topdir}."/.SCRAM"; |
81 |
< |
$self->{archstore}=$self->{topdir}."/.SCRAM/".$ENV{SCRAM_ARCH}; |
82 |
< |
|
83 |
< |
# Change the cache name: |
42 |
> |
$self->{archstore}=$projectarea->archdir(); |
43 |
> |
$self->{toolcache}=$self->{configdir}."/toolbox/$ENV{SCRAM_ARCH}/tools"; |
44 |
|
$self->name($projectarea->toolcachename()); |
45 |
< |
$self->cloned_tm(1); |
86 |
< |
|
87 |
< |
return $self; |
88 |
< |
} |
89 |
< |
|
90 |
< |
sub arch_change_after_copy() |
91 |
< |
{ |
92 |
< |
my $self=shift; |
93 |
< |
my ($newarch, $cachename)=@_; |
94 |
< |
# Make changes to arch-specific settings when copying tool manager |
95 |
< |
# object to another arch during setup: |
96 |
< |
$self->{arch} = $newarch; |
97 |
< |
$self->{archstore} = $self->{topdir}."/.SCRAM/".$newarch; |
98 |
< |
# Change the name of the cache to reflect new (arch-specific) location: |
99 |
< |
$self->name($cachename); |
45 |
> |
$self->dirty(); |
46 |
|
} |
47 |
< |
|
102 |
< |
sub interactive() |
103 |
< |
{ |
104 |
< |
my $self=shift; |
105 |
< |
# Interactive mode on/off: |
106 |
< |
@_ ? $self->{interactive} = shift |
107 |
< |
: ((defined $self->{interactive}) ? $self->{interactive} : 0); |
108 |
< |
} |
109 |
< |
|
47 |
> |
|
48 |
|
sub setupalltools() |
49 |
|
{ |
50 |
|
my $self = shift; |
51 |
< |
my ($arealocation,$setupopt) = @_; |
52 |
< |
my (@localtools); |
53 |
< |
my $selected; |
116 |
< |
|
117 |
< |
# Get the selected tool list. Handle the case where there might not be |
118 |
< |
# any selected tools: //FIXME: need to handle case where there are no |
119 |
< |
# selected tools (not very often but a possibility): |
120 |
< |
my $sel = $self->selected(); |
121 |
< |
|
122 |
< |
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 |
< |
|
127 |
< |
# Setup option "setupopt" directs the setup: 1 is for booting from |
128 |
< |
# scratch, 0 is when just doing "scram setup" (in this case we don't |
129 |
< |
# want to pick up everything from any scram-managed projects): |
130 |
< |
if ($setupopt == 1) # We're booting from scratch |
131 |
< |
{ |
132 |
< |
# Look for a match in the scram db: |
133 |
< |
foreach my $S (@$selected) |
134 |
< |
{ |
135 |
< |
# Store other tools in ReqDoc in separate array. We will set up these tools later: |
136 |
< |
push(@localtools,$S); |
137 |
< |
} |
138 |
< |
|
139 |
< |
# Set up extra tools required in this project, in addition to |
140 |
< |
# any scram-managed projects |
141 |
< |
foreach my $localtool (@localtools) |
142 |
< |
{ |
143 |
< |
# First check to see if it's already set up (i.e., was contained |
144 |
< |
# in list of requirements for scram project): |
145 |
< |
if (! $self->definedtool($localtool)) |
146 |
< |
{ |
147 |
< |
$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool)); |
148 |
< |
$self->addtoselected($localtool); |
149 |
< |
} |
150 |
< |
else |
151 |
< |
{ |
152 |
< |
scramlogmsg($localtool," already set up.","\n"),if ($ENV{SCRAM_DEBUG}); |
153 |
< |
} |
154 |
< |
} |
155 |
< |
} |
156 |
< |
else |
157 |
< |
{ |
158 |
< |
# Just loop over all tools and setup again: |
159 |
< |
foreach my $localtool (@{$selected}) |
160 |
< |
{ |
161 |
< |
$self->toolsetup($arealocation,$localtool,$self->defaultversion($localtool)); |
162 |
< |
} |
163 |
< |
} |
164 |
< |
|
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, $force) = @_; |
172 |
< |
my ($toolcheck, $toolparser); |
64 |
> |
my ($toolfile) = @_; |
65 |
|
|
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 |
|
|
176 |
– |
# New ToolParser object for this tool if there isn't one already. |
177 |
– |
# Look in array of raw tools to see if this tool has a ToolParser object: |
178 |
– |
$toolcheck=0; |
179 |
– |
|
180 |
– |
map |
181 |
– |
{ |
182 |
– |
if ($_->toolname() eq $toolname) {$toolcheck = 1; $toolparser = $_;} |
183 |
– |
} $self->rawtools(); |
184 |
– |
|
185 |
– |
# Tool not known so we create a new ToolParser object and parse it: |
186 |
– |
if ($toolcheck != 1 || $force == 1) |
187 |
– |
{ |
188 |
– |
$toolparser = BuildSystem::ToolParser->new(); |
189 |
– |
$toolparser->filehead('<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::ToolDoc" version="1.0">'); |
190 |
– |
$toolparser->filetail('</doc>'); |
191 |
– |
# We only want to store the stuff relevant for one particular version: |
192 |
– |
$toolparser->parse($toolname, $toolversion, $toolfile); |
193 |
– |
# Store the ToolParser object in the cache: |
194 |
– |
$self->store($toolparser); |
195 |
– |
print "\nFile $toolfile reparsed (modified)","\n",if ($ENV{SCRAM_DEBUG}); |
196 |
– |
} |
197 |
– |
|
74 |
|
# Next, set up the tool: |
75 |
< |
my $store = $toolparser->processrawtool($self->interactive()); |
200 |
< |
# Make sure that we have this tool in the list of selected tools (just in case this tool was |
201 |
< |
# set up by hand afterwards): |
202 |
< |
$self->addtoselected($toolname); |
75 |
> |
my $store = $toolparser->processrawtool(); |
76 |
|
|
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 |
86 |
|
} |
87 |
|
|
88 |
|
# Store the ToolData object in the cache: |
89 |
< |
$self->storeincache($toolparser->toolname(),$store); |
90 |
< |
return $self; |
91 |
< |
} |
92 |
< |
|
93 |
< |
sub toolsetup() |
94 |
< |
{ |
95 |
< |
my $self=shift; |
96 |
< |
my ($arealocation, $toolname, $toolversion, $toolurl) = @_; |
97 |
< |
my ($urlcache, $url, $filename, $tfname); |
98 |
< |
my $toolfile; |
99 |
< |
my $force = 0; # we may have to force a reparse of a tool file |
227 |
< |
|
228 |
< |
$toolname =~ tr[A-Z][a-z]; |
229 |
< |
$toolversion ||= $self->defaultversion($toolname); |
230 |
< |
$urlcache=URL::URLcache->new($arealocation."/.SCRAM/cache"); # Download tool cache |
231 |
< |
|
232 |
< |
# Check for the downloaded tools cache: |
233 |
< |
if (defined($urlcache)) |
234 |
< |
{ |
235 |
< |
$self->{urlhandler}=URL::URLhandler->new($urlcache); |
236 |
< |
} |
237 |
< |
|
238 |
< |
$url = $self->toolurls()->{$toolname}; |
239 |
< |
$filename = $self->{toolfiledir}."/".$toolname; |
240 |
< |
|
241 |
< |
# If .SCRAM/InstalledTools doesn't exist, create it: |
242 |
< |
if (! -d $self->{toolfiledir}) |
243 |
< |
{ |
244 |
< |
AddDir::adddir($self->{toolfiledir}); |
245 |
< |
} |
246 |
< |
|
247 |
< |
# First, check to see if there was a tool URL given. If so, we might need to read |
248 |
< |
# from http or from a file: type URL: |
249 |
< |
if (my ($proto, $urlv) = ($toolurl =~ /(.*):(.*)/)) |
250 |
< |
{ |
251 |
< |
# See what kind of URL (file:, http:, cvs:, svn:, .. ): |
252 |
< |
if ($proto eq 'file') |
253 |
< |
{ |
254 |
< |
# Check to see if there is a ~ and substitute the user |
255 |
< |
# home directory if there is (file:~/xyz): |
256 |
< |
if (my ($urlpath) = ($urlv =~ m|^\~/(.*)$|)) |
257 |
< |
{ |
258 |
< |
$urlv = $ENV{HOME}."/".$urlpath; |
259 |
< |
} |
260 |
< |
elsif (my ($urlpath) = ($urlv =~ m|^\./(.*)$|)) |
261 |
< |
{ |
262 |
< |
# Relative to current directory (file:./xyz): |
263 |
< |
use Cwd qw(&cwd); |
264 |
< |
$urlv = cwd()."/".$urlpath; |
265 |
< |
} |
266 |
< |
|
267 |
< |
# If the tool url is a file and the file exists, |
268 |
< |
# copy it to .SCRAM/InstalledTools and set the |
269 |
< |
# filename accordingly: |
270 |
< |
if ( -f $urlv) |
271 |
< |
{ |
272 |
< |
use File::Copy; |
273 |
< |
copy($urlv, $filename); |
274 |
< |
my $mode = 0644; chmod $mode, $filename; |
275 |
< |
$toolfile=$filename; |
276 |
< |
# Here we must account for the fact that the file tool doc may be |
277 |
< |
# a modified version of an existing tool in the current config. we |
278 |
< |
# make sure that this file is reparsed, even if there is already a |
279 |
< |
# ToolParser object for the tool: |
280 |
< |
$force = 1; |
281 |
< |
} |
282 |
< |
else |
283 |
< |
{ |
284 |
< |
$::scram->scramerror("Unable to set up $toolname from URL \"$toolurl\" - $urlv does not exist!"); |
285 |
< |
} |
286 |
< |
} |
287 |
< |
elsif ($proto eq 'http') |
288 |
< |
{ |
289 |
< |
print "SCRAM: downloading $toolname from $toolurl","\n"; |
290 |
< |
# Download from WWW first: |
291 |
< |
use LWP::Simple qw(&getstore); |
292 |
< |
my $http_response_val = &getstore($toolurl, $filename); |
293 |
< |
|
294 |
< |
# Check the HTTP status. If doc not found, exit: |
295 |
< |
if ($http_response_val != 200) |
296 |
< |
{ |
297 |
< |
my ($server,$doc) = ($urlv =~ m|//(.*?)/(.*)|); |
298 |
< |
$::scram->scramerror("Unable to set up $toolname: $doc not found on $server!"); |
299 |
< |
} |
300 |
< |
else |
301 |
< |
{ |
302 |
< |
$toolfile=$filename; |
303 |
< |
} |
304 |
< |
} |
305 |
< |
elsif ($proto eq 'cvs') |
306 |
< |
{ |
307 |
< |
print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n"; |
308 |
< |
print "[ not yet supported ]","\n"; |
309 |
< |
exit(0); |
310 |
< |
} |
311 |
< |
elsif ($proto eq 'svn') |
312 |
< |
{ |
313 |
< |
print "SCRAM: downloading $toolname from $urlv using protocol $proto.","\n"; |
314 |
< |
print "[ not yet supported ]","\n"; |
315 |
< |
exit(0); |
316 |
< |
} |
317 |
< |
else |
318 |
< |
{ |
319 |
< |
$::scram->scramerror("Unable to download $urlv! Unknown protocol \"$proto\". Bye."); |
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 |
< |
else |
323 |
< |
{ |
324 |
< |
# Copy the downloaded tool file to InstalledTools directory: |
325 |
< |
if ( ! -f $filename ) |
326 |
< |
{ |
327 |
< |
# If the URL is empty, the chances are that this tool was not downloaded to .SCRAM/InstalledTools. |
328 |
< |
# We signal an error and exit: |
329 |
< |
if ($url eq '') |
330 |
< |
{ |
331 |
< |
$::scram->scramerror("$toolname was selected in project requirements but is not in the configuration!"); |
332 |
< |
} |
333 |
< |
else |
334 |
< |
{ |
335 |
< |
# Otherwise, we try to download it: |
336 |
< |
$self->verbose("Attempting Download of $url"); |
337 |
< |
# Get file from download cache: |
338 |
< |
($url,$filename)=$self->{urlhandler}->get($url); |
339 |
< |
use File::Copy; |
340 |
< |
$tfname=$self->{toolfiledir}."/".$toolname; |
341 |
< |
copy($filename, $tfname); |
342 |
< |
my $mode = 0644; chmod $mode, $tfname; |
343 |
< |
$toolfile=$tfname; |
344 |
< |
} |
345 |
< |
} |
346 |
< |
else |
347 |
< |
{ |
348 |
< |
# File already exists in the .SCRAM/InstallTools directory: |
349 |
< |
$toolfile=$filename; |
350 |
< |
} |
351 |
< |
} |
352 |
< |
|
353 |
< |
# Run the core setup routine: |
354 |
< |
$self->coresetup($toolname, $toolversion, $toolfile,$force); |
104 |
> |
scramlogclean(); |
105 |
|
return $self; |
106 |
|
} |
107 |
|
|
108 |
|
sub setupself() |
109 |
|
{ |
110 |
|
my $self=shift; |
361 |
– |
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.xml"; |
113 |
> |
my $filename=$self->{configdir}."/Self.xml"; |
114 |
|
|
115 |
|
if ( -f $filename ) |
116 |
|
{ |
119 |
|
$selfparser = BuildSystem::ToolParser->new(); |
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('self','SELF',$filename); |
122 |
> |
$selfparser->parse($filename); |
123 |
|
|
124 |
|
# Next, set up the tool: |
125 |
< |
$store = $selfparser->processrawtool($self->interactive()); |
125 |
> |
$store = $selfparser->processrawtool(); |
126 |
|
|
127 |
|
# If we are in a developer area, also add RELEASETOP paths: |
128 |
|
if (exists($ENV{RELEASETOP})) |
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; |
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} |
448 |
< |
<=> %{$rawsel}->{$b}} |
449 |
< |
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 |
< |
|
462 |
< |
# Return the array of tools, in order that they appear in RequirementsDoc: |
463 |
< |
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 |
|
|
485 |
– |
sub cloned_tm() |
486 |
– |
{ |
487 |
– |
my $self=shift; |
488 |
– |
# Has this area already been cloned and brought in-line with current location: |
489 |
– |
@_ ? $self->{CLONED} = $_[0] |
490 |
– |
: $self->{CLONED}; |
491 |
– |
} |
492 |
– |
|
302 |
|
sub remove_tool() |
303 |
|
{ |
304 |
|
my $self=shift; |
305 |
|
my ($toolname)=@_; |
306 |
< |
my $tools = $self->{SETUP}; |
307 |
< |
my $newtlist = {}; |
499 |
< |
|
500 |
< |
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; |
505 |
< |
} |
506 |
< |
else |
507 |
< |
{ |
508 |
< |
# Is this tool a compiler? |
509 |
< |
if ($tooldata->scram_compiler() == 1) |
510 |
< |
{ |
511 |
< |
# Also remove this from the compiler info if there happens to be an entry: |
512 |
< |
while (my ($langtype, $ctool) = each %{$self->{SCRAM_COMPILER}}) |
513 |
< |
{ |
514 |
< |
if ($toolname eq $ctool->[0]) |
515 |
< |
{ |
516 |
< |
delete $self->{SCRAM_COMPILER}->{$langtype}; |
517 |
< |
print "Deleting compiler $toolname from cache.","\n"; |
518 |
< |
} |
519 |
< |
} |
520 |
< |
} |
521 |
< |
else |
522 |
< |
{ |
523 |
< |
print "Deleting $toolname from cache.","\n"; |
524 |
< |
} |
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 |
< |
$self->updatetooltimestamp ("", $toolname); |
530 |
< |
# Now remove from the RAW tool list: |
531 |
< |
$self->cleanup_raw($toolname); |
532 |
< |
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() |
359 |
|
} |
360 |
|
} |
361 |
|
|
570 |
– |
sub updatetool() |
571 |
– |
{ |
572 |
– |
my $self=shift; |
573 |
– |
my ($name, $obj) = @_; |
574 |
– |
|
575 |
– |
# Replace the existing copy of the tool with the new one: |
576 |
– |
if (exists $self->{SETUP}->{$name}) |
577 |
– |
{ |
578 |
– |
# Check to make sure that we were really passed a compiler with |
579 |
– |
# the desired name: |
580 |
– |
if ($obj->toolname() eq $name) |
581 |
– |
{ |
582 |
– |
$self->updatetooltimestamp ($obj, $name); |
583 |
– |
print "ToolManager: Updating the cached copy of ".$name."\n"; |
584 |
– |
delete $self->{SETUP}->{$name}; |
585 |
– |
$self->{SETUP}->{$name} = $obj; |
586 |
– |
$self->writecache(); |
587 |
– |
} |
588 |
– |
else |
589 |
– |
{ |
590 |
– |
print "WARNING: Tool name (".$name.") and tool obj name (".$obj->toolname().") don't match!","\n"; |
591 |
– |
print " Not making any changes.","\n"; |
592 |
– |
} |
593 |
– |
} |
594 |
– |
else |
595 |
– |
{ |
596 |
– |
print "WARNING: No entry in cache for ".$name.". Not making any updates.\n"; |
597 |
– |
} |
598 |
– |
} |
599 |
– |
|
600 |
– |
sub check_compatibility() |
601 |
– |
{ |
602 |
– |
my $self=shift; |
603 |
– |
my ($itoolmgr)=@_; |
604 |
– |
# Get the version of the toolmanager. If the project fails to return a version |
605 |
– |
# string we return 0 for no compatibility (in which case, all tools will be set |
606 |
– |
# up in the traditional way): |
607 |
– |
my $itm_configversion = $itoolmgr->configversion(); |
608 |
– |
if ($itm_configversion) |
609 |
– |
{ |
610 |
– |
# The configurations won't be identical. We must compare the digits: |
611 |
– |
my ($numeric_version) = ($itm_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/); |
612 |
– |
my $current_configversion = $self->configversion(); |
613 |
– |
my ($current_numeric_version) = ($current_configversion =~ /[a-zA-Z]*\_([0-9a-z]*).*?/); |
614 |
– |
($current_numeric_version == $numeric_version) && return 1; # OK, compatible; |
615 |
– |
} |
616 |
– |
# Project does not define configuration version so just return: |
617 |
– |
return 0; |
618 |
– |
} |
619 |
– |
|
620 |
– |
sub configversion() |
621 |
– |
{ |
622 |
– |
my $self=shift; |
623 |
– |
@_ ? $self->{CONFIGVERSION} = shift |
624 |
– |
: $self->{CONFIGVERSION}; |
625 |
– |
} |
626 |
– |
|
362 |
|
sub updatetooltimestamp () |
363 |
|
{ |
364 |
|
my $self=shift; |
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 |
< |
AddDir::adddir($stampdir); |
391 |
> |
Utilities::AddDir::adddir($stampdir); |
392 |
|
} |
393 |
< |
open(TIMESTAMPFILE,">$stampfile"); |
394 |
< |
close(TIMESTAMPFILE); |
393 |
> |
my $ref; |
394 |
> |
open($ref,">$stampfile"); |
395 |
> |
close($ref); |
396 |
> |
if (!$samevalues){$self->dirty();} |
397 |
|
} |
398 |
|
} |
399 |
|
|