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;
   
   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,$!,);
         return 0;
         };
      
      ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
      #print "\n";
      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 = "[not found]";
            last;
            }
         $status = "[OK]";
         printf ("\t\tChecking for %-22s............ %-s\n",$file,$status);
         }
      print "\n";
      }
   
   if ( $OK eq 'true' )
      {
      printf ("Existence check for %-30s ............ [OK]\n",$default.":");
      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 $type=$self->{tool}->type($varname);
        my $path;
        my $oldpath;
        print $self->featuretext($self->{EnvContext});
        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 ( ! defined $path ) {
            print "Error : ".$oldpath." is not valid.\n";
            next;
           }
         }
         return $path;
        } #end for

}

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() ))
              {
              print "VALUE: ",$val,"\n";
              $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};
          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.7
Committed:	Thu Nov 15 21:18:16 2001 UTC (23 years, 5 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.6:	+64 -45 lines
Log Message:	Committing the days changes.
#	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
179			chomp $default;
180			$default=$self->_expandvars($default);
181			$self->verbose("Testing location");
182
183			if ( -f $default )
184			{
185			$OK="true";
186			$self->verbose("File OK");
187			}
188			else
189			{
190			my $dh=DirHandle->new();
191
192			opendir $dh, $default or do
193			{
194			printf ("\nTrying %-s ...... >>%s<<\n",$default,$!,);
195			return 0;
196			};
197
198			($#{$testfiles}==-1) ? $OK='false' : $OK='true';
199			#print "\n";
200			my @files=readdir $dh;
201			undef $dh;
202
203			foreach $file ( @$testfiles )
204			{
205			# now check that the required files are actually there
206			if ( ( $number = grep /\Q$file\L/, @files) == 0 )
207			{
208			$OK='false';
209			$status = "[not found]";
210			last;
211			}
212			$status = "[OK]";
213			printf ("\t\tChecking for %-22s............ %-s\n",$file,$status);
214			}
215			print "\n";
216			}
217
218			if ( $OK eq 'true' )
219			{
220			printf ("Existence check for %-30s ............ [OK]\n",$default.":");
221			return 1;
222			}
223
224			return 0;
225			}
226	williamc	1.2
227			sub _expandvars {
228			my $self=shift;
229			my $string=shift;
230
231			return "" , if ( ! defined $string );
232			$string=~s{
233			\$\((\w+)\)
234			}{
235			if (defined $self->{ToolEnv}{$1}) {
236			$self->_expandvars($self->{ToolEnv}{$1});
237			} else {
238			"\$$1";
239			}
240			}egx;
241			$string=~s{
242			\$(\w+)
243			}{
244			if (defined $self->{ToolEnv}{$1}) {
245			$self->_expandvars($self->{ToolEnv}{$1});
246			} else {
247			"\$$1";
248			}
249			}egx;
250			return $string;
251			}
252
253	williamc	1.3	sub _askusermenu {
254			my $self=shift;
255			my $querystring=shift;
256			my @items=@_;
257
258			my $path=-1;
259	williamc	1.4	my $n;
260			while ( ($path!~/^\d+$/) \|\| ($path > ($#items+1)) \|\| ($path < 1) ) {
261	williamc	1.3	for (my $i=0; $i<=$#items; $i++ ) {
262	williamc	1.4	$n=$i+1;
263			print $n.") ".$items[$i]."\n";
264	williamc	1.3	}
265			print "\n".$querystring;
266			$path=<STDIN>;
267			chomp $path;
268			}
269	williamc	1.4	$path--;
270	williamc	1.3	return $path;
271			}
272	williamc	1.2
273			sub _askuser {
274			my $self=shift;
275			my $querystring=shift;
276			my $varname=shift;
277
278	williamc	1.4	my $type=$self->{tool}->type($varname);
279			my $path;
280			my $oldpath;
281	williamc	1.2	print $self->featuretext($self->{EnvContext});
282			for ( ;; ) {
283			print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
284			$path=<STDIN>;
285			chomp $path;
286	williamc	1.4	$oldpath=$path;
287	williamc	1.2	if ( $path ne "" ) {
288	williamc	1.4	($path)=$self->_validateparam($type,$path);
289			if ( ! defined $path ) {
290			print "Error : ".$oldpath." is not valid.\n";
291			next;
292			}
293	williamc	1.2	}
294	williamc	1.4	return $path;
295	williamc	1.2	} #end for
296
297			}
298
299	williamc	1.4	sub _validateparam {
300			my $self=shift;
301			my $type=shift;
302			my @params=@_;
303
304			my @newparams=();
305			foreach $param ( @params ) {
306			if ( defined $self->{'client'}) { # must be a location
307			if ( $self->_testlocation($param ,
308			[ $self->{tool}->getfeature($type)] )) {
309			$self->verbose("$param passed validation");
310			push @newparams,$param;
311			}
312			else {
313			$self->verbose("$param failed validation");
314			}
315			}
316			else {
317			# --- no other tests to pass so it must be OK
318			push @newparams,$param;
319			}
320			}
321			return @newparams;
322			}
323
324	williamc	1.2	#
325			# Propgate through the searcher collecting matching tools
326			#
327			sub _searchtools {
328			my $self=shift;
329			my $tool=shift;
330	williamc	1.4	my $searcher=shift;
331	williamc	1.2
332			my @tools=();
333			my $area;
334			my $rtool;
335	williamc	1.4	my $it=$searcher->newiterator();
336	sashby	1.6
337	williamc	1.4	while ( ! $it->last() ) {
338	williamc	1.2	$area=$it->next();
339			if ( defined $area ) {
340			$self->verbose("Searching for ".$tool->name()." ".
341			$tool->version()." in ".$area->location());
342			$rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
343	williamc	1.3	if ( defined $rtool ) {
344			if ( $rtool->equals($tool) ) {
345			$self->verbose("Found matching tool");
346	williamc	1.2	push @tools,$rtool;
347	williamc	1.3	}
348			else {
349			$self->verbose("Rejected tool ".$rtool->name()." "
350			.$rtool->version());
351			}
352	williamc	1.2	}
353	williamc	1.4	else {
354			$self->verbose("Tool Passed as Undefined");
355			}
356	williamc	1.2	}
357	williamc	1.3	else {
358			$self->verbose("Area passed is not defined");
359			}
360	williamc	1.2	}
361			return @tools;
362			}
363
364			# search toolboxes for a nice list
365			#
366			sub _toolparamcopy {
367			my $self=shift;
368			my $tool=shift;
369			my $param=shift;
370
371			my $rv=0;
372			my @params=();
373			$self->verbose("Check Other Projects for tool");
374	williamc	1.4	my @validtools=();
375			if ( defined $self->{toolboxsearcher} ) {
376			@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
377			}
378			if ( $#validtools >=0 ) {
379			if ( ! $self->interactive() ) {
380	williamc	1.2	@params=$validtools[0]->getfeature($param);
381			if ( $#params >=0 ) {
382			$self->verbose("Extracting Feature $param from tool".
383			" (= @params )\n");
384			$rv=1;
385			}
386			}
387			}
388			return ($rv,@params);
389			}
390
391	williamc	1.4	sub _getparamsets {
392			my $self=shift;
393			my $tool=shift;
394			my $param=shift;
395
396			my @paramlist=();
397			my @params=();
398			$self->verbose("Searching for parameter settings in other tools");
399			my @validtools=();
400			if ( defined $self->{toolboxsearcher} ) {
401			@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
402			}
403			else {
404			$self->verbose("No tool searcher available");
405			}
406			if ( $#validtools >=0 ) {
407			foreach $t ( @validtools ) {
408			@params=$t->getfeature($param);
409			if ( $#params >=0 ) {
410			push @paramlist, [ @params ];
411			$self->verbose("Found @params");
412			}
413			}
414			}
415			return @paramlist;
416			}
417
418	williamc	1.2	# -- Tag Routines
419
420			sub Client_start {
421			my $self=shift;
422			my $name=shift;
423			my $hashref=shift;
424
425			if ( $self->{Arch} ) {
426			$self->{'client'}=1;
427			}
428			}
429
430			sub Client_end {
431			my $self=shift;
432			if ( $self->{Arch} ) {
433			undef $self->{'client'};
434			}
435			}
436
437			sub Tool_Start {
438			my $self=shift;
439			my $name=shift;
440			my $hashref=shift;
441
442			$self->{switch}->checktag($name, $hashref, 'name');
443			$self->{switch}->checktag($name, $hashref, 'version');
444			$self->{switch}->opengroup("Toolactive");
445
446			# lower case the name
447			$$hashref{'name'}=~tr[A-Z][a-z];
448			# make sure we only pick up the tool requested
449			if ( ( $self->{tool}->name() eq $$hashref{'name'} ) &&
450			($self->{tool}->version() eq $$hashref{'version'})) {
451			$self->{switch}->
452			allowgroup("Toolactive",$self->{switch}->currentparsename());
453			$self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
454			$self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
455			$self->{toolfound}=0;
456			}
457			else {
458			$self->{switch}->disallowgroup("Toolactive",
459			$self->{switch}->currentparsename());
460			}
461			}
462
463			sub Tool_End {
464			my $self=shift;
465			my $name=shift;
466			my $hashref=shift;
467
468			$self->{switch}->closegroup("Toolactive");
469	williamc	1.5	}
470
471			sub Makefile_Start {
472			my $self=shift;
473			my $name=shift;
474			my $hashref=shift;
475
476			if ( $self->{Arch} ) {
477			if ( ! defined $self->{toolmakefilefh} ) {
478			$self->{toolmakefilefh}=FileHandle->new();
479			$self->{toolmakefilefh}->open(">".$self->{toolmakefile});
480			}
481			}
482			}
483
484			sub Makefile_text {
485			my $self=shift;
486			my $name=shift;
487			my $string=shift;
488
489			if ( $self->{Arch} ) {
490			print {$self->{toolmakefilefh}} $string;
491			}
492			}
493
494			sub Makefile_end {
495			my $self=shift;
496			my $name=shift;
497			my $hashref=shift;
498
499			if ( $self->{Arch} ) {
500			print {$self->{toolmakefilefh}} "\n";
501			}
502	williamc	1.2	}
503
504	williamc	1.4	# -- collect number of variables of the same name - need to know how many
505			# before main setup processing
506			sub Environment_init {
507			my $self=shift;
508			my $name=shift;
509			my $hashref=shift;
510
511			$self->{switch}->checktag($name, $hashref, 'name');
512			if ( $self->{Arch} ) {
513			if ( exists $self->{envcount}{$$hashref{'name'}} ) {
514			$self->{envcount}{$$hashref{'name'}}++;
515			}
516			else {
517			$self->{envcount}{$$hashref{'name'}}=0;
518			}
519			}
520			}
521
522	williamc	1.2	sub Environment_Start {
523			my $self=shift;
524			my $name=shift;
525			my $hashref=shift;
526	sashby	1.6
527	williamc	1.2	$self->{switch}->checktag($name, $hashref, 'name');
528			if ( $self->{Arch} ) {
529	williamc	1.4	my $val=undef;
530	williamc	1.2	if ( defined $self->{EnvContext} ) {
531			$self->parserror(" Attempted to open new <$name> context".
532			" without closing the previous one");
533			}
534	williamc	1.4	# -- 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			}
541
542	williamc	1.2	$self->{currentenvtext}="";
543			$self->{EnvContext}=$$hashref{'name'};
544			undef $self->{Envvalue};
545			if ( exists $$hashref{'type'} ) {
546			$$hashref{'type'}=~tr[A-Z][a-z];
547			$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
548			}
549	williamc	1.4	# check other installed copies of the tool
550			# -- construct a menu of options
551			my @menulist=();
552			# -- a value is fixed - unless interactive switch is on
553	williamc	1.2	if ( exists $$hashref{'value'}) {
554	williamc	1.4	$val=$$hashref{'value'};
555			if ( $self->interactive() ) {
556			unshift @menulist,$$hashref{'value'};
557			}
558	williamc	1.2	}
559	williamc	1.4	# -- add any default values to the selection
560			if ( ! defined $val ) {
561			if ( $self->_checkdefault($hashref) ) {
562			my $var=$self->_expandvars($$hashref{'default'});
563			if ( !grep { $_ eq $var } @menulist ) {
564			unshift @menulist, $var;
565			}
566	williamc	1.2	}
567	williamc	1.4	# -- check the environment
568			if ( defined $ENV{$$hashref{'name'}} ) {
569			if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) {
570			unshift @menulist, $ENV{$$hashref{'name'}};
571			}
572	williamc	1.2	}
573	williamc	1.4	my @paramlist=$self->_getparamsets($self->{tool},
574			$$hashref{'name'});
575			foreach $p ( @paramlist ) {
576			# -- only add them if there are the same number of variables
577			if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) {
578			if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
579			{$$hashref{'name'}}] } @menulist) {
580			push @menulist,$$p[$self->{EnvironmentCount}
581			{$$hashref{'name'}}];
582			}
583			}
584			else {
585			$self->verbose("Ignoring tool params - not the same number".
586			" defined (".$#{$p}." != ".
587			$self->{envcount}{$$hashref{'name'}}.")");
588			}
589	williamc	1.2	}
590	williamc	1.4	if ( $#menulist >=0 ) {
591	sashby	1.7	print "Validating Values for Variable: ".$$hashref{'name'}."\n";
592	williamc	1.4	@menulist=$self->_validateparam($$hashref{'type'},@menulist);
593			}
594	sashby	1.7	print "\n";
595	williamc	1.4	# -- If theres only one option take it without asking
596	sashby	1.7	if ( $#menulist == 0 && ( ! $self->interactive() ))
597			{
598			print "VALUE: ",$val,"\n";
599			$val=$menulist[0];
600			}
601	williamc	1.4	elsif ( $#menulist > 0 ) {
602			my $in=$self->_askusermenu(
603			"Multiple possibilities found for ".
604	sashby	1.7	$$hashref{'name'}." ( occurrance ".
605	williamc	1.4	($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
606			"\nPlease Choose: ",
607			(@menulist,"Other"));
608			if ( $in <=$#menulist ) {
609			$val=$menulist[$in];
610			}
611			else {
612			undef $val;
613			}
614			}
615	williamc	1.2	}
616	williamc	1.4	$self->{Envvalue}=$val; # single val parameter
617	williamc	1.2	}
618			}
619
620			sub Env_text {
621			my $self=shift;
622			my $name=shift;
623			my $string=shift;
624
625			if ( $self->{Arch} ) {
626			$self->{currentenvtext}=$self->{currentenvtext}.$string;
627			}
628			}
629
630			sub Environment_End {
631			my $self=shift;
632			my $name=shift;
633
634			if ( $self->{Arch} ) {
635			if ( ! defined $self->{EnvContext} ) {
636			$self->{switch}->parseerror("</$name> without an opening context");
637			}
638			# - set the help text
639			$self->featuretext($self->{EnvContext},$self->{currentenvtext});
640			if ( ! defined $self->{Envvalue} ) {
641			$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
642			$self->{EnvContext});
643			}
644			$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
645			$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
646			$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
647			undef $self->{EnvContext};
648			undef $self->{Envvalue};
649			}
650			}
651
652			sub Lib {
653			my $self=shift;
654			my $name=shift;
655			my $hashref=shift;
656
657			$self->{switch}->checktag($name, $hashref, 'name');
658			if ( $self->{Arch} ) {
659			$self->{tool}->addfeature("lib",$$hashref{'name'});
660			}
661			}
662
663			sub External_Start {
664			my $self=shift;
665			my $name=shift;
666			my $hashref=shift;
667
668			$self->{switch}->checktag($name, $hashref,'ref');
669			if ( $self->{Arch} ) {
670			$self->{tool}->addfeature("_externals",$$hashref{'ref'});
671			}
672			}
673
674			sub Arch_Start {
675			my $self=shift;
676			my $name=shift;
677			my $hashref=shift;
678
679			$self->{switch}->checktag($name, $hashref,'name');
680			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
681			: ($self->{Arch}=0);
682			push @{$self->{ARCHBLOCK}}, $self->{Arch};
683			}
684
685			sub Arch_End {
686			my $self=shift;
687			my $name=shift;
688
689			pop @{$self->{ARCHBLOCK}};
690			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
691			}