| 65 |
|
return @{$self->{tools}}; |
| 66 |
|
} |
| 67 |
|
|
| 68 |
+ |
|
| 69 |
|
sub selectedtools |
| 70 |
|
{ |
| 71 |
+ |
############################################################### |
| 72 |
+ |
# selectedtools() # |
| 73 |
+ |
############################################################### |
| 74 |
+ |
# modified : Wed Dec 5 15:39:39 2001 / SFA # |
| 75 |
+ |
# params : # |
| 76 |
+ |
# : # |
| 77 |
+ |
# : # |
| 78 |
+ |
# : # |
| 79 |
+ |
# function : New version of routine. Return a list of tools # |
| 80 |
+ |
# : that were selected after parsing RequirementsDoc # |
| 81 |
+ |
# : # |
| 82 |
+ |
# : # |
| 83 |
+ |
############################################################### |
| 84 |
|
my $self=shift; |
| 85 |
< |
my @toollist=(); |
| 85 |
> |
my @toolarray = (); |
| 86 |
> |
|
| 87 |
> |
# Grab the arrays of tools: |
| 88 |
> |
my ($toolref,$deseltoolref,$unseltoolref) = $self->grabtools(); |
| 89 |
> |
|
| 90 |
> |
my @tools = @{$toolref}; |
| 91 |
> |
my @deseltools = @{$deseltoolref}; |
| 92 |
> |
my @unseltools = @{$unseltoolref}; |
| 93 |
> |
|
| 94 |
> |
if ($#tools == -1) |
| 95 |
> |
{ |
| 96 |
> |
$self->verbose(">> No tools SELECTED. Checking for DESELECTED tools"); |
| 97 |
> |
|
| 98 |
> |
# No tools "SELECTED". We return the tools that were "UNSELECTED" |
| 99 |
> |
# (these are the tools that remain after unwanted tools are deselected): |
| 100 |
> |
if ($#unseltools != -1) |
| 101 |
> |
{ |
| 102 |
> |
$self->verbose(">> Using the tools remaining after DESELECTION ops"); |
| 103 |
> |
# The array has elements: |
| 104 |
> |
return @unseltools; |
| 105 |
> |
} |
| 106 |
> |
else |
| 107 |
> |
{ |
| 108 |
> |
$self->verbose(">> No UNSELECTED tools....."); |
| 109 |
> |
} |
| 110 |
> |
} |
| 111 |
> |
else |
| 112 |
> |
{ |
| 113 |
> |
# We will return the selected tools but only after checking |
| 114 |
> |
# for subsequently deselected tools (unlikely but...): |
| 115 |
> |
foreach $selected (@tools) |
| 116 |
> |
{ |
| 117 |
> |
# If the tool exists in the deselected tool array, pass. |
| 118 |
> |
if ( ! grep /$selected/, @deseltools) |
| 119 |
> |
{ |
| 120 |
> |
push @toolarray, $selected; |
| 121 |
> |
} |
| 122 |
> |
else |
| 123 |
> |
{ |
| 124 |
> |
$self->verbose(">> Tool $selected was subsequently deselected."); |
| 125 |
> |
} |
| 126 |
> |
} |
| 127 |
> |
} |
| 128 |
> |
return @toolarray; |
| 129 |
> |
} |
| 130 |
> |
|
| 131 |
|
|
| 132 |
+ |
sub grabtools |
| 133 |
+ |
{ |
| 134 |
+ |
############################################################### |
| 135 |
+ |
# grabtools() # |
| 136 |
+ |
############################################################### |
| 137 |
+ |
# modified : Wed Dec 5 14:41:56 2001 / SFA # |
| 138 |
+ |
# params : # |
| 139 |
+ |
# : # |
| 140 |
+ |
# : # |
| 141 |
+ |
# : # |
| 142 |
+ |
# function : Loop over the tools read from RequirementsDoc # |
| 143 |
+ |
# : and fill arrays for selected, deselected and # |
| 144 |
+ |
# : unselected tools. # |
| 145 |
+ |
# : # |
| 146 |
+ |
############################################################### |
| 147 |
+ |
my $self=shift; |
| 148 |
+ |
my @toollist=(); |
| 149 |
+ |
my @deseltoollist=(); |
| 150 |
+ |
my @unseltoollist=(); |
| 151 |
+ |
|
| 152 |
|
foreach $tool ( @{$self->{tools}} ) |
| 153 |
|
{ |
| 154 |
|
if ( $self->{selected}{$tool} eq "SELECTED" ) |
| 155 |
|
{ |
| 77 |
– |
$self->verbose(">> Adding tool $tool to list of selected tools"); |
| 156 |
|
push @toollist, $tool; |
| 157 |
|
} |
| 158 |
< |
$self->verbose(">> Tool $tool was deselected"); |
| 158 |
> |
elsif ( $self->{selected}{$tool} eq "DESELECTED" ) |
| 159 |
> |
{ |
| 160 |
> |
push @deseltoollist, $tool; |
| 161 |
> |
} |
| 162 |
> |
elsif ( $self->{selected}{$tool} eq "UNSELECTED" ) |
| 163 |
> |
{ |
| 164 |
> |
push @unseltoollist, $tool; |
| 165 |
> |
} |
| 166 |
> |
else |
| 167 |
> |
{ |
| 168 |
> |
$self->verbose(">> Looks like an unknown sel flag for tool ".$tool." "); |
| 169 |
> |
} |
| 170 |
|
} |
| 171 |
< |
return @toollist; |
| 171 |
> |
return \(@toollist, @deseltoollist, @unseltoollist); |
| 172 |
|
} |
| 173 |
|
|
| 174 |
+ |
|
| 175 |
|
sub toolcomment { |
| 176 |
|
my $self=shift; |
| 177 |
|
my $tool=shift; |
| 259 |
|
|
| 260 |
|
sub arch { |
| 261 |
|
my $self=shift; |
| 262 |
+ |
# $self->arch is the SCRAM_ARCH value: |
| 263 |
|
if ( @_ ) { |
| 264 |
|
$self->{arch}=shift |
| 265 |
|
} |
| 289 |
|
} |
| 290 |
|
|
| 291 |
|
|
| 292 |
< |
sub download { |
| 293 |
< |
my $self=shift; |
| 292 |
> |
sub download |
| 293 |
> |
{ |
| 294 |
> |
my $self=shift; |
| 295 |
> |
my $tool; |
| 296 |
> |
$| = 1; # Unbuffer the output |
| 297 |
|
|
| 298 |
< |
my $tool; |
| 299 |
< |
foreach $tool ( $self->tools() ) { |
| 300 |
< |
$self->verbose("Downloading ".$self->toolurl($tool)); |
| 301 |
< |
# get into the cache |
| 302 |
< |
$self->{switch}->urlget($self->toolurl($tool)); |
| 303 |
< |
} |
| 304 |
< |
} |
| 298 |
> |
print "Downloading tool descriptions....","\n"; |
| 299 |
> |
print " "; |
| 300 |
> |
foreach $tool ( $self->tools() ) |
| 301 |
> |
{ |
| 302 |
> |
print "#"; |
| 303 |
> |
$self->verbose("Downloading ".$self->toolurl($tool)); |
| 304 |
> |
# get into the cache |
| 305 |
> |
$self->{switch}->urlget($self->toolurl($tool)); |
| 306 |
> |
} |
| 307 |
> |
print "\nDone.","\n","\n"; |
| 308 |
> |
} |
| 309 |
|
|
| 310 |
|
sub _autoselect { |
| 311 |
|
my $self=shift; |
| 335 |
|
sub Restrict_end { |
| 336 |
|
my $self=shift; |
| 337 |
|
my $name=shift; |
| 338 |
< |
|
| 338 |
> |
|
| 339 |
|
if ( $self->{Arch} ) { |
| 340 |
|
if ( $#{$self->{restrictstack}} >= 0 ) { |
| 341 |
|
$self->_autoselect(pop @{$self->{restrictstack}}); |
| 354 |
|
$self->{switch}->checktag( $name, $hashref, 'version'); |
| 355 |
|
$self->{switch}->checktag( $name, $hashref, 'name'); |
| 356 |
|
$self->{switch}->checktag( $name, $hashref, 'url'); |
| 357 |
< |
|
| 357 |
> |
|
| 358 |
|
if ( $self->{reqcontext} == 1 ) { |
| 359 |
|
$self->{switch}->parseerror( |
| 360 |
< |
"Open new $name conext without previous </$name>"); |
| 360 |
> |
"Open new $name context without previous </$name>"); |
| 361 |
|
} |
| 362 |
|
$self->{reqcontext}=1; |
| 363 |
|
$$hashref{'name'}=~tr[A-Z][a-z]; |
| 364 |
+ |
|
| 365 |
+ |
# Add tool to the tool array: |
| 366 |
|
push @{$self->{tools}}, $$hashref{'name'}; |
| 367 |
+ |
# Also add its' version: |
| 368 |
|
$self->{version}{$$hashref{'name'}}=$$hashref{'version'}; |
| 369 |
+ |
|
| 370 |
|
# -- make sure the full url is taken |
| 371 |
|
my $urlobj=$self->{switch}->expandurl($$hashref{'url'}); |
| 372 |
|
$self->{url}{$$hashref{'name'}}=$urlobj->url(); |
| 373 |
|
|
| 374 |
< |
# -- selection |
| 375 |
< |
if ( $self->{Arch} ) { |
| 376 |
< |
if ( $self->_autoselect() ) { |
| 377 |
< |
$self->{selected}{$$hashref{'name'}}=1; |
| 378 |
< |
} |
| 379 |
< |
else { |
| 380 |
< |
$self->{selected}{$$hashref{'name'}}=0; |
| 381 |
< |
} |
| 382 |
< |
} |
| 374 |
> |
# Disable the auto select mechanism. Now, we start with |
| 375 |
> |
# all tools having a flag "UNSELECTED". Then we choose |
| 376 |
> |
# which we wish to select: |
| 377 |
> |
if ( $self->{Arch} ) |
| 378 |
> |
{ |
| 379 |
> |
$self->{selected}{$$hashref{'name'}}="UNSELECTED"; |
| 380 |
> |
} |
| 381 |
> |
# Output the tool name here with the value |
| 382 |
> |
# of its' select flag: |
| 383 |
> |
$self->verbose(">> Tool name: ".$$hashref{'name'}." sel/desel flag value: ". |
| 384 |
> |
$self->{selected}{$$hashref{'name'}} ." "); |
| 385 |
> |
|
| 386 |
|
$self->{creqtool}=$$hashref{'name'}; |
| 387 |
|
$self->{creqversion}=$$hashref{'version'}; |
| 388 |
|
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=""; |
| 444 |
|
} |
| 445 |
|
} |
| 446 |
|
|
| 447 |
< |
sub Arch_Start { |
| 448 |
< |
my $self=shift; |
| 449 |
< |
my $name=shift; |
| 450 |
< |
my $hashref=shift; |
| 447 |
> |
sub Arch_Start |
| 448 |
> |
{ |
| 449 |
> |
my $self=shift; |
| 450 |
> |
my $name=shift; |
| 451 |
> |
my $hashref=shift; |
| 452 |
> |
# Check the architecture tag: |
| 453 |
> |
$self->{switch}->checktag($name, $hashref,'name'); |
| 454 |
> |
# Look for a match between the architecture flag read |
| 455 |
> |
# from the RequirementsDoc ($$hashref{name}) and scram arch: |
| 456 |
> |
#if ($self->arch() =~ /$$hashref{name}.*/) |
| 457 |
> |
# { |
| 458 |
> |
|
| 459 |
> |
# } |
| 460 |
> |
#elsif ($self->arch() =~ /$$hashref{name}/) |
| 461 |
> |
# { |
| 462 |
> |
# } |
| 463 |
> |
#else |
| 464 |
> |
# { |
| 465 |
> |
# } |
| 466 |
> |
( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1) |
| 467 |
> |
: ($self->{Arch}=0); |
| 468 |
> |
# ( ($self->arch()=~/$$hashref{name}[BLAH]/) )? ($self->{Arch}=1) |
| 469 |
> |
# : ($self->{Arch}=0); |
| 470 |
|
|
| 471 |
< |
$self->{switch}->checktag($name, $hashref,'name'); |
| 472 |
< |
|
| 473 |
< |
( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1) |
| 474 |
< |
: ($self->{Arch}=0); |
| 475 |
< |
$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name}); |
| 352 |
< |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
| 353 |
< |
push @{$self->{ArchStack}}, $$hashref{'name'}; |
| 354 |
< |
} |
| 471 |
> |
|
| 472 |
> |
$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name}); |
| 473 |
> |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
| 474 |
> |
push @{$self->{ArchStack}}, $$hashref{'name'}; |
| 475 |
> |
} |
| 476 |
|
|
| 477 |
|
sub Arch_End { |
| 478 |
|
my $self=shift; |
