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); |
193 |
|
|
194 |
|
opendir $dh, $default or do |
195 |
|
{ |
196 |
< |
printf ("\nTrying %-s ...... >>%s<<\n",$default,$!,); |
196 |
> |
printf ("\nTrying %-s ...... >> %s <<\n",$default,$main::bold.$!.$main::normal); |
197 |
|
return 0; |
198 |
|
}; |
199 |
|
|
200 |
|
($#{$testfiles}==-1) ? $OK='false' : $OK='true'; |
201 |
< |
#print "\n"; |
201 |
> |
|
202 |
|
my @files=readdir $dh; |
203 |
|
undef $dh; |
204 |
|
|
208 |
|
if ( ( $number = grep /\Q$file\L/, @files) == 0 ) |
209 |
|
{ |
210 |
|
$OK='false'; |
211 |
< |
$status = "[not found]"; |
211 |
> |
$status = $statusbad; |
212 |
|
last; |
213 |
|
} |
214 |
< |
$status = "[OK]"; |
215 |
< |
printf ("\t\tChecking for %-22s............ %-s\n",$file,$status); |
214 |
> |
$status = $statusgood; |
215 |
> |
|
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 ............ [OK]\n",$default.":"); |
223 |
> |
printf ("Existence check for %-30s ............ [%s]\n",$default.":",$statusgood); |
224 |
|
return 1; |
225 |
|
} |
226 |
|
|
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; |
276 |
> |
sub _askuser |
277 |
> |
{ |
278 |
> |
my $self=shift; |
279 |
> |
my $querystring=shift; |
280 |
> |
my $varname=shift; |
281 |
> |
my $lookupdb = $main::lookupobject; |
282 |
> |
my $type=$self->{tool}->type($varname); |
283 |
> |
my $path; |
284 |
> |
my $oldpath; |
285 |
> |
my $defaultpath = $lookupdb->lhcxxPath(); |
286 |
> |
|
287 |
> |
# Print the feature info: |
288 |
> |
print $self->featuretext($self->{EnvContext}); |
289 |
|
|
290 |
< |
my $type=$self->{tool}->type($varname); |
291 |
< |
my $path; |
292 |
< |
my $oldpath; |
293 |
< |
print $self->featuretext($self->{EnvContext}); |
294 |
< |
for ( ;; ) { |
295 |
< |
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
296 |
< |
$path=<STDIN>; |
297 |
< |
chomp $path; |
290 |
> |
# Check if tool is listed in the lookupdb: |
291 |
> |
if ($lookupdb->checkTool(${$self->{tool}}{name})) |
292 |
> |
{ |
293 |
> |
$self->verbose(">> Tool ",${$self->{tool}}{name}," exists in DB..."); |
294 |
> |
# Check if $varname is a tag that's listed in our lookup table for this tool: |
295 |
> |
if ($lookupdb->lookupTag(${$self->{tool}}{name},$varname)) |
296 |
> |
{ |
297 |
> |
$self->verbose(">> Tag ",$varname," is defined for tool ",${$self->{tool}}{name}); |
298 |
> |
# Get the value for this tag: |
299 |
> |
$path = $lookupdb->lookupTag(${$self->{tool}}{name},$varname); |
300 |
> |
} |
301 |
> |
else |
302 |
> |
# No known tag for this tool so try the default path: |
303 |
> |
{ |
304 |
> |
$path = $defaultpath; |
305 |
> |
} |
306 |
> |
} |
307 |
> |
# If the defaultpath is valid then try that: |
308 |
> |
elsif ( -d $defaultpath) |
309 |
> |
{ |
310 |
> |
$path = $defaultpath; |
311 |
> |
} |
312 |
> |
# We'll have to ask the user: |
313 |
> |
else |
314 |
> |
{ |
315 |
> |
# Infinite loop while there isn't a valid path: |
316 |
> |
for (;;) |
317 |
> |
{ |
318 |
> |
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
319 |
> |
$path=<STDIN>; |
320 |
> |
chomp $path; |
321 |
|
$oldpath=$path; |
322 |
< |
if ( $path ne "" ) { |
323 |
< |
($path)=$self->_validateparam($type,$path); |
324 |
< |
if ( ! defined $path ) { |
325 |
< |
print "Error : ".$oldpath." is not valid.\n"; |
326 |
< |
next; |
327 |
< |
} |
328 |
< |
} |
322 |
> |
|
323 |
> |
if ( $path ne "" ) |
324 |
> |
{ |
325 |
> |
($path)=$self->_validateparam($type,$path); |
326 |
> |
# If the path is not defined, print |
327 |
> |
# a message and repeat the prompt: |
328 |
> |
if ( ! defined $path ) |
329 |
> |
{ |
330 |
> |
print "Error : ".$oldpath." is not valid.\n"; |
331 |
> |
next; |
332 |
> |
} |
333 |
> |
} |
334 |
|
return $path; |
335 |
< |
} #end for |
336 |
< |
|
337 |
< |
} |
335 |
> |
} |
336 |
> |
} |
337 |
> |
return $path; |
338 |
> |
} |
339 |
|
|
340 |
|
sub _validateparam { |
341 |
|
my $self=shift; |
560 |
|
} |
561 |
|
} |
562 |
|
|
563 |
< |
sub Environment_Start { |
564 |
< |
my $self=shift; |
565 |
< |
my $name=shift; |
566 |
< |
my $hashref=shift; |
563 |
> |
sub Environment_Start |
564 |
> |
{ |
565 |
> |
my $self=shift; |
566 |
> |
my $name=shift; |
567 |
> |
my $hashref=shift; |
568 |
|
|
569 |
< |
$self->{switch}->checktag($name, $hashref, 'name'); |
528 |
< |
if ( $self->{Arch} ) { |
529 |
< |
my $val=undef; |
530 |
< |
if ( defined $self->{EnvContext} ) { |
531 |
< |
$self->parserror(" Attempted to open new <$name> context". |
532 |
< |
" without closing the previous one"); |
533 |
< |
} |
534 |
< |
# -- keep a counter of the number of times we see this variable |
535 |
< |
if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} ) { |
536 |
< |
$self->{EnvironmentCount}{$$hashref{'name'}}++; |
537 |
< |
} |
538 |
< |
else { |
539 |
< |
$self->{EnvironmentCount}{$$hashref{'name'}}=0; |
540 |
< |
} |
569 |
> |
$self->{switch}->checktag($name, $hashref, 'name'); |
570 |
|
|
571 |
< |
$self->{currentenvtext}=""; |
572 |
< |
$self->{EnvContext}=$$hashref{'name'}; |
573 |
< |
undef $self->{Envvalue}; |
574 |
< |
if ( exists $$hashref{'type'} ) { |
575 |
< |
$$hashref{'type'}=~tr[A-Z][a-z]; |
576 |
< |
$self->{tool}->type($$hashref{'name'},$$hashref{'type'}); |
577 |
< |
} |
578 |
< |
# check other installed copies of the tool |
579 |
< |
# -- construct a menu of options |
580 |
< |
my @menulist=(); |
581 |
< |
# -- a value is fixed - unless interactive switch is on |
582 |
< |
if ( exists $$hashref{'value'}) { |
583 |
< |
$val=$$hashref{'value'}; |
584 |
< |
if ( $self->interactive() ) { |
585 |
< |
unshift @menulist,$$hashref{'value'}; |
571 |
> |
if ( $self->{Arch} ) |
572 |
> |
{ |
573 |
> |
my $val=undef; |
574 |
> |
if ( defined $self->{EnvContext} ) |
575 |
> |
{ |
576 |
> |
$self->parserror(" Attempted to open new <$name> context". |
577 |
> |
" without closing the previous one"); |
578 |
> |
} |
579 |
> |
# -- keep a counter of the number of times we see this variable |
580 |
> |
if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} ) |
581 |
> |
{ |
582 |
> |
$self->{EnvironmentCount}{$$hashref{'name'}}++; |
583 |
> |
} |
584 |
> |
else |
585 |
> |
{ |
586 |
> |
$self->{EnvironmentCount}{$$hashref{'name'}}=0; |
587 |
> |
} |
588 |
> |
|
589 |
> |
$self->{currentenvtext}=""; |
590 |
> |
$self->{EnvContext}=$$hashref{'name'}; |
591 |
> |
undef $self->{Envvalue}; |
592 |
> |
|
593 |
> |
if ( exists $$hashref{'type'} ) |
594 |
> |
{ |
595 |
> |
$$hashref{'type'}=~tr[A-Z][a-z]; |
596 |
> |
$self->{tool}->type($$hashref{'name'},$$hashref{'type'}); |
597 |
> |
} |
598 |
> |
# check other installed copies of the tool |
599 |
> |
# -- construct a menu of options |
600 |
> |
my @menulist=(); |
601 |
> |
# -- a value is fixed - unless interactive switch is on |
602 |
> |
if ( exists $$hashref{'value'}) |
603 |
> |
{ |
604 |
> |
$val=$$hashref{'value'}; |
605 |
> |
if ( $self->interactive() ) |
606 |
> |
{ |
607 |
> |
unshift @menulist,$$hashref{'value'}; |
608 |
|
} |
609 |
< |
} |
610 |
< |
# -- add any default values to the selection |
611 |
< |
if ( ! defined $val ) { |
612 |
< |
if ( $self->_checkdefault($hashref) ) { |
613 |
< |
my $var=$self->_expandvars($$hashref{'default'}); |
614 |
< |
if ( !grep { $_ eq $var } @menulist ) { |
615 |
< |
unshift @menulist, $var; |
616 |
< |
} |
617 |
< |
} |
618 |
< |
# -- check the environment |
619 |
< |
if ( defined $ENV{$$hashref{'name'}} ) { |
620 |
< |
if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) { |
621 |
< |
unshift @menulist, $ENV{$$hashref{'name'}}; |
622 |
< |
} |
623 |
< |
} |
624 |
< |
my @paramlist=$self->_getparamsets($self->{tool}, |
625 |
< |
$$hashref{'name'}); |
626 |
< |
foreach $p ( @paramlist ) { |
627 |
< |
# -- only add them if there are the same number of variables |
628 |
< |
if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) { |
629 |
< |
if ( !grep {$_ eq $$p[$self->{EnvironmentCount} |
630 |
< |
{$$hashref{'name'}}] } @menulist) { |
631 |
< |
push @menulist,$$p[$self->{EnvironmentCount} |
632 |
< |
{$$hashref{'name'}}]; |
633 |
< |
} |
634 |
< |
} |
635 |
< |
else { |
636 |
< |
$self->verbose("Ignoring tool params - not the same number". |
637 |
< |
" defined (".$#{$p}." != ". |
638 |
< |
$self->{envcount}{$$hashref{'name'}}.")"); |
639 |
< |
} |
640 |
< |
} |
641 |
< |
if ( $#menulist >=0 ) { |
609 |
> |
} |
610 |
> |
# -- add any default values to the selection |
611 |
> |
if ( ! defined $val ) |
612 |
> |
{ |
613 |
> |
if ( $self->_checkdefault($hashref) ) |
614 |
> |
{ |
615 |
> |
my $var=$self->_expandvars($$hashref{'default'}); |
616 |
> |
if ( !grep { $_ eq $var } @menulist ) |
617 |
> |
{ |
618 |
> |
unshift @menulist, $var; |
619 |
> |
} |
620 |
> |
} |
621 |
> |
# -- check the environment |
622 |
> |
if ( defined $ENV{$$hashref{'name'}} ) |
623 |
> |
{ |
624 |
> |
if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) |
625 |
> |
{ |
626 |
> |
unshift @menulist, $ENV{$$hashref{'name'}}; |
627 |
> |
} |
628 |
> |
} |
629 |
> |
my @paramlist=$self->_getparamsets($self->{tool}, |
630 |
> |
$$hashref{'name'}); |
631 |
> |
foreach $p ( @paramlist ) |
632 |
> |
{ |
633 |
> |
# -- only add them if there are the same number of variables |
634 |
> |
if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) |
635 |
> |
{ |
636 |
> |
if ( !grep {$_ eq $$p[$self->{EnvironmentCount} |
637 |
> |
{$$hashref{'name'}}] } @menulist) |
638 |
> |
{ |
639 |
> |
push @menulist,$$p[$self->{EnvironmentCount} |
640 |
> |
{$$hashref{'name'}}]; |
641 |
> |
} |
642 |
> |
} |
643 |
> |
else |
644 |
> |
{ |
645 |
> |
$self->verbose("Ignoring tool params - not the same number". |
646 |
> |
" defined (".$#{$p}." != ". |
647 |
> |
$self->{envcount}{$$hashref{'name'}}.")"); |
648 |
> |
} |
649 |
> |
} |
650 |
> |
if ( $#menulist >=0 ) |
651 |
> |
{ |
652 |
|
print "Validating Values for Variable: ".$$hashref{'name'}."\n"; |
653 |
|
@menulist=$self->_validateparam($$hashref{'type'},@menulist); |
654 |
< |
} |
655 |
< |
print "\n"; |
656 |
< |
# -- If theres only one option take it without asking |
657 |
< |
if ( $#menulist == 0 && ( ! $self->interactive() )) |
658 |
< |
{ |
659 |
< |
print "VALUE: ",$val,"\n"; |
660 |
< |
$val=$menulist[0]; |
661 |
< |
} |
662 |
< |
elsif ( $#menulist > 0 ) { |
663 |
< |
my $in=$self->_askusermenu( |
664 |
< |
"Multiple possibilities found for ". |
665 |
< |
$$hashref{'name'}." ( occurrance ". |
666 |
< |
($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ". |
667 |
< |
"\nPlease Choose: ", |
668 |
< |
(@menulist,"Other")); |
669 |
< |
if ( $in <=$#menulist ) { |
670 |
< |
$val=$menulist[$in]; |
671 |
< |
} |
672 |
< |
else { |
673 |
< |
undef $val; |
674 |
< |
} |
675 |
< |
} |
676 |
< |
} |
677 |
< |
$self->{Envvalue}=$val; # single val parameter |
678 |
< |
} |
679 |
< |
} |
654 |
> |
} |
655 |
> |
print "\n"; |
656 |
> |
# -- If theres only one option take it without asking |
657 |
> |
if ( $#menulist == 0 && ( ! $self->interactive() )) |
658 |
> |
{ |
659 |
> |
$val=$menulist[0]; |
660 |
> |
} |
661 |
> |
elsif ( $#menulist > 0 ) |
662 |
> |
{ |
663 |
> |
my $in=$self->_askusermenu( |
664 |
> |
"Multiple possibilities found for ". |
665 |
> |
$$hashref{'name'}." ( occurrance ". |
666 |
> |
($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ". |
667 |
> |
"\nPlease Choose: ", |
668 |
> |
(@menulist,"Other")); |
669 |
> |
if ( $in <=$#menulist ) |
670 |
> |
{ |
671 |
> |
$val=$menulist[$in]; |
672 |
> |
} |
673 |
> |
else |
674 |
> |
{ |
675 |
> |
undef $val; |
676 |
> |
} |
677 |
> |
} |
678 |
> |
} |
679 |
> |
$self->{Envvalue}=$val; # single val parameter |
680 |
> |
} |
681 |
> |
} |
682 |
|
|
683 |
|
sub Env_text { |
684 |
|
my $self=shift; |
690 |
|
} |
691 |
|
} |
692 |
|
|
693 |
< |
sub Environment_End { |
694 |
< |
my $self=shift; |
695 |
< |
my $name=shift; |
696 |
< |
|
697 |
< |
if ( $self->{Arch} ) { |
698 |
< |
if ( ! defined $self->{EnvContext} ) { |
699 |
< |
$self->{switch}->parseerror("</$name> without an opening context"); |
700 |
< |
} |
701 |
< |
# - set the help text |
702 |
< |
$self->featuretext($self->{EnvContext},$self->{currentenvtext}); |
703 |
< |
if ( ! defined $self->{Envvalue} ) { |
704 |
< |
$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:", |
705 |
< |
$self->{EnvContext}); |
706 |
< |
} |
707 |
< |
$self->{Envvalue}=$self->_expandvars($self->{Envvalue}); |
708 |
< |
$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue}); |
709 |
< |
$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue}; |
710 |
< |
undef $self->{EnvContext}; |
711 |
< |
undef $self->{Envvalue}; |
712 |
< |
} |
713 |
< |
} |
693 |
> |
sub Environment_End |
694 |
> |
{ |
695 |
> |
my $self=shift; |
696 |
> |
my $name=shift; |
697 |
> |
|
698 |
> |
if ( $self->{Arch} ) |
699 |
> |
{ |
700 |
> |
if ( ! defined $self->{EnvContext} ) |
701 |
> |
{ |
702 |
> |
$self->{switch}->parseerror("</$name> without an opening context"); |
703 |
> |
} |
704 |
> |
# - set the help text |
705 |
> |
$self->featuretext($self->{EnvContext},$self->{currentenvtext}); |
706 |
> |
|
707 |
> |
if ( ! defined $self->{Envvalue} ) |
708 |
> |
{ |
709 |
> |
$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:", |
710 |
> |
$self->{EnvContext}); |
711 |
> |
} |
712 |
> |
|
713 |
> |
$self->{Envvalue}=$self->_expandvars($self->{Envvalue}); |
714 |
> |
$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue}); |
715 |
> |
$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue}; |
716 |
> |
|
717 |
> |
# Undefine in time for next pass: |
718 |
> |
undef $self->{EnvContext}; |
719 |
> |
undef $self->{Envvalue}; |
720 |
> |
} |
721 |
> |
} |
722 |
|
|
723 |
|
sub Lib { |
724 |
|
my $self=shift; |