| 28 |
|
bless $self, $class; |
| 29 |
|
$self->{cache}=shift; |
| 30 |
|
$self->{mydoctype}="BuildSystem::ToolDoc"; |
| 31 |
< |
$self->{mydocversion}="1.0"; |
| 31 |
> |
$self->{mydocversion}="1.1"; |
| 32 |
|
$self->init(); |
| 33 |
|
return $self; |
| 34 |
|
} |
| 36 |
|
sub init { |
| 37 |
|
my $self=shift; |
| 38 |
|
$self->{switch}=ActiveDoc::SimpleDoc->new(); |
| 39 |
+ |
$self->{switch}->newparse("setupinit"); |
| 40 |
+ |
$self->{switch}->addtag("setupinit","Tool",\&Tool_Start, $self, |
| 41 |
+ |
"", $self, |
| 42 |
+ |
\&Tool_End, $self); |
| 43 |
+ |
$self->{switch}->addtag("setupinit", "Architecture", |
| 44 |
+ |
\&Arch_Start,$self, |
| 45 |
+ |
"", $self, |
| 46 |
+ |
\&Arch_End,$self); |
| 47 |
+ |
$self->{switch}->addtag("setupinit","Environment", |
| 48 |
+ |
\&Environment_init, $self, |
| 49 |
+ |
"", $self, |
| 50 |
+ |
"", $self); |
| 51 |
+ |
$self->{switch}->grouptag("Tool","setupinit"); |
| 52 |
+ |
|
| 53 |
|
$self->{switch}->newparse("setup"); |
| 54 |
|
$self->{switch}->addtag("setup","Tool",\&Tool_Start, $self, |
| 55 |
|
"", $self, |
| 67 |
|
\&Environment_Start, $self, |
| 68 |
|
\&Env_text, $self, |
| 69 |
|
\&Environment_End, $self); |
| 70 |
+ |
$self->{switch}->addtag("setup","Makefile", |
| 71 |
+ |
\&Makefile_Start, $self, |
| 72 |
+ |
\&Makefile_text, $self, |
| 73 |
+ |
\&Makefile_end, $self); |
| 74 |
|
$self->{switch}->grouptag("Tool","setup"); |
| 75 |
|
$self->{switch}->addtag("setup","Architecture", |
| 76 |
|
\&Arch_Start,$self, |
| 95 |
|
|
| 96 |
|
sub toolsearcher { |
| 97 |
|
my $self=shift; |
| 98 |
+ |
|
| 99 |
|
if ( @_ ) { |
| 100 |
|
my $searcher=shift; |
| 101 |
|
if ( ! defined $searcher ) { |
| 112 |
|
my $file=shift; |
| 113 |
|
my $name=shift; |
| 114 |
|
my $version=shift; |
| 115 |
+ |
my $toolbox=shift; |
| 116 |
|
|
| 117 |
|
$self->{ToolEnv}{'SCRAMtoolname'}=$name; |
| 118 |
|
$self->{ToolEnv}{'SCRAMtoolversion'}=$version; |
| 125 |
|
$self->{toolfound}=1; |
| 126 |
|
# -- check the type of document - can we parse it? |
| 127 |
|
my($doctype,$docversion)=$self->{switch}->doctype(); |
| 128 |
< |
if ( ($doctype ne $self->{mydoctype}) || |
| 129 |
< |
($self->{mydocversion} ne $docversion) ) { |
| 128 |
> |
if (($doctype ne $self->{mydoctype}) || |
| 129 |
> |
(($self->{mydocversion} ne $docversion) && ($docversion ne "1.0")) ) { |
| 130 |
|
$self->error("Unable to Parse Document of type $doctype $docversion". |
| 131 |
|
"\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")"); |
| 132 |
|
} |
| 133 |
+ |
delete $self->{envcount}; |
| 134 |
+ |
$self->verbose("Pre-Parse"); |
| 135 |
+ |
$self->{switch}->parse("setupinit"); |
| 136 |
+ |
$self->{toolmakefile}=$toolbox->toolmakefile($name,$version); |
| 137 |
+ |
$self->verbose("Setup Parse"); |
| 138 |
|
$self->{switch}->parse("setup"); |
| 139 |
+ |
undef $self->{toolmakefilefh}; |
| 140 |
|
return $self->{toolfound}; |
| 141 |
|
} |
| 142 |
|
|
| 171 |
|
my $self=shift; |
| 172 |
|
my $default=shift; |
| 173 |
|
my $testfiles=shift; |
| 174 |
+ |
|
| 175 |
|
my $OK='false'; |
| 176 |
|
my $file; |
| 177 |
|
|
| 178 |
|
chomp $default; |
| 179 |
|
$default=$self->_expandvars($default); |
| 180 |
+ |
$self->verbose("Testing location"); |
| 181 |
|
print "Trying $default .... "; |
| 182 |
|
if ( -f $default ) { |
| 183 |
|
$OK="true"; |
| 184 |
+ |
$self->verbose("File OK"); |
| 185 |
|
} |
| 186 |
|
else { |
| 187 |
< |
my $fh=FileHandle->new(); |
| 188 |
< |
opendir $fh, $default or do { print "No \n"; return 0; }; |
| 187 |
> |
my $dh=DirHandle->new(); |
| 188 |
> |
opendir $dh, $default or do { print "No $!\n"; return 0; }; |
| 189 |
|
($#{$testfiles}==-1) ? $OK='false' : $OK='true'; |
| 190 |
|
print "\n"; |
| 191 |
< |
my @files=readdir $fh; |
| 192 |
< |
undef $fh; |
| 191 |
> |
my @files=readdir $dh; |
| 192 |
> |
undef $dh; |
| 193 |
|
foreach $file ( @$testfiles ) { |
| 194 |
|
print " Checking for $file .... "; |
| 195 |
|
# now check that the required files are actually there |
| 202 |
|
} |
| 203 |
|
} |
| 204 |
|
if ( $OK eq 'true' ) { |
| 205 |
< |
print "Directory Check Complete\n"; |
| 205 |
> |
print "Existence Check Complete\n"; |
| 206 |
|
return 1 |
| 207 |
|
} |
| 208 |
|
return 0 |
| 240 |
|
my @items=@_; |
| 241 |
|
|
| 242 |
|
my $path=-1; |
| 243 |
< |
while ( ($path!~/^\d+$/) || ($path > $#items) || ($path < 0) ) { |
| 243 |
> |
my $n; |
| 244 |
> |
while ( ($path!~/^\d+$/) || ($path > ($#items+1)) || ($path < 1) ) { |
| 245 |
|
for (my $i=0; $i<=$#items; $i++ ) { |
| 246 |
< |
print $i.") ".$items[$i]."\n"; |
| 246 |
> |
$n=$i+1; |
| 247 |
> |
print $n.") ".$items[$i]."\n"; |
| 248 |
|
} |
| 249 |
|
print "\n".$querystring; |
| 250 |
|
$path=<STDIN>; |
| 251 |
|
chomp $path; |
| 252 |
|
} |
| 253 |
+ |
$path--; |
| 254 |
|
return $path; |
| 255 |
|
} |
| 256 |
|
|
| 259 |
|
my $querystring=shift; |
| 260 |
|
my $varname=shift; |
| 261 |
|
|
| 262 |
+ |
my $type=$self->{tool}->type($varname); |
| 263 |
+ |
my $path; |
| 264 |
+ |
my $oldpath; |
| 265 |
|
print $self->featuretext($self->{EnvContext}); |
| 266 |
|
for ( ;; ) { |
| 267 |
|
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
| 268 |
|
$path=<STDIN>; |
| 269 |
|
chomp $path; |
| 270 |
+ |
$oldpath=$path; |
| 271 |
|
if ( $path ne "" ) { |
| 272 |
< |
if ( defined $self->{'client'}) { # must be a location |
| 273 |
< |
if ( $self->_testlocation($path , "H", $Envtype{$type} )) { |
| 274 |
< |
return $path; |
| 275 |
< |
} |
| 276 |
< |
print "Error : ".$path." does not exist.\n"; |
| 241 |
< |
next; |
| 242 |
< |
} |
| 243 |
< |
} |
| 244 |
< |
else { |
| 245 |
< |
return $path; |
| 272 |
> |
($path)=$self->_validateparam($type,$path); |
| 273 |
> |
if ( ! defined $path ) { |
| 274 |
> |
print "Error : ".$oldpath." is not valid.\n"; |
| 275 |
> |
next; |
| 276 |
> |
} |
| 277 |
|
} |
| 278 |
+ |
return $path; |
| 279 |
|
} #end for |
| 280 |
|
|
| 281 |
|
} |
| 282 |
|
|
| 283 |
+ |
sub _validateparam { |
| 284 |
+ |
my $self=shift; |
| 285 |
+ |
my $type=shift; |
| 286 |
+ |
my @params=@_; |
| 287 |
+ |
|
| 288 |
+ |
my @newparams=(); |
| 289 |
+ |
foreach $param ( @params ) { |
| 290 |
+ |
if ( defined $self->{'client'}) { # must be a location |
| 291 |
+ |
if ( $self->_testlocation($param , |
| 292 |
+ |
[ $self->{tool}->getfeature($type)] )) { |
| 293 |
+ |
$self->verbose("$param passed validation"); |
| 294 |
+ |
push @newparams,$param; |
| 295 |
+ |
} |
| 296 |
+ |
else { |
| 297 |
+ |
$self->verbose("$param failed validation"); |
| 298 |
+ |
} |
| 299 |
+ |
} |
| 300 |
+ |
else { |
| 301 |
+ |
# --- no other tests to pass so it must be OK |
| 302 |
+ |
push @newparams,$param; |
| 303 |
+ |
} |
| 304 |
+ |
} |
| 305 |
+ |
return @newparams; |
| 306 |
+ |
} |
| 307 |
+ |
|
| 308 |
|
# |
| 309 |
|
# Propgate through the searcher collecting matching tools |
| 310 |
|
# |
| 311 |
|
sub _searchtools { |
| 312 |
|
my $self=shift; |
| 313 |
|
my $tool=shift; |
| 314 |
+ |
my $searcher=shift; |
| 315 |
|
|
| 316 |
|
my @tools=(); |
| 317 |
|
my $area; |
| 318 |
|
my $rtool; |
| 319 |
< |
if ( defined $self->{toolboxsearcher} ) { |
| 320 |
< |
my $it=$self->{toolboxsearcher}->newiterator(); |
| 321 |
< |
while ( ! $it->last() ) { |
| 319 |
> |
my $it=$searcher->newiterator(); |
| 320 |
> |
|
| 321 |
> |
while ( ! $it->last() ) { |
| 322 |
|
$area=$it->next(); |
| 323 |
|
if ( defined $area ) { |
| 324 |
|
$self->verbose("Searching for ".$tool->name()." ". |
| 334 |
|
.$rtool->version()); |
| 335 |
|
} |
| 336 |
|
} |
| 337 |
+ |
else { |
| 338 |
+ |
$self->verbose("Tool Passed as Undefined"); |
| 339 |
+ |
} |
| 340 |
|
} |
| 341 |
|
else { |
| 342 |
|
$self->verbose("Area passed is not defined"); |
| 343 |
|
} |
| 283 |
– |
} |
| 344 |
|
} |
| 345 |
|
return @tools; |
| 346 |
|
} |
| 355 |
|
my $rv=0; |
| 356 |
|
my @params=(); |
| 357 |
|
$self->verbose("Check Other Projects for tool"); |
| 358 |
< |
my @validtools=$self->_searchtools($tool); |
| 359 |
< |
if ( ! $self->interactive() ) { |
| 360 |
< |
if ( $#validtools >=0 ) { |
| 358 |
> |
my @validtools=(); |
| 359 |
> |
if ( defined $self->{toolboxsearcher} ) { |
| 360 |
> |
@validtools=$self->_searchtools($tool,$self->{toolboxsearcher}); |
| 361 |
> |
} |
| 362 |
> |
if ( $#validtools >=0 ) { |
| 363 |
> |
if ( ! $self->interactive() ) { |
| 364 |
|
@params=$validtools[0]->getfeature($param); |
| 365 |
|
if ( $#params >=0 ) { |
| 366 |
|
$self->verbose("Extracting Feature $param from tool". |
| 367 |
|
" (= @params )\n"); |
| 305 |
– |
#$tool->setfeature($param,@params); |
| 368 |
|
$rv=1; |
| 369 |
|
} |
| 370 |
|
} |
| 372 |
|
return ($rv,@params); |
| 373 |
|
} |
| 374 |
|
|
| 375 |
+ |
sub _getparamsets { |
| 376 |
+ |
my $self=shift; |
| 377 |
+ |
my $tool=shift; |
| 378 |
+ |
my $param=shift; |
| 379 |
+ |
|
| 380 |
+ |
my @paramlist=(); |
| 381 |
+ |
my @params=(); |
| 382 |
+ |
$self->verbose("Searching for parameter settings in other tools"); |
| 383 |
+ |
my @validtools=(); |
| 384 |
+ |
if ( defined $self->{toolboxsearcher} ) { |
| 385 |
+ |
@validtools=$self->_searchtools($tool,$self->{toolboxsearcher}); |
| 386 |
+ |
} |
| 387 |
+ |
else { |
| 388 |
+ |
$self->verbose("No tool searcher available"); |
| 389 |
+ |
} |
| 390 |
+ |
if ( $#validtools >=0 ) { |
| 391 |
+ |
foreach $t ( @validtools ) { |
| 392 |
+ |
@params=$t->getfeature($param); |
| 393 |
+ |
if ( $#params >=0 ) { |
| 394 |
+ |
push @paramlist, [ @params ]; |
| 395 |
+ |
$self->verbose("Found @params"); |
| 396 |
+ |
} |
| 397 |
+ |
} |
| 398 |
+ |
} |
| 399 |
+ |
return @paramlist; |
| 400 |
+ |
} |
| 401 |
+ |
|
| 402 |
|
# -- Tag Routines |
| 403 |
|
|
| 404 |
|
sub Client_start { |
| 452 |
|
$self->{switch}->closegroup("Toolactive"); |
| 453 |
|
} |
| 454 |
|
|
| 455 |
+ |
sub Makefile_Start { |
| 456 |
+ |
my $self=shift; |
| 457 |
+ |
my $name=shift; |
| 458 |
+ |
my $hashref=shift; |
| 459 |
+ |
|
| 460 |
+ |
if ( $self->{Arch} ) { |
| 461 |
+ |
if ( ! defined $self->{toolmakefilefh} ) { |
| 462 |
+ |
$self->{toolmakefilefh}=FileHandle->new(); |
| 463 |
+ |
$self->{toolmakefilefh}->open(">".$self->{toolmakefile}); |
| 464 |
+ |
} |
| 465 |
+ |
} |
| 466 |
+ |
} |
| 467 |
+ |
|
| 468 |
+ |
sub Makefile_text { |
| 469 |
+ |
my $self=shift; |
| 470 |
+ |
my $name=shift; |
| 471 |
+ |
my $string=shift; |
| 472 |
+ |
|
| 473 |
+ |
if ( $self->{Arch} ) { |
| 474 |
+ |
print {$self->{toolmakefilefh}} $string; |
| 475 |
+ |
} |
| 476 |
+ |
} |
| 477 |
+ |
|
| 478 |
+ |
sub Makefile_end { |
| 479 |
+ |
my $self=shift; |
| 480 |
+ |
my $name=shift; |
| 481 |
+ |
my $hashref=shift; |
| 482 |
+ |
|
| 483 |
+ |
if ( $self->{Arch} ) { |
| 484 |
+ |
print {$self->{toolmakefilefh}} "\n"; |
| 485 |
+ |
} |
| 486 |
+ |
} |
| 487 |
+ |
|
| 488 |
+ |
# -- collect number of variables of the same name - need to know how many |
| 489 |
+ |
# before main setup processing |
| 490 |
+ |
sub Environment_init { |
| 491 |
+ |
my $self=shift; |
| 492 |
+ |
my $name=shift; |
| 493 |
+ |
my $hashref=shift; |
| 494 |
+ |
|
| 495 |
+ |
$self->{switch}->checktag($name, $hashref, 'name'); |
| 496 |
+ |
if ( $self->{Arch} ) { |
| 497 |
+ |
if ( exists $self->{envcount}{$$hashref{'name'}} ) { |
| 498 |
+ |
$self->{envcount}{$$hashref{'name'}}++; |
| 499 |
+ |
} |
| 500 |
+ |
else { |
| 501 |
+ |
$self->{envcount}{$$hashref{'name'}}=0; |
| 502 |
+ |
} |
| 503 |
+ |
} |
| 504 |
+ |
} |
| 505 |
+ |
|
| 506 |
|
sub Environment_Start { |
| 507 |
|
my $self=shift; |
| 508 |
|
my $name=shift; |
| 509 |
|
my $hashref=shift; |
| 510 |
< |
|
| 510 |
> |
|
| 511 |
|
$self->{switch}->checktag($name, $hashref, 'name'); |
| 512 |
|
if ( $self->{Arch} ) { |
| 513 |
+ |
my $val=undef; |
| 514 |
|
if ( defined $self->{EnvContext} ) { |
| 515 |
|
$self->parserror(" Attempted to open new <$name> context". |
| 516 |
|
" without closing the previous one"); |
| 517 |
|
} |
| 518 |
+ |
# -- keep a counter of the number of times we see this variable |
| 519 |
+ |
if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} ) { |
| 520 |
+ |
$self->{EnvironmentCount}{$$hashref{'name'}}++; |
| 521 |
+ |
} |
| 522 |
+ |
else { |
| 523 |
+ |
$self->{EnvironmentCount}{$$hashref{'name'}}=0; |
| 524 |
+ |
} |
| 525 |
+ |
|
| 526 |
|
$self->{currentenvtext}=""; |
| 527 |
|
$self->{EnvContext}=$$hashref{'name'}; |
| 528 |
|
undef $self->{Envvalue}; |
| 530 |
|
$$hashref{'type'}=~tr[A-Z][a-z]; |
| 531 |
|
$self->{tool}->type($$hashref{'name'},$$hashref{'type'}); |
| 532 |
|
} |
| 533 |
+ |
# check other installed copies of the tool |
| 534 |
+ |
# -- construct a menu of options |
| 535 |
+ |
my @menulist=(); |
| 536 |
+ |
# -- a value is fixed - unless interactive switch is on |
| 537 |
|
if ( exists $$hashref{'value'}) { |
| 538 |
< |
$self->{Envvalue}=$$hashref{'value'}; |
| 538 |
> |
$val=$$hashref{'value'}; |
| 539 |
> |
if ( $self->interactive() ) { |
| 540 |
> |
unshift @menulist,$$hashref{'value'}; |
| 541 |
> |
} |
| 542 |
|
} |
| 543 |
< |
elsif ( ! $self->interactive() ) { |
| 544 |
< |
# check other installed copies of the tool |
| 545 |
< |
my ($rv,@params)= |
| 546 |
< |
$self->_toolparamcopy($self->{tool},$$hashref{'name'}); |
| 547 |
< |
if ( $rv && ($#params == 0)) { #dont use multivalued params! |
| 548 |
< |
# -- if default is OK as well ask user which one to choose |
| 549 |
< |
my $val=$params[0]; |
| 550 |
< |
if ( $self->_checkdefault($hashref) ) { |
| 551 |
< |
# -- many options - just ask the user |
| 552 |
< |
my $expdef=$self->_expandvars($$hashref{'default'}); |
| 553 |
< |
if ( $expdef ne $val ) { |
| 554 |
< |
my $in=$self->_askusermenu( |
| 555 |
< |
"Multiple possibilities found. Please Choose:", |
| 400 |
< |
($params[0],$expdef,"Other")); |
| 401 |
< |
if ( $in == 1 ) { |
| 402 |
< |
$val=$expdef; |
| 403 |
< |
} |
| 404 |
< |
elsif ( $in == 2 ) { |
| 405 |
< |
$val=$self->_askuser("Please Enter Value:",$$hashref{'name'}); |
| 406 |
< |
} |
| 407 |
< |
} |
| 408 |
< |
} |
| 409 |
< |
$self->{Envvalue}=$val; # single val parameter |
| 543 |
> |
# -- add any default values to the selection |
| 544 |
> |
if ( ! defined $val ) { |
| 545 |
> |
if ( $self->_checkdefault($hashref) ) { |
| 546 |
> |
my $var=$self->_expandvars($$hashref{'default'}); |
| 547 |
> |
if ( !grep { $_ eq $var } @menulist ) { |
| 548 |
> |
unshift @menulist, $var; |
| 549 |
> |
} |
| 550 |
> |
} |
| 551 |
> |
# -- check the environment |
| 552 |
> |
if ( defined $ENV{$$hashref{'name'}} ) { |
| 553 |
> |
if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) { |
| 554 |
> |
unshift @menulist, $ENV{$$hashref{'name'}}; |
| 555 |
> |
} |
| 556 |
|
} |
| 557 |
< |
elsif ( defined $ENV{$$hashref{'name'}} ) { |
| 558 |
< |
# check the environment |
| 559 |
< |
$self->{Envvalue}=$ENV{$$hashref{'name'}}; |
| 557 |
> |
my @paramlist=$self->_getparamsets($self->{tool}, |
| 558 |
> |
$$hashref{'name'}); |
| 559 |
> |
foreach $p ( @paramlist ) { |
| 560 |
> |
# -- only add them if there are the same number of variables |
| 561 |
> |
if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) { |
| 562 |
> |
if ( !grep {$_ eq $$p[$self->{EnvironmentCount} |
| 563 |
> |
{$$hashref{'name'}}] } @menulist) { |
| 564 |
> |
push @menulist,$$p[$self->{EnvironmentCount} |
| 565 |
> |
{$$hashref{'name'}}]; |
| 566 |
> |
} |
| 567 |
> |
} |
| 568 |
> |
else { |
| 569 |
> |
$self->verbose("Ignoring tool params - not the same number". |
| 570 |
> |
" defined (".$#{$p}." != ". |
| 571 |
> |
$self->{envcount}{$$hashref{'name'}}.")"); |
| 572 |
> |
} |
| 573 |
|
} |
| 574 |
< |
elsif ( $self->_checkdefault($hashref) ) { |
| 575 |
< |
$self->{Envvalue}=$$hashref{'default'}; |
| 574 |
> |
if ( $#menulist >=0 ) { |
| 575 |
> |
print "Validating Values for Variable : ".$$hashref{'name'}."\n"; |
| 576 |
> |
@menulist=$self->_validateparam($$hashref{'type'},@menulist); |
| 577 |
|
} |
| 578 |
+ |
# -- If theres only one option take it without asking |
| 579 |
+ |
if ( $#menulist == 0 && ( ! $self->interactive() )) { |
| 580 |
+ |
$val=$menulist[0]; |
| 581 |
+ |
} |
| 582 |
+ |
elsif ( $#menulist > 0 ) { |
| 583 |
+ |
my $in=$self->_askusermenu( |
| 584 |
+ |
"Multiple possibilities found for ". |
| 585 |
+ |
$$hashref{'name'}." ( occurance ". |
| 586 |
+ |
($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ". |
| 587 |
+ |
"\nPlease Choose: ", |
| 588 |
+ |
(@menulist,"Other")); |
| 589 |
+ |
if ( $in <=$#menulist ) { |
| 590 |
+ |
$val=$menulist[$in]; |
| 591 |
+ |
} |
| 592 |
+ |
else { |
| 593 |
+ |
undef $val; |
| 594 |
+ |
} |
| 595 |
+ |
} |
| 596 |
|
} |
| 597 |
+ |
$self->{Envvalue}=$val; # single val parameter |
| 598 |
|
} |
| 599 |
|
} |
| 600 |
|
|
| 670 |
|
pop @{$self->{ARCHBLOCK}}; |
| 671 |
|
$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}]; |
| 672 |
|
} |
| 494 |
– |
|
| 495 |
– |
|
