ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolDoc.pm
(Generate patch)

Comparing COMP/SCRAM/src/BuildSystem/ToolDoc.pm (file contents):
Revision 1.7 by sashby, Thu Nov 15 21:18:16 2001 UTC vs.
Revision 1.8 by sashby, Fri Nov 16 16:29:49 2001 UTC

# Line 175 | Line 175 | sub _testlocation
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);
# Line 191 | Line 193 | sub _testlocation
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  
# Line 206 | Line 208 | sub _testlocation
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    
# Line 254 | Line 257 | sub _askusermenu {
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) ) {
# Line 270 | Line 273 | sub _askusermenu {
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;
# Line 519 | Line 560 | sub Environment_init {
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;
# Line 627 | Line 690 | sub Env_text {
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;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines