src/BuildSystem/ToolDoc.pm

#
# ToolDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# SimpleDoc interface to initialise Tool objects
#
# Interface
# ---------
# new()         : A new ToolDoc object
# tool(toolobj) : set the tool object for the class
# toolsearcher(searcher) : set the searcher for finding reference tools
# setup(file,$name,$version) : setup a tool object from the specified file
#                               return 0 for OK 1 for cancel
# interactive([0|1]) : set the interactive node 0=off 1=on

package BuildSystem::ToolDoc;
require 5.004;
use ActiveDoc::SimpleDoc;
use Utilities::Verbose;
@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->{cache}=shift;
        $self->{mydoctype}="BuildSystem::ToolDoc";
        $self->{mydocversion}="1.1";
        $self->init();
        return $self;
}

sub init {
        my $self=shift;
        $self->{switch}=ActiveDoc::SimpleDoc->new();
        $self->{switch}->newparse("setupinit");
        $self->{switch}->addtag("setupinit","Tool",\&Tool_Start, $self, 
                                                "", $self,
                                                \&Tool_End, $self);
        $self->{switch}->addtag("setupinit", "Architecture",
                                        \&Arch_Start,$self,
                                        "", $self,
                                        \&Arch_End,$self);
        $self->{switch}->addtag("setupinit","Environment",
                                        \&Environment_init, $self,
                                        "", $self,
                                        "", $self);
        $self->{switch}->grouptag("Tool","setupinit");

        $self->{switch}->newparse("setup");
        $self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,     
                                                "", $self,
                                                \&Tool_End, $self);
        $self->{switch}->addtag("setup","Lib",\&Lib, $self,     
                                                "", $self,
                                                "", $self);
        $self->{switch}->addtag("setup","External",\&External_Start, $self,     
                                                "", $self,
                                                "", $self);
        $self->{switch}->addtag("setup","Client",\&Client_start, $self, 
                                                "", $self,
                                                \&Client_end, $self);
        $self->{switch}->addtag("setup","Environment",
                                                \&Environment_Start, $self,     
                                                \&Env_text, $self,
                                                \&Environment_End, $self);
        $self->{switch}->addtag("setup","Makefile",
                                                \&Makefile_Start, $self,        
                                                \&Makefile_text, $self,
                                                \&Makefile_end, $self);
        $self->{switch}->grouptag("Tool","setup");
        $self->{switch}->addtag("setup","Architecture",
                                        \&Arch_Start,$self,
                                        "", $self,
                                        \&Arch_End,$self);
        $self->{Arch}=1;
        push @{$self->{ARCHBLOCK}}, $self->{Arch};

}

sub interactive {
        my $self=shift;
        
        @_?$self->{interactive}=shift
          :((defined $self->{interactive})?$self->{interactive}:0);
}

sub tool {
        my $self=shift;
        $self->{tool}=shift;
}

sub toolsearcher {
        my $self=shift;

        if ( @_ ) {
          my $searcher=shift;
          if ( ! defined $searcher ) {
             $self->error("Undefined Value passed as a Searcher".
                " in ToolDoc::toolsearcher");
          }
          $self->{toolboxsearcher}=$searcher;
        }
        return $self->{toolboxsearcher};
}

sub setup {
        my $self=shift;
        my $file=shift;
        my $name=shift;
        my $version=shift;
        my $toolbox=shift;

        $self->{ToolEnv}{'SCRAMtoolname'}=$name;
        $self->{ToolEnv}{'SCRAMtoolversion'}=$version;
        $self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};

        $name=~tr[A-Z][a-z];
        $self->{tool}->name($name);
        $self->{tool}->version($version);
        $self->{switch}->filetoparse($file);
        $self->{toolfound}=1;
        # -- check the type of document - can we parse it?
        my($doctype,$docversion)=$self->{switch}->doctype();
        if (($doctype ne $self->{mydoctype}) || 
          (($self->{mydocversion} ne $docversion) && ($docversion ne "1.0")) ) {
          $self->error("Unable to Parse Document of type $doctype $docversion".
                "\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")");
        }
        delete $self->{envcount};
        $self->verbose("Pre-Parse");
        $self->{switch}->parse("setupinit");
        $self->{toolmakefile}=$toolbox->toolmakefile($name,$version);
        $self->verbose("Setup Parse");
        $self->{switch}->parse("setup");
        undef $self->{toolmakefilefh};

        return $self->{toolfound};
}

sub featuretext {
        my $self=shift;
        my $feature=shift;

        if ( @_ ) {
          $self->{featuretext}{$feature}=shift;
        }
        else {
          return ($self->{featuretext}{$feature});
        }
}

sub _checkdefault {
        my $self=shift;
        my $hashref=shift;

        if ( defined $$hashref{'default'} ) { #check default
          my $default;
          foreach $default ( split /:/, $$hashref{'default'} ) {
            $default=~s/\"//;
            if ($self->_testlocation($default,
               [ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
          }
        }
        return 0;
}

sub _testlocation
   {
   my $self=shift;
   my $default=shift;
   my $testfiles=shift;
   my $OK='false';
   my $file;
   my $statusgood = $main::bold."OK".$main::normal;
   my $statusbad = $main::bold."Not found".$main::normal;
   
   chomp $default;
   $default=$self->_expandvars($default);
   $self->verbose("Testing location");
   
   if ( -f $default )
      {
      $OK="true";
      $self->verbose("File OK");
      }
   else
      {
      my $dh=DirHandle->new();
      
      opendir $dh, $default or do
         {
         printf ("\nTrying %-s ...... >> %s <<\n",$default,$main::bold.$!.$main::normal);
         return 0;
         };
      
      ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
      
      my @files=readdir $dh;
      undef $dh;

      foreach $file ( @$testfiles )
         {
         # now check that the required files are actually there
         if ( ( $number = grep /\Q$file\L/, @files) == 0 )
            {
            $OK='false';
            $status = $statusbad;
            last;
            }
         $status = $statusgood;

         printf ("\t\tChecking for %-22s............ [%s]\n",$file,$status);
         }
      print "\n";
      }
   
   if ( $OK eq 'true' )
      {
      printf ("Existence check for %-30s ............ [%s]\n",$default.":",$statusgood);
      return 1;
      }
   
   return 0;
   }

sub _expandvars {
        my $self=shift;
        my $string=shift;

        return "" , if ( ! defined $string );
        $string=~s{
                \$\((\w+)\)
        }{
          if (defined $self->{ToolEnv}{$1}) {
                $self->_expandvars($self->{ToolEnv}{$1});
          } else {
                "\$$1";
          }
        }egx;
        $string=~s{
                \$(\w+)
        }{
          if (defined $self->{ToolEnv}{$1}) {
                $self->_expandvars($self->{ToolEnv}{$1});
          } else {
                "\$$1";
          }
        }egx;
        return $string;
}

sub _askusermenu {
        my $self=shift;
        my $querystring=shift;
        my @items=@_;
        
        my $path=-1;
        my $n;
        while ( ($path!~/^\d+$/) || ($path > ($#items+1)) || ($path < 1) ) {
         for (my $i=0; $i<=$#items; $i++ ) {
          $n=$i+1;
          print $n.") ".$items[$i]."\n";
         }
         print "\n".$querystring;
         $path=<STDIN>;
         chomp $path;
        }
        $path--;
        return $path;
}

sub _askuser
   {
   my $self=shift;
   my $querystring=shift;
   my $varname=shift;
   my $lookupdb = $main::lookupobject;
   my $type=$self->{tool}->type($varname);
   my $path;
   my $oldpath;
   my $defaultpath = $lookupdb->lhcxxPath();
   
   # Print the feature info:
   print $self->featuretext($self->{EnvContext});

   # Check if tool is listed in the lookupdb:
   if ($lookupdb->checkTool(${$self->{tool}}{name}))
      {
      $self->verbose(">> Tool ",${$self->{tool}}{name}," exists in DB...");
      # Check if $varname is a tag that's listed in our lookup table for this tool:      
      if ($lookupdb->lookupTag(${$self->{tool}}{name},$varname))
          {
          $self->verbose(">> Tag ",$varname," is defined for tool ",${$self->{tool}}{name});
          # Get the value for this tag:
          $path = $lookupdb->lookupTag(${$self->{tool}}{name},$varname);
          }
      else
      # No known tag for this tool so try the default path:
          {
          $path = $defaultpath;
          }   
      }
   # If the defaultpath is valid then try that:
   elsif ( -d $defaultpath)
      {
      $path = $defaultpath;
      }
   # We'll have to ask the user:
   else
      {
      # Infinite loop while there isn't a valid path:
      for (;;)
         {
         print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
         $path=<STDIN>;
         chomp $path;
         $oldpath=$path;
         
         if ( $path ne "" )
            {
            ($path)=$self->_validateparam($type,$path);
            # If the path is not defined, print
            # a message and repeat the prompt:
            if ( ! defined $path )
              {
              print "Error : ".$oldpath." is not valid.\n";
              next;
              }
            }
         return $path;
         }
      }
    return $path;
   }

sub _validateparam {
        my $self=shift;
        my $type=shift;
        my @params=@_;

        my @newparams=();
        foreach $param ( @params ) {
         if ( defined $self->{'client'}) { # must be a location
          if ( $self->_testlocation($param ,
               [ $self->{tool}->getfeature($type)] )) {
            $self->verbose("$param passed validation");
            push @newparams,$param;
          }
          else {
            $self->verbose("$param failed validation");
          }
         }
         else {
           # --- no other tests to pass so it must be OK
           push @newparams,$param;
         }
        }
        return @newparams;
}

#
# Propgate through the searcher collecting matching tools
#
sub _searchtools {
        my $self=shift;
        my $tool=shift;
        my $searcher=shift;

        my @tools=();
        my $area;
        my $rtool;
        my $it=$searcher->newiterator();
        
        while ( ! $it->last()  ) {
             $area=$it->next();
             if ( defined $area ) {
              $self->verbose("Searching for ".$tool->name()." ".
                 $tool->version()." in ".$area->location());
              $rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
              if ( defined $rtool ) {
               if ( $rtool->equals($tool) ) {
                $self->verbose("Found matching tool");
                push @tools,$rtool;
               }
               else {
                $self->verbose("Rejected tool ".$rtool->name()." "
                                                        .$rtool->version());
               }
              }
              else {
                $self->verbose("Tool Passed as Undefined");
              }
             }
             else {
                $self->verbose("Area passed is not defined");
             }
        }
        return @tools; 
}

# search toolboxes for a nice list
#
sub _toolparamcopy {
        my $self=shift;
        my $tool=shift;
        my $param=shift;

        my $rv=0;
        my @params=();
        $self->verbose("Check Other Projects for tool");
        my @validtools=();
        if ( defined $self->{toolboxsearcher} ) {
          @validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
        }
        if ( $#validtools >=0 ) {
          if ( ! $self->interactive() ) {
           @params=$validtools[0]->getfeature($param);
           if ( $#params >=0 ) {
                $self->verbose("Extracting Feature $param from tool".
                        " (= @params )\n");
                $rv=1;
           }
          }
        }
        return ($rv,@params);
}

sub _getparamsets {
        my $self=shift;
        my $tool=shift;
        my $param=shift;

        my @paramlist=();
        my @params=();
        $self->verbose("Searching for parameter settings in other tools");
        my @validtools=();
        if ( defined $self->{toolboxsearcher} ) {
          @validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
        }
        else {
          $self->verbose("No tool searcher available");
        }
        if ( $#validtools >=0 ) {
          foreach $t ( @validtools ) {
            @params=$t->getfeature($param);
            if ( $#params >=0 ) {
              push @paramlist, [ @params ];
              $self->verbose("Found @params");
            }
          }
        }
        return @paramlist;
}

# -- Tag Routines

sub Client_start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        if ( $self->{Arch} ) {
          $self->{'client'}=1;
        }
}

sub Client_end {
        my $self=shift;
        if ( $self->{Arch} ) {
        undef $self->{'client'};
        }
}
        
sub Tool_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        $self->{switch}->checktag($name, $hashref, 'version');
        $self->{switch}->opengroup("Toolactive");

        # lower case the name
        $$hashref{'name'}=~tr[A-Z][a-z];
        # make sure we only pick up the tool requested
        if ( ( $self->{tool}->name() eq $$hashref{'name'} ) && 
                ($self->{tool}->version() eq $$hashref{'version'})) {
          $self->{switch}->
                allowgroup("Toolactive",$self->{switch}->currentparsename());
          $self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
          $self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
          $self->{toolfound}=0;
        }
        else {
          $self->{switch}->disallowgroup("Toolactive",
                                $self->{switch}->currentparsename());
        }
}

sub Tool_End {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->closegroup("Toolactive");
}

sub Makefile_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        if ( $self->{Arch} ) {
         if ( ! defined $self->{toolmakefilefh} ) {
           $self->{toolmakefilefh}=FileHandle->new();
           $self->{toolmakefilefh}->open(">".$self->{toolmakefile}); 
         }
        }
}

sub Makefile_text {
        my $self=shift;
        my $name=shift;
        my $string=shift;

        if ( $self->{Arch} ) {
          print {$self->{toolmakefilefh}} $string;
        }
}

sub Makefile_end {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        if ( $self->{Arch} ) {
          print {$self->{toolmakefilefh}} "\n"; 
        }
}

# -- collect number of variables of the same name - need to know how many
#    before main setup processing
sub Environment_init {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        if ( $self->{Arch} ) {
        if ( exists $self->{envcount}{$$hashref{'name'}} ) {
          $self->{envcount}{$$hashref{'name'}}++;
        }
        else {
          $self->{envcount}{$$hashref{'name'}}=0;
        }
        }
}

sub Environment_Start
   {
   my $self=shift;
   my $name=shift;
   my $hashref=shift;
        
   $self->{switch}->checktag($name, $hashref, 'name');

   if ( $self->{Arch} )
      {
      my $val=undef;
      if ( defined $self->{EnvContext} )
         {
         $self->parserror(" Attempted to open new <$name> context".
                          " without closing the previous one");
         }
      # -- keep a counter of the number of times we see this variable
      if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} )
         {
         $self->{EnvironmentCount}{$$hashref{'name'}}++;
         }
      else
         {
         $self->{EnvironmentCount}{$$hashref{'name'}}=0;
         }
      
      $self->{currentenvtext}="";
      $self->{EnvContext}=$$hashref{'name'};
      undef $self->{Envvalue};

      if ( exists $$hashref{'type'} )
         {
         $$hashref{'type'}=~tr[A-Z][a-z];
         $self->{tool}->type($$hashref{'name'},$$hashref{'type'});
         }
      # check other installed copies of the tool
      # -- construct a menu of options
      my @menulist=();
      # -- a value is fixed - unless interactive switch is on
      if ( exists $$hashref{'value'})
         {
         $val=$$hashref{'value'};
         if ( $self->interactive() )
            {
            unshift @menulist,$$hashref{'value'};
            }
         }
      # -- add any default values to the selection
      if ( ! defined $val )
         {
         if ( $self->_checkdefault($hashref) )
            { 
            my $var=$self->_expandvars($$hashref{'default'});
             if ( !grep { $_ eq $var }  @menulist )
                {
                unshift @menulist, $var;
                }
            }
         # -- check the environment
         if ( defined $ENV{$$hashref{'name'}} )
            {
            if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist )
               { 
               unshift @menulist, $ENV{$$hashref{'name'}};
               }
            }
         my @paramlist=$self->_getparamsets($self->{tool},
                                            $$hashref{'name'});
         foreach $p ( @paramlist )
            {
            # -- only add them if there are the same number of variables
            if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} )
               {
               if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
                                        {$$hashref{'name'}}] } @menulist)
                  {
                  push @menulist,$$p[$self->{EnvironmentCount}
                                        {$$hashref{'name'}}];
                  }
               }
            else
               {
               $self->verbose("Ignoring tool params - not the same number".
                              " defined (".$#{$p}." != ".
                              $self->{envcount}{$$hashref{'name'}}.")");
               }
            }
         if ( $#menulist >=0 )
            {
            print "Validating Values for Variable: ".$$hashref{'name'}."\n";
            @menulist=$self->_validateparam($$hashref{'type'},@menulist);
            }
         print "\n";
         # -- If theres only one option take it without asking
         if ( $#menulist == 0 && ( ! $self->interactive() ))
            {
            $val=$menulist[0];
            } 
         elsif ( $#menulist > 0 )
            {
            my $in=$self->_askusermenu(
                                       "Multiple possibilities found for ".
                                       $$hashref{'name'}." ( occurrance ".
                                       ($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
                                       "\nPlease Choose: ",
                                       (@menulist,"Other"));
            if ( $in <=$#menulist )
               {
               $val=$menulist[$in];
               }
            else
               {
               undef $val;
               }
            }
         }
      $self->{Envvalue}=$val; # single val parameter
      }
   }

sub Env_text {
        my $self=shift;
        my $name=shift;
        my $string=shift;

        if ( $self->{Arch} ) {
          $self->{currentenvtext}=$self->{currentenvtext}.$string;
        }
}

sub Environment_End
   {
   my $self=shift;
   my $name=shift;
   
   if ( $self->{Arch} )
      {
      if ( ! defined $self->{EnvContext} )
         {
         $self->{switch}->parseerror("</$name> without an opening context");
         }
      # - set the help text
      $self->featuretext($self->{EnvContext},$self->{currentenvtext});
      
      if ( ! defined $self->{Envvalue} )
         {
         $self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
                                           $self->{EnvContext});
         }
      
      $self->{Envvalue}=$self->_expandvars($self->{Envvalue});
      $self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
      $self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};

      # Undefine in time for next pass:
      undef $self->{EnvContext};
      undef $self->{Envvalue};
      }
   }

