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.2 by williamc, Mon Aug 28 08:23:10 2000 UTC vs.
Revision 1.9 by sashby, Mon Nov 19 18:46:39 2001 UTC

# Line 28 | Line 28 | sub new {
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   }
# Line 36 | Line 36 | sub new {
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,
# Line 53 | Line 67 | sub init {
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,
# Line 77 | Line 95 | sub tool {
95  
96   sub toolsearcher {
97          my $self=shift;
98 +
99          if ( @_ ) {
100            my $searcher=shift;
101            if ( ! defined $searcher ) {
# Line 93 | Line 112 | sub setup {
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;
# Line 105 | Line 125 | sub setup {
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  
# Line 141 | Line 168 | sub _checkdefault {
168          return 0;
169   }
170  
171 < sub _testlocation {
172 <        my $self=shift;
173 <        my $default=shift;
174 <        my $testfiles=shift;
175 <        my $OK='false';
176 <        my $file;
177 <
178 <        chomp $default;
179 <        $default=$self->_expandvars($default);
180 <        print "Trying $default .... ";
181 <        if ( -f $default ) {
182 <                $OK="true";
183 <        }
184 <        else {
185 <          my $fh=FileHandle->new();
186 <          opendir $fh,  $default or do { print "No \n"; return 0; };
187 <         ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
188 <          print "\n";
189 <          my @files=readdir $fh;
190 <          undef $fh;
191 <          foreach $file ( @$testfiles ) {
192 <                print "   Checking for $file .... ";
193 <                # now check that the required files are actually there
194 <                if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
195 <                   $OK='false';
196 <                   print "not found\n";
197 <                   last;
198 <                }
199 <                print "found\n";
200 <          }
201 <        }
202 <        if ( $OK eq 'true' ) {
203 <                print "Directory Check Complete\n";
204 <                return 1
205 <        }
206 <        return 0
207 < }
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 >         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;
# Line 205 | Line 253 | sub _expandvars {
253          return $string;
254   }
255  
256 <
209 < sub _askuser {
256 > sub _askusermenu {
257          my $self=shift;
258 <        my $querystring=shift;
259 <        my $varname=shift;
260 <
261 <        print $self->featuretext($self->{EnvContext});
262 <        for  ( ;; ) {
263 <         print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
258 >        my $querystring=shift;
259 >        my @items=@_;
260 >        
261 >        my $path=-1;
262 >        my $n;
263 >        while ( ($path!~/^\d+$/) || ($path > ($#items+1)) || ($path < 1) ) {
264 >         for (my $i=0; $i<=$#items; $i++ ) {
265 >          $n=$i+1;
266 >          print $n.") ".$items[$i]."\n";
267 >         }
268 >         print "\n".$querystring;
269           $path=<STDIN>;
270           chomp $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";
277 <           next;
271 >        }
272 >        $path--;
273 >        return $path;
274 > }
275 >
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 +        
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 <         else {
359 <           return $path;
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 >            }
403           }
404 <        } #end for
405 <
404 >      return $path;
405 >      }
406 >   }
407 >
408 >
409 > sub _validateparam {
410 >        my $self=shift;
411 >        my $type=shift;
412 >        my @params=@_;
413 >
414 >        my @newparams=();
415 >        foreach $param ( @params ) {
416 >         if ( defined $self->{'client'}) { # must be a location
417 >          if ( $self->_testlocation($param ,
418 >               [ $self->{tool}->getfeature($type)] )) {
419 >            $self->verbose("$param passed validation");
420 >            push @newparams,$param;
421 >          }
422 >          else {
423 >            $self->verbose("$param failed validation");
424 >          }
425 >         }
426 >         else {
427 >           # --- no other tests to pass so it must be OK
428 >           push @newparams,$param;
429 >         }
430 >        }
431 >        return @newparams;
432   }
433  
434   #
# Line 238 | Line 437 | sub _askuser {
437   sub _searchtools {
438          my $self=shift;
439          my $tool=shift;
440 +        my $searcher=shift;
441  
442          my @tools=();
443          my $area;
444          my $rtool;
445 <        if ( defined $self->{toolboxsearcher} ) {
446 <           my $it=$self->{toolboxsearcher}->newiterator();
447 <           while ( ! $it->last()  ) {
445 >        my $it=$searcher->newiterator();
446 >        
447 >        while ( ! $it->last()  ) {
448               $area=$it->next();
449               if ( defined $area ) {
450                $self->verbose("Searching for ".$tool->name()." ".
451                   $tool->version()." in ".$area->location());
452                $rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
453 <              if ( (defined $rtool) && $rtool->equals($tool) ) {
453 >              if ( defined $rtool ) {
454 >               if ( $rtool->equals($tool) ) {
455 >                $self->verbose("Found matching tool");
456                  push @tools,$rtool;
457 +               }
458 +               else {
459 +                $self->verbose("Rejected tool ".$rtool->name()." "
460 +                                                        .$rtool->version());
461 +               }
462                }
463 +              else {
464 +                $self->verbose("Tool Passed as Undefined");
465 +              }
466               }
467 <           }
467 >             else {
468 >                $self->verbose("Area passed is not defined");
469 >             }
470          }
471          return @tools;
472   }
# Line 269 | Line 481 | sub _toolparamcopy {
481          my $rv=0;
482          my @params=();
483          $self->verbose("Check Other Projects for tool");
484 <        my @validtools=$self->_searchtools($tool);
485 <        if ( ! $self->interactive() ) {
486 <          if ( $#validtools >=0 ) {
484 >        my @validtools=();
485 >        if ( defined $self->{toolboxsearcher} ) {
486 >          @validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
487 >        }
488 >        if ( $#validtools >=0 ) {
489 >          if ( ! $self->interactive() ) {
490             @params=$validtools[0]->getfeature($param);
491             if ( $#params >=0 ) {
492                  $self->verbose("Extracting Feature $param from tool".
493                          " (= @params )\n");
279                #$tool->setfeature($param,@params);
494                  $rv=1;
495             }
496            }
# Line 284 | Line 498 | sub _toolparamcopy {
498          return ($rv,@params);
499   }
500  
501 + sub _getparamsets {
502 +        my $self=shift;
503 +        my $tool=shift;
504 +        my $param=shift;
505 +
506 +        my @paramlist=();
507 +        my @params=();
508 +        $self->verbose("Searching for parameter settings in other tools");
509 +        my @validtools=();
510 +        if ( defined $self->{toolboxsearcher} ) {
511 +          @validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
512 +        }
513 +        else {
514 +          $self->verbose("No tool searcher available");
515 +        }
516 +        if ( $#validtools >=0 ) {
517 +          foreach $t ( @validtools ) {
518 +            @params=$t->getfeature($param);
519 +            if ( $#params >=0 ) {
520 +              push @paramlist, [ @params ];
521 +              $self->verbose("Found @params");
522 +            }
523 +          }
524 +        }
525 +        return @paramlist;
526 + }
527 +
528   # -- Tag Routines
529  
530   sub Client_start {
# Line 337 | Line 578 | sub Tool_End {
578          $self->{switch}->closegroup("Toolactive");
579   }
580  
581 < sub Environment_Start {
581 > sub Makefile_Start {
582          my $self=shift;
583 <        my $name=shift;
584 <        my $hashref=shift;
583 >        my $name=shift;
584 >        my $hashref=shift;
585  
345        $self->{switch}->checktag($name, $hashref, 'name');
586          if ( $self->{Arch} ) {
587 <          if ( defined $self->{EnvContext} ) {
588 <            $self->parserror(" Attempted to open new <$name> context".
589 <                        " without closing the previous one");
590 <          }
351 <          $self->{currentenvtext}="";
352 <          $self->{EnvContext}=$$hashref{'name'};
353 <          undef $self->{Envvalue};
354 <          if ( exists $$hashref{'type'} ) {
355 <            $$hashref{'type'}=~tr[A-Z][a-z];
356 <            $self->{tool}->type($$hashref{'name'},$$hashref{'type'});
357 <          }
358 <          if ( exists $$hashref{'value'}) {
359 <            $self->{Envvalue}=$$hashref{'value'};
360 <          }
361 <          elsif ( ! $self->interactive() ) {
362 <           # check other installed copies of the tool
363 <           my ($rv,@params)=
364 <                $self->_toolparamcopy($self->{tool},$$hashref{'name'});
365 <           if ( $rv && ($#params == 0)) { #dont use multivalued params!
366 <              $self->{Envvalue}=$params[0]; # single val parameter
367 <           }
368 <           elsif ( defined $ENV{$$hashref{'name'}} ) {
369 <              # check the environment
370 <              $self->{Envvalue}=$ENV{$$hashref{'name'}};
371 <           }
372 <           elsif ( $self->_checkdefault($hashref) ) {
373 <              $self->{Envvalue}=$$hashref{'default'};
374 <           }
375 <          }
587 >         if ( ! defined $self->{toolmakefilefh} ) {
588 >           $self->{toolmakefilefh}=FileHandle->new();
589 >           $self->{toolmakefilefh}->open(">".$self->{toolmakefile});
590 >         }
591          }
592   }
593  
594 < sub Env_text {
594 > sub Makefile_text {
595          my $self=shift;
596          my $name=shift;
597          my $string=shift;
598  
599 <        if ( $self->{Arch} ) {
600 <          $self->{currentenvtext}=$self->{currentenvtext}.$string;
599 >        if ( $self->{Arch} ) {
600 >          print {$self->{toolmakefilefh}} $string;
601          }
602   }
603  
604 < sub Environment_End {
604 > sub Makefile_end {
605          my $self=shift;
606 <        my $name=shift;
606 >        my $name=shift;
607 >        my $hashref=shift;
608 >
609 >        if ( $self->{Arch} ) {
610 >          print {$self->{toolmakefilefh}} "\n";
611 >        }
612 > }
613 >
614 > # -- collect number of variables of the same name - need to know how many
615 > #    before main setup processing
616 > sub Environment_init {
617 >        my $self=shift;
618 >        my $name=shift;
619 >        my $hashref=shift;
620  
621 +        $self->{switch}->checktag($name, $hashref, 'name');
622          if ( $self->{Arch} ) {
623 <          if ( ! defined $self->{EnvContext} ) {
624 <            $self->{switch}->parseerror("</$name> without an opening context");
625 <          }
626 <          # - set the help text
627 <          $self->featuretext($self->{EnvContext},$self->{currentenvtext});
628 <          if ( ! defined $self->{Envvalue} ) {
629 <            $self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
630 <                        $self->{EnvContext});
631 <          }
632 <          $self->{Envvalue}=$self->_expandvars($self->{Envvalue});
633 <          $self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
634 <          $self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
635 <          undef $self->{EnvContext};
636 <          undef $self->{Envvalue};
623 >        if ( exists $self->{envcount}{$$hashref{'name'}} ) {
624 >          $self->{envcount}{$$hashref{'name'}}++;
625 >        }
626 >        else {
627 >          $self->{envcount}{$$hashref{'name'}}=0;
628 >        }
629 >        }
630 > }
631 >
632 > sub Environment_Start
633 >   {
634 >   my $self=shift;
635 >   my $name=shift;
636 >   my $hashref=shift;
637 >        
638 >   $self->{switch}->checktag($name, $hashref, 'name');
639 >
640 >   if ( $self->{Arch} )
641 >      {
642 >      my $val=undef;
643 >      if ( defined $self->{EnvContext} )
644 >         {
645 >         $self->parserror(" Attempted to open new <$name> context".
646 >                          " without closing the previous one");
647 >         }
648 >      # -- keep a counter of the number of times we see this variable
649 >      if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} )
650 >         {
651 >         $self->{EnvironmentCount}{$$hashref{'name'}}++;
652 >         }
653 >      else
654 >         {
655 >         $self->{EnvironmentCount}{$$hashref{'name'}}=0;
656 >         }
657 >      
658 >      $self->{currentenvtext}="";
659 >      $self->{EnvContext}=$$hashref{'name'};
660 >      undef $self->{Envvalue};
661 >
662 >      if ( exists $$hashref{'type'} )
663 >         {
664 >         $$hashref{'type'}=~tr[A-Z][a-z];
665 >         $self->{tool}->type($$hashref{'name'},$$hashref{'type'});
666 >         }
667 >      # check other installed copies of the tool
668 >      # -- construct a menu of options
669 >      my @menulist=();
670 >      # -- a value is fixed - unless interactive switch is on
671 >      if ( exists $$hashref{'value'})
672 >         {
673 >         $val=$$hashref{'value'};
674 >         if ( $self->interactive() )
675 >            {
676 >            unshift @menulist,$$hashref{'value'};
677 >            }
678 >         }
679 >      # -- add any default values to the selection
680 >      if ( ! defined $val )
681 >         {
682 >         if ( $self->_checkdefault($hashref) )
683 >            {
684 >            my $var=$self->_expandvars($$hashref{'default'});
685 >             if ( !grep { $_ eq $var }  @menulist )
686 >                {
687 >                unshift @menulist, $var;
688 >                }
689 >            }
690 >         # -- check the environment
691 >         if ( defined $ENV{$$hashref{'name'}} )
692 >            {
693 >            if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist )
694 >               {
695 >               unshift @menulist, $ENV{$$hashref{'name'}};
696 >               }
697 >            }
698 >         my @paramlist=$self->_getparamsets($self->{tool},
699 >                                            $$hashref{'name'});
700 >         foreach $p ( @paramlist )
701 >            {
702 >            # -- only add them if there are the same number of variables
703 >            if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} )
704 >               {
705 >               if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
706 >                                        {$$hashref{'name'}}] } @menulist)
707 >                  {
708 >                  push @menulist,$$p[$self->{EnvironmentCount}
709 >                                        {$$hashref{'name'}}];
710 >                  }
711 >               }
712 >            else
713 >               {
714 >               $self->verbose("Ignoring tool params - not the same number".
715 >                              " defined (".$#{$p}." != ".
716 >                              $self->{envcount}{$$hashref{'name'}}.")");
717 >               }
718 >            }
719 >         if ( $#menulist >=0 )
720 >            {
721 >            print "Validating Values for Variable: ".$$hashref{'name'}."\n";
722 >            @menulist=$self->_validateparam($$hashref{'type'},@menulist);
723 >            }
724 >         print "\n";
725 >         # -- If theres only one option take it without asking
726 >         if ( $#menulist == 0 && ( ! $self->interactive() ))
727 >            {
728 >            $val=$menulist[0];
729 >            }
730 >         elsif ( $#menulist > 0 )
731 >            {
732 >            my $in=$self->_askusermenu(
733 >                                       "Multiple possibilities found for ".
734 >                                       $$hashref{'name'}." ( occurrance ".
735 >                                       ($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
736 >                                       "\nPlease Choose: ",
737 >                                       (@menulist,"Other"));
738 >            if ( $in <=$#menulist )
739 >               {
740 >               $val=$menulist[$in];
741 >               }
742 >            else
743 >               {
744 >               undef $val;
745 >               }
746 >            }
747 >         }
748 >      $self->{Envvalue}=$val; # single val parameter
749 >      }
750 >   }
751 >
752 > sub Env_text {
753 >        my $self=shift;
754 >        my $name=shift;
755 >        my $string=shift;
756 >
757 >        if ( $self->{Arch} ) {
758 >          $self->{currentenvtext}=$self->{currentenvtext}.$string;
759          }
760   }
761  
762 + sub Environment_End
763 +   {
764 +   my $self=shift;
765 +   my $name=shift;
766 +  
767 +   if ( $self->{Arch} )
768 +      {
769 +      if ( ! defined $self->{EnvContext} )
770 +         {
771 +         $self->{switch}->parseerror("</$name> without an opening context");
772 +         }
773 +      # - set the help text
774 +      $self->featuretext($self->{EnvContext},$self->{currentenvtext});
775 +      
776 +      if ( ! defined $self->{Envvalue} )
777 +         {
778 +         $self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
779 +                                           $self->{EnvContext});
780 +         }
781 +      
782 +      $self->{Envvalue}=$self->_expandvars($self->{Envvalue});
783 +      $self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
784 +      $self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
785 +
786 +      # Undefine in time for next pass:
787 +      undef $self->{EnvContext};
788 +      undef $self->{Envvalue};
789 +      }
790 +   }
791 +
792   sub Lib {
793          my $self=shift;
794          my $name=shift;
# Line 448 | Line 829 | sub Arch_End {
829          pop @{$self->{ARCHBLOCK}};
830          $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
831   }
451
452

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines