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 |
|
} |
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 |
+ |
|
141 |
|
return $self->{toolfound}; |
142 |
|
} |
143 |
|
|
168 |
|
return 0; |
169 |
|
} |
170 |
|
|
171 |
< |
sub _testlocation { |
172 |
< |
my $self=shift; |
173 |
< |
my $default=shift; |
174 |
< |
my $testfiles=shift; |
175 |
< |
|
176 |
< |
my $OK='false'; |
177 |
< |
my $file; |
171 |
> |
sub _testlocation |
172 |
> |
{ |
173 |
> |
my $self=shift; |
174 |
> |
my $default=shift; |
175 |
> |
my $testfiles=shift; |
176 |
> |
my $OK='false'; |
177 |
> |
my $file; |
178 |
> |
my $statusgood = $main::bold."OK".$main::normal; |
179 |
> |
my $statusbad = $main::bold."Not found".$main::normal; |
180 |
> |
|
181 |
> |
chomp $default; |
182 |
> |
$default=$self->_expandvars($default); |
183 |
> |
$self->verbose("Testing location"); |
184 |
> |
|
185 |
> |
if ( -f $default ) |
186 |
> |
{ |
187 |
> |
$OK="true"; |
188 |
> |
$self->verbose("File OK"); |
189 |
> |
} |
190 |
> |
else |
191 |
> |
{ |
192 |
> |
my $dh=DirHandle->new(); |
193 |
> |
|
194 |
> |
opendir $dh, $default or do |
195 |
> |
{ |
196 |
> |
printf ("\nTrying %-s ...... >> %s <<\n",$default,$main::bold.$!.$main::normal); |
197 |
> |
return 0; |
198 |
> |
}; |
199 |
> |
|
200 |
> |
($#{$testfiles}==-1) ? $OK='false' : $OK='true'; |
201 |
> |
|
202 |
> |
my @files=readdir $dh; |
203 |
> |
undef $dh; |
204 |
> |
|
205 |
> |
foreach $file ( @$testfiles ) |
206 |
> |
{ |
207 |
> |
# now check that the required files are actually there |
208 |
> |
if ( ( $number = grep /\Q$file\L/, @files) == 0 ) |
209 |
> |
{ |
210 |
> |
$OK='false'; |
211 |
> |
$status = $statusbad; |
212 |
> |
last; |
213 |
> |
} |
214 |
> |
$status = $statusgood; |
215 |
|
|
216 |
< |
chomp $default; |
217 |
< |
$default=$self->_expandvars($default); |
218 |
< |
$self->verbose("Testing location"); |
219 |
< |
print "Trying $default .... "; |
220 |
< |
if ( -f $default ) { |
221 |
< |
$OK="true"; |
222 |
< |
$self->verbose("File OK"); |
223 |
< |
} |
224 |
< |
else { |
225 |
< |
my $dh=DirHandle->new(); |
226 |
< |
opendir $dh, $default or do { print "No $!\n"; return 0; }; |
227 |
< |
($#{$testfiles}==-1) ? $OK='false' : $OK='true'; |
228 |
< |
print "\n"; |
179 |
< |
my @files=readdir $dh; |
180 |
< |
undef $dh; |
181 |
< |
foreach $file ( @$testfiles ) { |
182 |
< |
print " Checking for $file .... "; |
183 |
< |
# now check that the required files are actually there |
184 |
< |
if ( ( $number = grep /\Q$file\L/, @files) == 0 ) { |
185 |
< |
$OK='false'; |
186 |
< |
print "not found\n"; |
187 |
< |
last; |
188 |
< |
} |
189 |
< |
print "found\n"; |
190 |
< |
} |
191 |
< |
} |
192 |
< |
if ( $OK eq 'true' ) { |
193 |
< |
print "Directory Check Complete\n"; |
194 |
< |
return 1 |
195 |
< |
} |
196 |
< |
return 0 |
197 |
< |
} |
216 |
> |
printf ("\t\tChecking for %-22s............ [%s]\n",$file,$status); |
217 |
> |
} |
218 |
> |
print "\n"; |
219 |
> |
} |
220 |
> |
|
221 |
> |
if ( $OK eq 'true' ) |
222 |
> |
{ |
223 |
> |
printf ("Existence check for %-30s ............ [%s]\n",$default.":",$statusgood); |
224 |
> |
return 1; |
225 |
> |
} |
226 |
> |
|
227 |
> |
return 0; |
228 |
> |
} |
229 |
|
|
230 |
|
sub _expandvars { |
231 |
|
my $self=shift; |
257 |
|
my $self=shift; |
258 |
|
my $querystring=shift; |
259 |
|
my @items=@_; |
260 |
< |
|
260 |
> |
|
261 |
|
my $path=-1; |
262 |
|
my $n; |
263 |
|
while ( ($path!~/^\d+$/) || ($path > ($#items+1)) || ($path < 1) ) { |
273 |
|
return $path; |
274 |
|
} |
275 |
|
|
276 |
< |
sub _askuser { |
277 |
< |
my $self=shift; |
278 |
< |
my $querystring=shift; |
279 |
< |
my $varname=shift; |
280 |
< |
|
281 |
< |
my $type=$self->{tool}->type($varname); |
282 |
< |
my $path; |
283 |
< |
my $oldpath; |
284 |
< |
print $self->featuretext($self->{EnvContext}); |
285 |
< |
for ( ;; ) { |
286 |
< |
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
287 |
< |
$path=<STDIN>; |
288 |
< |
chomp $path; |
276 |
> |
sub _askuser |
277 |
> |
{ |
278 |
> |
############################################################### |
279 |
> |
# _askuser() # |
280 |
> |
############################################################### |
281 |
> |
# modified : Mon Nov 19 15:51:01 2001 / SFA # |
282 |
> |
# params : # |
283 |
> |
# : # |
284 |
> |
# : # |
285 |
> |
# : # |
286 |
> |
# function : Looks for valid path to tool, either using a # |
287 |
> |
# : default path, or by using the lookup table. # |
288 |
> |
# : # |
289 |
> |
# : # |
290 |
> |
############################################################### |
291 |
> |
my $self=shift; |
292 |
> |
|
293 |
> |
# First, check for interactive flag. If "on", call the original |
294 |
> |
# version of this routine: |
295 |
> |
if ( $self->{interactive} ) |
296 |
> |
{ |
297 |
> |
my $ipath=$self->_askuseri(@_); |
298 |
> |
return $ipath; |
299 |
> |
} |
300 |
> |
|
301 |
> |
my $querystring=shift; |
302 |
> |
my $varname=shift; |
303 |
> |
my $lookupdb = $main::lookupobject; |
304 |
> |
my $type=$self->{tool}->type($varname); |
305 |
> |
my $path; |
306 |
> |
my $oldpath; |
307 |
> |
my $defaultpath = $lookupdb->lhcxxPath(); |
308 |
> |
|
309 |
> |
# Print the feature info: |
310 |
> |
print $self->featuretext($self->{EnvContext}); |
311 |
> |
|
312 |
> |
# Check if tool is listed in the lookupdb: |
313 |
> |
if ($lookupdb->checkTool(${$self->{tool}}{name})) |
314 |
> |
{ |
315 |
> |
$self->verbose(">> Tool ${$self->{tool}}{name} exists in DB..."); |
316 |
> |
# Check if $varname is a tag that's listed in our lookup table for this tool: |
317 |
> |
if ($lookupdb->lookupTag(${$self->{tool}}{name},$varname)) |
318 |
> |
{ |
319 |
> |
$self->verbose(">> Tag $varname is defined for tool ${$self->{tool}}{name}"); |
320 |
> |
# Get the value for this tag: |
321 |
> |
$path = $lookupdb->lookupTag(${$self->{tool}}{name},$varname); |
322 |
> |
} |
323 |
> |
else |
324 |
> |
# No known tag for this tool so try the default path: |
325 |
> |
{ |
326 |
> |
$path = $defaultpath; |
327 |
> |
} |
328 |
> |
} |
329 |
> |
# If the defaultpath is valid then try that: |
330 |
> |
elsif ( -d $defaultpath) |
331 |
> |
{ |
332 |
> |
$path = $defaultpath; |
333 |
> |
} |
334 |
> |
# We'll have to ask the user: |
335 |
> |
else |
336 |
> |
{ |
337 |
> |
# Infinite loop while there isn't a valid path: |
338 |
> |
for (;;) |
339 |
> |
{ |
340 |
> |
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
341 |
> |
$path=<STDIN>; |
342 |
> |
chomp $path; |
343 |
|
$oldpath=$path; |
344 |
< |
if ( $path ne "" ) { |
345 |
< |
($path)=$self->_validateparam($type,$path); |
346 |
< |
if ( ! defined $path ) { |
344 |
> |
|
345 |
> |
if ( $path ne "" ) |
346 |
> |
{ |
347 |
> |
($path)=$self->_validateparam($type,$path); |
348 |
> |
# If the path is not defined, print |
349 |
> |
# a message and repeat the prompt: |
350 |
> |
if ( ! defined $path ) |
351 |
> |
{ |
352 |
> |
print "Error : ".$oldpath." is not valid.\n"; |
353 |
> |
next; |
354 |
> |
} |
355 |
> |
} |
356 |
> |
return $path; |
357 |
> |
} |
358 |
> |
} |
359 |
> |
return $path; |
360 |
> |
} |
361 |
> |
|
362 |
> |
|
363 |
> |
sub _askuseri |
364 |
> |
{ |
365 |
> |
############################################################### |
366 |
> |
# _askuseri() # |
367 |
> |
############################################################### |
368 |
> |
# modified : Mon Nov 19 15:46:36 2001 / SFA # |
369 |
> |
# params : # |
370 |
> |
# : # |
371 |
> |
# : # |
372 |
> |
# : # |
373 |
> |
# function : Interactive version of askuser routine. Called # |
374 |
> |
# : when "-i" flag set in scramcli. # |
375 |
> |
# : # |
376 |
> |
# : # |
377 |
> |
############################################################### |
378 |
> |
my $self = shift; |
379 |
> |
my $querystring = shift; |
380 |
> |
my $varname = shift; |
381 |
> |
|
382 |
> |
my $type=$self->{tool}->type($varname); |
383 |
> |
my $path; |
384 |
> |
my $oldpath; |
385 |
> |
|
386 |
> |
print $self->featuretext($self->{EnvContext}); |
387 |
> |
|
388 |
> |
for ( ;; ) |
389 |
> |
{ |
390 |
> |
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
391 |
> |
$path=<STDIN>; |
392 |
> |
chomp $path; |
393 |
> |
$oldpath=$path; |
394 |
> |
|
395 |
> |
if ( $path ne "" ) |
396 |
> |
{ |
397 |
> |
($path)=$self->_validateparam($type,$path); |
398 |
> |
if ( ! defined $path ) |
399 |
> |
{ |
400 |
|
print "Error : ".$oldpath." is not valid.\n"; |
401 |
|
next; |
402 |
< |
} |
402 |
> |
} |
403 |
|
} |
404 |
< |
return $path; |
405 |
< |
} #end for |
404 |
> |
return $path; |
405 |
> |
} |
406 |
> |
} |
407 |
|
|
269 |
– |
} |
408 |
|
|
409 |
|
sub _validateparam { |
410 |
|
my $self=shift; |
443 |
|
my $area; |
444 |
|
my $rtool; |
445 |
|
my $it=$searcher->newiterator(); |
446 |
< |
|
446 |
> |
|
447 |
|
while ( ! $it->last() ) { |
448 |
|
$area=$it->next(); |
449 |
|
if ( defined $area ) { |
480 |
|
|
481 |
|
my $rv=0; |
482 |
|
my @params=(); |
483 |
+ |
|
484 |
|
$self->verbose("Check Other Projects for tool"); |
485 |
|
my @validtools=(); |
486 |
|
if ( defined $self->{toolboxsearcher} ) { |
506 |
|
|
507 |
|
my @paramlist=(); |
508 |
|
my @params=(); |
509 |
+ |
|
510 |
+ |
# Check for an override of the searcher. If the |
511 |
+ |
# variable SEARCHOVRD is set, we return an empty array: |
512 |
+ |
if ( $ENV{'SEARCHOVRD'} eq 'true' ) |
513 |
+ |
{ |
514 |
+ |
$self->verbose("Searching for tool settings from other projects OVERRIDDEN"); |
515 |
+ |
# This bypasses the menu option presented to the user when there is more than one |
516 |
+ |
# choice for the tool location: |
517 |
+ |
return @paramlist; |
518 |
+ |
} |
519 |
+ |
# Otherwise we proceed as normal: |
520 |
|
$self->verbose("Searching for parameter settings in other tools"); |
521 |
|
my @validtools=(); |
522 |
|
if ( defined $self->{toolboxsearcher} ) { |
523 |
< |
@validtools=$self->_searchtools($tool,$self->{toolboxsearcher}); |
524 |
< |
} |
523 |
> |
@validtools=$self->_searchtools($tool,$self->{toolboxsearcher}); |
524 |
> |
} |
525 |
|
else { |
526 |
|
$self->verbose("No tool searcher available"); |
527 |
|
} |
590 |
|
$self->{switch}->closegroup("Toolactive"); |
591 |
|
} |
592 |
|
|
593 |
+ |
sub Makefile_Start { |
594 |
+ |
my $self=shift; |
595 |
+ |
my $name=shift; |
596 |
+ |
my $hashref=shift; |
597 |
+ |
|
598 |
+ |
if ( $self->{Arch} ) { |
599 |
+ |
if ( ! defined $self->{toolmakefilefh} ) { |
600 |
+ |
$self->{toolmakefilefh}=FileHandle->new(); |
601 |
+ |
$self->{toolmakefilefh}->open(">".$self->{toolmakefile}); |
602 |
+ |
} |
603 |
+ |
} |
604 |
+ |
} |
605 |
+ |
|
606 |
+ |
sub Makefile_text { |
607 |
+ |
my $self=shift; |
608 |
+ |
my $name=shift; |
609 |
+ |
my $string=shift; |
610 |
+ |
|
611 |
+ |
if ( $self->{Arch} ) { |
612 |
+ |
print {$self->{toolmakefilefh}} $string; |
613 |
+ |
} |
614 |
+ |
} |
615 |
+ |
|
616 |
+ |
sub Makefile_end { |
617 |
+ |
my $self=shift; |
618 |
+ |
my $name=shift; |
619 |
+ |
my $hashref=shift; |
620 |
+ |
|
621 |
+ |
if ( $self->{Arch} ) { |
622 |
+ |
print {$self->{toolmakefilefh}} "\n"; |
623 |
+ |
} |
624 |
+ |
} |
625 |
+ |
|
626 |
|
# -- collect number of variables of the same name - need to know how many |
627 |
|
# before main setup processing |
628 |
|
sub Environment_init { |
641 |
|
} |
642 |
|
} |
643 |
|
|
644 |
< |
sub Environment_Start { |
645 |
< |
my $self=shift; |
646 |
< |
my $name=shift; |
647 |
< |
my $hashref=shift; |
648 |
< |
|
649 |
< |
$self->{switch}->checktag($name, $hashref, 'name'); |
650 |
< |
if ( $self->{Arch} ) { |
468 |
< |
my $val=undef; |
469 |
< |
if ( defined $self->{EnvContext} ) { |
470 |
< |
$self->parserror(" Attempted to open new <$name> context". |
471 |
< |
" without closing the previous one"); |
472 |
< |
} |
473 |
< |
# -- keep a counter of the number of times we see this variable |
474 |
< |
if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} ) { |
475 |
< |
$self->{EnvironmentCount}{$$hashref{'name'}}++; |
476 |
< |
} |
477 |
< |
else { |
478 |
< |
$self->{EnvironmentCount}{$$hashref{'name'}}=0; |
479 |
< |
} |
644 |
> |
sub Environment_Start |
645 |
> |
{ |
646 |
> |
my $self=shift; |
647 |
> |
my $name=shift; |
648 |
> |
my $hashref=shift; |
649 |
> |
|
650 |
> |
$self->{switch}->checktag($name, $hashref, 'name'); |
651 |
|
|
652 |
< |
$self->{currentenvtext}=""; |
653 |
< |
$self->{EnvContext}=$$hashref{'name'}; |
654 |
< |
undef $self->{Envvalue}; |
655 |
< |
if ( exists $$hashref{'type'} ) { |
656 |
< |
$$hashref{'type'}=~tr[A-Z][a-z]; |
657 |
< |
$self->{tool}->type($$hashref{'name'},$$hashref{'type'}); |
658 |
< |
} |
659 |
< |
# check other installed copies of the tool |
660 |
< |
# -- construct a menu of options |
661 |
< |
my @menulist=(); |
662 |
< |
# -- a value is fixed - unless interactive switch is on |
663 |
< |
if ( exists $$hashref{'value'}) { |
664 |
< |
$val=$$hashref{'value'}; |
665 |
< |
if ( $self->interactive() ) { |
666 |
< |
unshift @menulist,$$hashref{'value'}; |
652 |
> |
if ( $self->{Arch} ) |
653 |
> |
{ |
654 |
> |
my $val=undef; |
655 |
> |
if ( defined $self->{EnvContext} ) |
656 |
> |
{ |
657 |
> |
$self->parserror(" Attempted to open new <$name> context". |
658 |
> |
" without closing the previous one"); |
659 |
> |
} |
660 |
> |
# -- keep a counter of the number of times we see this variable |
661 |
> |
if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} ) |
662 |
> |
{ |
663 |
> |
$self->{EnvironmentCount}{$$hashref{'name'}}++; |
664 |
> |
} |
665 |
> |
else |
666 |
> |
{ |
667 |
> |
$self->{EnvironmentCount}{$$hashref{'name'}}=0; |
668 |
> |
} |
669 |
> |
|
670 |
> |
$self->{currentenvtext}=""; |
671 |
> |
$self->{EnvContext}=$$hashref{'name'}; |
672 |
> |
undef $self->{Envvalue}; |
673 |
> |
|
674 |
> |
if ( exists $$hashref{'type'} ) |
675 |
> |
{ |
676 |
> |
$$hashref{'type'}=~tr[A-Z][a-z]; |
677 |
> |
$self->{tool}->type($$hashref{'name'},$$hashref{'type'}); |
678 |
> |
} |
679 |
> |
# check other installed copies of the tool |
680 |
> |
# -- construct a menu of options |
681 |
> |
my @menulist=(); |
682 |
> |
# -- a value is fixed - unless interactive switch is on |
683 |
> |
if ( exists $$hashref{'value'}) |
684 |
> |
{ |
685 |
> |
$val=$$hashref{'value'}; |
686 |
> |
if ( $self->interactive() ) |
687 |
> |
{ |
688 |
> |
unshift @menulist,$$hashref{'value'}; |
689 |
|
} |
690 |
< |
} |
691 |
< |
# -- add any default values to the selection |
692 |
< |
if ( ! defined $val ) { |
693 |
< |
if ( $self->_checkdefault($hashref) ) { |
694 |
< |
my $var=$self->_expandvars($$hashref{'default'}); |
695 |
< |
if ( !grep { $_ eq $var } @menulist ) { |
696 |
< |
unshift @menulist, $var; |
697 |
< |
} |
698 |
< |
} |
699 |
< |
# -- check the environment |
700 |
< |
if ( defined $ENV{$$hashref{'name'}} ) { |
701 |
< |
if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) { |
702 |
< |
unshift @menulist, $ENV{$$hashref{'name'}}; |
703 |
< |
} |
704 |
< |
} |
705 |
< |
my @paramlist=$self->_getparamsets($self->{tool}, |
706 |
< |
$$hashref{'name'}); |
707 |
< |
foreach $p ( @paramlist ) { |
708 |
< |
# -- only add them if there are the same number of variables |
709 |
< |
if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) { |
710 |
< |
if ( !grep {$_ eq $$p[$self->{EnvironmentCount} |
711 |
< |
{$$hashref{'name'}}] } @menulist) { |
712 |
< |
push @menulist,$$p[$self->{EnvironmentCount} |
713 |
< |
{$$hashref{'name'}}]; |
714 |
< |
} |
715 |
< |
} |
716 |
< |
else { |
717 |
< |
$self->verbose("Ignoring tool params - not the same number". |
718 |
< |
" defined (".$#{$p}." != ". |
719 |
< |
$self->{envcount}{$$hashref{'name'}}.")"); |
720 |
< |
} |
721 |
< |
} |
722 |
< |
if ( $#menulist >=0 ) { |
723 |
< |
print "Validating Values for Variable : ".$$hashref{'name'}."\n"; |
690 |
> |
} |
691 |
> |
# -- add any default values to the selection |
692 |
> |
if ( ! defined $val ) |
693 |
> |
{ |
694 |
> |
if ( $self->_checkdefault($hashref) ) |
695 |
> |
{ |
696 |
> |
my $var=$self->_expandvars($$hashref{'default'}); |
697 |
> |
if ( !grep { $_ eq $var } @menulist ) |
698 |
> |
{ |
699 |
> |
unshift @menulist, $var; |
700 |
> |
} |
701 |
> |
} |
702 |
> |
# -- check the environment |
703 |
> |
if ( defined $ENV{$$hashref{'name'}} ) |
704 |
> |
{ |
705 |
> |
if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) |
706 |
> |
{ |
707 |
> |
unshift @menulist, $ENV{$$hashref{'name'}}; |
708 |
> |
} |
709 |
> |
} |
710 |
> |
my @paramlist=$self->_getparamsets($self->{tool}, |
711 |
> |
$$hashref{'name'}); |
712 |
> |
foreach $p ( @paramlist ) |
713 |
> |
{ |
714 |
> |
# -- only add them if there are the same number of variables |
715 |
> |
if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) |
716 |
> |
{ |
717 |
> |
if ( !grep {$_ eq $$p[$self->{EnvironmentCount} |
718 |
> |
{$$hashref{'name'}}] } @menulist) |
719 |
> |
{ |
720 |
> |
push @menulist,$$p[$self->{EnvironmentCount} |
721 |
> |
{$$hashref{'name'}}]; |
722 |
> |
} |
723 |
> |
} |
724 |
> |
else |
725 |
> |
{ |
726 |
> |
$self->verbose("Ignoring tool params - not the same number". |
727 |
> |
" defined (".$#{$p}." != ". |
728 |
> |
$self->{envcount}{$$hashref{'name'}}.")"); |
729 |
> |
} |
730 |
> |
} |
731 |
> |
if ( $#menulist >=0 ) |
732 |
> |
{ |
733 |
> |
print "Validating Values for Variable: ".$$hashref{'name'}."\n"; |
734 |
|
@menulist=$self->_validateparam($$hashref{'type'},@menulist); |
735 |
< |
} |
736 |
< |
# -- If theres only one option take it without asking |
737 |
< |
if ( $#menulist == 0 && ( ! $self->interactive() )) { |
738 |
< |
$val=$menulist[0]; |
739 |
< |
} |
740 |
< |
elsif ( $#menulist > 0 ) { |
741 |
< |
my $in=$self->_askusermenu( |
742 |
< |
"Multiple possibilities found for ". |
743 |
< |
$$hashref{'name'}." ( occurance ". |
744 |
< |
($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ". |
745 |
< |
"\nPlease Choose: ", |
746 |
< |
(@menulist,"Other")); |
747 |
< |
if ( $in <=$#menulist ) { |
748 |
< |
$val=$menulist[$in]; |
749 |
< |
} |
750 |
< |
else { |
751 |
< |
undef $val; |
752 |
< |
} |
753 |
< |
} |
754 |
< |
} |
755 |
< |
$self->{Envvalue}=$val; # single val parameter |
756 |
< |
} |
757 |
< |
} |
735 |
> |
} |
736 |
> |
print "\n"; |
737 |
> |
# -- If theres only one option take it without asking |
738 |
> |
if ( $#menulist == 0 && ( ! $self->interactive() )) |
739 |
> |
{ |
740 |
> |
$val=$menulist[0]; |
741 |
> |
} |
742 |
> |
elsif ( $#menulist > 0 ) |
743 |
> |
{ |
744 |
> |
my $in=$self->_askusermenu( |
745 |
> |
"Multiple possibilities found for ". |
746 |
> |
$$hashref{'name'}." ( occurrence ". |
747 |
> |
($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ". |
748 |
> |
"\nPlease Choose: ", |
749 |
> |
(@menulist,"Other")); |
750 |
> |
if ( $in <=$#menulist ) |
751 |
> |
{ |
752 |
> |
$val=$menulist[$in]; |
753 |
> |
} |
754 |
> |
else |
755 |
> |
{ |
756 |
> |
undef $val; |
757 |
> |
} |
758 |
> |
} |
759 |
> |
} |
760 |
> |
$self->{Envvalue}=$val; # single val parameter |
761 |
> |
} |
762 |
> |
} |
763 |
|
|
764 |
|
sub Env_text { |
765 |
|
my $self=shift; |
771 |
|
} |
772 |
|
} |
773 |
|
|
774 |
< |
sub Environment_End { |
775 |
< |
my $self=shift; |
776 |
< |
my $name=shift; |
777 |
< |
|
778 |
< |
if ( $self->{Arch} ) { |
779 |
< |
if ( ! defined $self->{EnvContext} ) { |
780 |
< |
$self->{switch}->parseerror("</$name> without an opening context"); |
781 |
< |
} |
782 |
< |
# - set the help text |
783 |
< |
$self->featuretext($self->{EnvContext},$self->{currentenvtext}); |
784 |
< |
if ( ! defined $self->{Envvalue} ) { |
785 |
< |
$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:", |
786 |
< |
$self->{EnvContext}); |
787 |
< |
} |
788 |
< |
$self->{Envvalue}=$self->_expandvars($self->{Envvalue}); |
789 |
< |
$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue}); |
790 |
< |
$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue}; |
791 |
< |
undef $self->{EnvContext}; |
792 |
< |
undef $self->{Envvalue}; |
793 |
< |
} |
794 |
< |
} |
774 |
> |
sub Environment_End |
775 |
> |
{ |
776 |
> |
my $self=shift; |
777 |
> |
my $name=shift; |
778 |
> |
|
779 |
> |
if ( $self->{Arch} ) |
780 |
> |
{ |
781 |
> |
if ( ! defined $self->{EnvContext} ) |
782 |
> |
{ |
783 |
> |
$self->{switch}->parseerror("</$name> without an opening context"); |
784 |
> |
} |
785 |
> |
# - set the help text |
786 |
> |
$self->featuretext($self->{EnvContext},$self->{currentenvtext}); |
787 |
> |
|
788 |
> |
if ( ! defined $self->{Envvalue} ) |
789 |
> |
{ |
790 |
> |
$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:", |
791 |
> |
$self->{EnvContext}); |
792 |
> |
} |
793 |
> |
|
794 |
> |
$self->{Envvalue}=$self->_expandvars($self->{Envvalue}); |
795 |
> |
$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue}); |
796 |
> |
$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue}; |
797 |
> |
|
798 |
> |
# Undefine in time for next pass: |
799 |
> |
undef $self->{EnvContext}; |
800 |
> |
undef $self->{Envvalue}; |
801 |
> |
} |
802 |
> |
} |
803 |
|
|
804 |
|
sub Lib { |
805 |
|
my $self=shift; |