sub Lib {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        if ( $self->{Arch} ) {
          $self->{tool}->addfeature("lib",$$hashref{'name'});
        }
}

sub External_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref,'ref');
        if ( $self->{Arch} ) {
          $self->{tool}->addfeature("_externals",$$hashref{'ref'});
        }
}

sub Arch_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref,'name');
        ( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
                                                : ($self->{Arch}=0);
        push @{$self->{ARCHBLOCK}}, $self->{Arch};
}

sub Arch_End {
        my $self=shift;
        my $name=shift;

        pop @{$self->{ARCHBLOCK}};
        $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
}
Revision:	1.8
Committed:	Fri Nov 16 16:29:49 2001 UTC (23 years, 5 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.7:	+213 -142 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	williamc	1.2	#
2			# ToolDoc.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8			# SimpleDoc interface to initialise Tool objects
9			#
10			# Interface
11			# ---------
12			# new() : A new ToolDoc object
13			# tool(toolobj) : set the tool object for the class
14			# toolsearcher(searcher) : set the searcher for finding reference tools
15			# setup(file,$name,$version) : setup a tool object from the specified file
16			# return 0 for OK 1 for cancel
17			# interactive([0\|1]) : set the interactive node 0=off 1=on
18
19			package BuildSystem::ToolDoc;
20			require 5.004;
21			use ActiveDoc::SimpleDoc;
22			use Utilities::Verbose;
23			@ISA=qw(Utilities::Verbose);
24
25			sub new {
26			my $class=shift;
27			$self={};
28			bless $self, $class;
29			$self->{cache}=shift;
30			$self->{mydoctype}="BuildSystem::ToolDoc";
31	williamc	1.5	$self->{mydocversion}="1.1";
32	williamc	1.2	$self->init();
33			return $self;
34			}
35
36			sub init {
37			my $self=shift;
38			$self->{switch}=ActiveDoc::SimpleDoc->new();
39	williamc	1.4	$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	williamc	1.5	$self->{switch}->grouptag("Tool","setupinit");
52
53	williamc	1.2	$self->{switch}->newparse("setup");
54			$self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,
55			"", $self,
56			\&Tool_End, $self);
57			$self->{switch}->addtag("setup","Lib",\&Lib, $self,
58			"", $self,
59			"", $self);
60			$self->{switch}->addtag("setup","External",\&External_Start, $self,
61			"", $self,
62			"", $self);
63			$self->{switch}->addtag("setup","Client",\&Client_start, $self,
64			"", $self,
65			\&Client_end, $self);
66			$self->{switch}->addtag("setup","Environment",
67			\&Environment_Start, $self,
68			\&Env_text, $self,
69			\&Environment_End, $self);
70	williamc	1.5	$self->{switch}->addtag("setup","Makefile",
71			\&Makefile_Start, $self,
72			\&Makefile_text, $self,
73			\&Makefile_end, $self);
74	williamc	1.2	$self->{switch}->grouptag("Tool","setup");
75			$self->{switch}->addtag("setup","Architecture",
76			\&Arch_Start,$self,
77			"", $self,
78			\&Arch_End,$self);
79			$self->{Arch}=1;
80			push @{$self->{ARCHBLOCK}}, $self->{Arch};
81
82			}
83
84			sub interactive {
85			my $self=shift;
86
87			@_?$self->{interactive}=shift
88			:((defined $self->{interactive})?$self->{interactive}:0);
89			}
90
91			sub tool {
92			my $self=shift;
93			$self->{tool}=shift;
94			}
95
96			sub toolsearcher {
97			my $self=shift;
98	sashby	1.6
99	williamc	1.2	if ( @_ ) {
100			my $searcher=shift;
101			if ( ! defined $searcher ) {
102			$self->error("Undefined Value passed as a Searcher".
103			" in ToolDoc::toolsearcher");
104			}
105			$self->{toolboxsearcher}=$searcher;
106			}
107			return $self->{toolboxsearcher};
108			}
109
110			sub setup {
111			my $self=shift;
112			my $file=shift;
113			my $name=shift;
114			my $version=shift;
115	williamc	1.5	my $toolbox=shift;
116	williamc	1.2
117			$self->{ToolEnv}{'SCRAMtoolname'}=$name;
118			$self->{ToolEnv}{'SCRAMtoolversion'}=$version;
119			$self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};
120
121			$name=~tr[A-Z][a-z];
122			$self->{tool}->name($name);
123			$self->{tool}->version($version);
124			$self->{switch}->filetoparse($file);
125			$self->{toolfound}=1;
126			# -- check the type of document - can we parse it?
127			my($doctype,$docversion)=$self->{switch}->doctype();
128	williamc	1.5	if (($doctype ne $self->{mydoctype}) \|\|
129			(($self->{mydocversion} ne $docversion) && ($docversion ne "1.0")) ) {
130	williamc	1.2	$self->error("Unable to Parse Document of type $doctype $docversion".
131			"\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")");
132			}
133	williamc	1.4	delete $self->{envcount};
134	williamc	1.5	$self->verbose("Pre-Parse");
135	williamc	1.4	$self->{switch}->parse("setupinit");
136	williamc	1.5	$self->{toolmakefile}=$toolbox->toolmakefile($name,$version);
137			$self->verbose("Setup Parse");
138	williamc	1.2	$self->{switch}->parse("setup");
139	williamc	1.5	undef $self->{toolmakefilefh};
140	sashby	1.7
141	williamc	1.2	return $self->{toolfound};
142			}
143
144			sub featuretext {
145			my $self=shift;
146			my $feature=shift;
147
148			if ( @_ ) {
149			$self->{featuretext}{$feature}=shift;
150			}
151			else {
152			return ($self->{featuretext}{$feature});
153			}
154			}
155
156			sub _checkdefault {
157			my $self=shift;
158			my $hashref=shift;
159
160			if ( defined $$hashref{'default'} ) { #check default
161			my $default;
162			foreach $default ( split /:/, $$hashref{'default'} ) {
163			$default=~s/\"//;
164			if ($self->_testlocation($default,
165			[ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
166			}
167			}
168			return 0;
169			}
170
171	sashby	1.7	sub _testlocation
172			{
173			my $self=shift;
174			my $default=shift;
175			my $testfiles=shift;
176			my $OK='false';
177			my $file;
178	sashby	1.8	my $statusgood = $main::bold."OK".$main::normal;
179			my $statusbad = $main::bold."Not found".$main::normal;
180	sashby	1.7
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	sashby	1.8	printf ("\nTrying %-s ...... >> %s <<\n",$default,$main::bold.$!.$main::normal);
197	sashby	1.7	return 0;
198			};
199
200			($#{$testfiles}==-1) ? $OK='false' : $OK='true';
201	sashby	1.8
202	sashby	1.7	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	sashby	1.8	$status = $statusbad;
212	sashby	1.7	last;
213			}
214	sashby	1.8	$status = $statusgood;
215
216			printf ("\t\tChecking for %-22s............ [%s]\n",$file,$status);
217	sashby	1.7	}
218			print "\n";
219			}
220
221			if ( $OK eq 'true' )
222			{
223	sashby	1.8	printf ("Existence check for %-30s ............ [%s]\n",$default.":",$statusgood);
224	sashby	1.7	return 1;
225			}
226
227			return 0;
228			}
229	williamc	1.2
230			sub _expandvars {
231			my $self=shift;
232			my $string=shift;
233
234			return "" , if ( ! defined $string );
235			$string=~s{
236			\$\((\w+)\)
237			}{
238			if (defined $self->{ToolEnv}{$1}) {
239			$self->_expandvars($self->{ToolEnv}{$1});
240			} else {
241			"\$$1";
242			}
243			}egx;
244			$string=~s{
245			\$(\w+)
246			}{
247			if (defined $self->{ToolEnv}{$1}) {
248			$self->_expandvars($self->{ToolEnv}{$1});
249			} else {
250			"\$$1";
251			}
252			}egx;
253			return $string;
254			}
255
256	williamc	1.3	sub _askusermenu {
257			my $self=shift;
258			my $querystring=shift;
259			my @items=@_;
260	sashby	1.8
261	williamc	1.3	my $path=-1;
262	williamc	1.4	my $n;
263			while ( ($path!~/^\d+$/) \|\| ($path > ($#items+1)) \|\| ($path < 1) ) {
264	williamc	1.3	for (my $i=0; $i<=$#items; $i++ ) {
265	williamc	1.4	$n=$i+1;
266			print $n.") ".$items[$i]."\n";
267	williamc	1.3	}
268			print "\n".$querystring;
269			$path=<STDIN>;
270			chomp $path;
271			}
272	williamc	1.4	$path--;
273	williamc	1.3	return $path;
274			}
275	williamc	1.2
276	sashby	1.8	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	williamc	1.2
290	sashby	1.8	# 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	williamc	1.4	$oldpath=$path;
322	sashby	1.8
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	williamc	1.2	}
336	sashby	1.8	}
337			return $path;
338			}
339	williamc	1.2
340	williamc	1.4	sub _validateparam {
341			my $self=shift;
342			my $type=shift;
343			my @params=@_;
344
345			my @newparams=();
346			foreach $param ( @params ) {
347			if ( defined $self->{'client'}) { # must be a location
348			if ( $self->_testlocation($param ,
349			[ $self->{tool}->getfeature($type)] )) {
350			$self->verbose("$param passed validation");
351			push @newparams,$param;
352			}
353			else {
354			$self->verbose("$param failed validation");
355			}
356			}
357			else {
358			# --- no other tests to pass so it must be OK
359			push @newparams,$param;
360			}
361			}
362			return @newparams;
363			}
364
365	williamc	1.2	#
366			# Propgate through the searcher collecting matching tools
367			#
368			sub _searchtools {
369			my $self=shift;
370			my $tool=shift;
371	williamc	1.4	my $searcher=shift;
372	williamc	1.2
373			my @tools=();
374			my $area;
375			my $rtool;
376	williamc	1.4	my $it=$searcher->newiterator();
377	sashby	1.6
378	williamc	1.4	while ( ! $it->last() ) {
379	williamc	1.2	$area=$it->next();
380			if ( defined $area ) {
381			$self->verbose("Searching for ".$tool->name()." ".
382			$tool->version()." in ".$area->location());
383			$rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
384	williamc	1.3	if ( defined $rtool ) {
385			if ( $rtool->equals($tool) ) {
386			$self->verbose("Found matching tool");
387	williamc	1.2	push @tools,$rtool;
388	williamc	1.3	}
389			else {
390			$self->verbose("Rejected tool ".$rtool->name()." "
391			.$rtool->version());
392			}
393	williamc	1.2	}
394	williamc	1.4	else {
395			$self->verbose("Tool Passed as Undefined");
396			}
397	williamc	1.2	}
398	williamc	1.3	else {
399			$self->verbose("Area passed is not defined");
400			}
401	williamc	1.2	}
402			return @tools;
403			}
404
405			# search toolboxes for a nice list
406			#
407			sub _toolparamcopy {
408			my $self=shift;
409			my $tool=shift;
410			my $param=shift;
411
412			my $rv=0;
413			my @params=();
414			$self->verbose("Check Other Projects for tool");
415	williamc	1.4	my @validtools=();
416			if ( defined $self->{toolboxsearcher} ) {
417			@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
418			}
419			if ( $#validtools >=0 ) {
420			if ( ! $self->interactive() ) {
421	williamc	1.2	@params=$validtools[0]->getfeature($param);
422			if ( $#params >=0 ) {
423			$self->verbose("Extracting Feature $param from tool".
424			" (= @params )\n");
425			$rv=1;
426			}
427			}
428			}
429			return ($rv,@params);
430			}
431
432	williamc	1.4	sub _getparamsets {
433			my $self=shift;
434			my $tool=shift;
435			my $param=shift;
436
437			my @paramlist=();
438			my @params=();
439			$self->verbose("Searching for parameter settings in other tools");
440			my @validtools=();
441			if ( defined $self->{toolboxsearcher} ) {
442			@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
443			}
444			else {
445			$self->verbose("No tool searcher available");
446			}
447			if ( $#validtools >=0 ) {
448			foreach $t ( @validtools ) {
449			@params=$t->getfeature($param);
450			if ( $#params >=0 ) {
451			push @paramlist, [ @params ];
452			$self->verbose("Found @params");
453			}
454			}
455			}
456			return @paramlist;
457			}
458
459	williamc	1.2	# -- Tag Routines
460
461			sub Client_start {
462			my $self=shift;
463			my $name=shift;
464			my $hashref=shift;
465
466			if ( $self->{Arch} ) {
467			$self->{'client'}=1;
468			}
469			}
470
471			sub Client_end {
472			my $self=shift;
473			if ( $self->{Arch} ) {
474			undef $self->{'client'};
475			}
476			}
477
478			sub Tool_Start {
479			my $self=shift;
480			my $name=shift;
481			my $hashref=shift;
482
483			$self->{switch}->checktag($name, $hashref, 'name');
484			$self->{switch}->checktag($name, $hashref, 'version');
485			$self->{switch}->opengroup("Toolactive");
486
487			# lower case the name
488			$$hashref{'name'}=~tr[A-Z][a-z];
489			# make sure we only pick up the tool requested
490			if ( ( $self->{tool}->name() eq $$hashref{'name'} ) &&
491			($self->{tool}->version() eq $$hashref{'version'})) {
492			$self->{switch}->
493			allowgroup("Toolactive",$self->{switch}->currentparsename());
494			$self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
495			$self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
496			$self->{toolfound}=0;
497			}
498			else {
499			$self->{switch}->disallowgroup("Toolactive",
500			$self->{switch}->currentparsename());
501			}
502			}
503
504			sub Tool_End {
505			my $self=shift;
506			my $name=shift;
507			my $hashref=shift;
508
509			$self->{switch}->closegroup("Toolactive");
510	williamc	1.5	}
511
512			sub Makefile_Start {
513			my $self=shift;
514			my $name=shift;
515			my $hashref=shift;
516
517			if ( $self->{Arch} ) {
518			if ( ! defined $self->{toolmakefilefh} ) {
519			$self->{toolmakefilefh}=FileHandle->new();
520			$self->{toolmakefilefh}->open(">".$self->{toolmakefile});
521			}
522			}
523			}
524
525			sub Makefile_text {
526			my $self=shift;
527			my $name=shift;
528			my $string=shift;
529
530			if ( $self->{Arch} ) {
531			print {$self->{toolmakefilefh}} $string;
532			}
533			}
534
535			sub Makefile_end {
536			my $self=shift;
537			my $name=shift;
538			my $hashref=shift;
539
540			if ( $self->{Arch} ) {
541			print {$self->{toolmakefilefh}} "\n";
542			}
543	williamc	1.2	}
544
545	williamc	1.4	# -- collect number of variables of the same name - need to know how many
546			# before main setup processing
547			sub Environment_init {
548			my $self=shift;
549			my $name=shift;
550			my $hashref=shift;
551
552			$self->{switch}->checktag($name, $hashref, 'name');
553			if ( $self->{Arch} ) {
554			if ( exists $self->{envcount}{$$hashref{'name'}} ) {
555			$self->{envcount}{$$hashref{'name'}}++;
556			}
557			else {
558			$self->{envcount}{$$hashref{'name'}}=0;
559			}
560			}
561			}
562
563	sashby	1.8	sub Environment_Start
564			{
565			my $self=shift;
566			my $name=shift;
567			my $hashref=shift;
568	sashby	1.6
569	sashby	1.8	$self->{switch}->checktag($name, $hashref, 'name');
570
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	williamc	1.4
593	sashby	1.8	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			{
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	williamc	1.4	}
650	sashby	1.8	if ( $#menulist >=0 )
651			{
652	sashby	1.7	print "Validating Values for Variable: ".$$hashref{'name'}."\n";
653	williamc	1.4	@menulist=$self->_validateparam($$hashref{'type'},@menulist);
654	sashby	1.8	}
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	williamc	1.2
683			sub Env_text {
684			my $self=shift;
685			my $name=shift;
686			my $string=shift;
687
688			if ( $self->{Arch} ) {
689			$self->{currentenvtext}=$self->{currentenvtext}.$string;
690			}
691			}
692
693	sashby	1.8	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	williamc	1.2
723			sub Lib {
724			my $self=shift;
725			my $name=shift;
726			my $hashref=shift;
727
728			$self->{switch}->checktag($name, $hashref, 'name');
729			if ( $self->{Arch} ) {
730			$self->{tool}->addfeature("lib",$$hashref{'name'});
731			}
732			}
733
734			sub External_Start {
735			my $self=shift;
736			my $name=shift;
737			my $hashref=shift;
738
739			$self->{switch}->checktag($name, $hashref,'ref');
740			if ( $self->{Arch} ) {
741			$self->{tool}->addfeature("_externals",$$hashref{'ref'});
742			}
743			}
744
745			sub Arch_Start {
746			my $self=shift;
747			my $name=shift;
748			my $hashref=shift;
749
750			$self->{switch}->checktag($name, $hashref,'name');
751			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
752			: ($self->{Arch}=0);
753			push @{$self->{ARCHBLOCK}}, $self->{Arch};
754			}
755
756			sub Arch_End {
757			my $self=shift;
758			my $name=shift;
759
760			pop @{$self->{ARCHBLOCK}};
761			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
762			}