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.0";
        $self->init();
        return $self;
}

sub init {
        my $self=shift;
        $self->{switch}=ActiveDoc::SimpleDoc->new();
        $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}->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;

        $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) ) {
          $self->error("Unable to Parse Document of type $doctype $docversion".
                "\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")");
        }
        $self->{switch}->parse("setup");
        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);
        print "Trying $default .... ";
        if ( -f $default ) {
                $OK="true";
        }
        else {
          my $fh=FileHandle->new();
          opendir $fh,  $default or do { print "No \n"; return 0; };
         ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
          print "\n";
          my @files=readdir $fh;
          undef $fh;
          foreach $file ( @$testfiles ) {
                print "   Checking for $file .... ";
                # now check that the required files are actually there
                if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
                   $OK='false';
                   print "not found\n";
                   last;
                }
                print "found\n";
          }
        }
        if ( $OK eq 'true' ) {
                print "Directory Check Complete\n";
                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;
        while ( ($path!~/^\d+$/) || ($path > $#items) || ($path < 0) ) {
         for (my $i=0; $i<=$#items; $i++ ) {
          print $i.") ".$items[$i]."\n";
         }
         print "\n".$querystring;
         $path=<STDIN>;
         chomp $path;
        }
        return $path;
}

sub _askuser {
        my $self=shift;
        my $querystring=shift;
        my $varname=shift;

        print $self->featuretext($self->{EnvContext});
        for  ( ;; ) {
         print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
         $path=<STDIN>;
         chomp $path;
         if ( $path ne "" ) {
          if ( defined $self->{'client'}) { # must be a location
           if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
             return $path;
           }
           print "Error : ".$path." does not exist.\n";
           next;
          }
         }
         else {
           return $path;
         }
        } #end for

}

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

        my @tools=();
        my $area;
        my $rtool;
        if ( defined $self->{toolboxsearcher} ) {
           my $it=$self->{toolboxsearcher}->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("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=$self->_searchtools($tool);
        if ( ! $self->interactive() ) {
          if ( $#validtools >=0 ) {
           @params=$validtools[0]->getfeature($param);
           if ( $#params >=0 ) {
                $self->verbose("Extracting Feature $param from tool".
                        " (= @params )\n");
                #$tool->setfeature($param,@params);
                $rv=1;
           }
          }
        }
        return ($rv,@params);
}

# -- 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 Environment_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->{switch}->checktag($name, $hashref, 'name');
        if ( $self->{Arch} ) {
          if ( defined $self->{EnvContext} ) {
            $self->parserror(" Attempted to open new <$name> context".
                        " without closing the previous one");
          }
          $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'});
          }
          if ( exists $$hashref{'value'}) {
            $self->{Envvalue}=$$hashref{'value'};
          }
          elsif ( ! $self->interactive() ) {
           # check other installed copies of the tool
           my ($rv,@params)=
                $self->_toolparamcopy($self->{tool},$$hashref{'name'});
           if ( $rv && ($#params == 0)) { #dont use multivalued params!
              # -- if default is OK as well ask user which one to choose
              my $val=$params[0];
              if ( $self->_checkdefault($hashref) ) {
                # -- many options - just ask the user
                my $expdef=$self->_expandvars($$hashref{'default'});
                if ( $expdef ne $val ) {
                 my $in=$self->_askusermenu(
                        "Multiple possibilities found. Please Choose:",
                        ($params[0],$expdef,"Other"));
                 if ( $in == 1 ) {
                  $val=$expdef;
                 }
                 elsif ( $in == 2 ) {
                  $val=$self->_askuser("Please Enter Value:",$$hashref{'name'});
                 }
                }
              } 
              $self->{Envvalue}=$val; # single val parameter
           }
           elsif ( defined $ENV{$$hashref{'name'}} ) {
              # check the environment
              $self->{Envvalue}=$ENV{$$hashref{'name'}};
           }
           elsif ( $self->_checkdefault($hashref) ) {
              $self->{Envvalue}=$$hashref{'default'};
           }
          }
        }
}

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.3
Committed:	Mon Oct 23 12:56:03 2000 UTC (24 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+45 -2 lines
Log Message:	Import from V0_15branch - ToolDoc menus
#	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			$self->{mydocversion}="1.0";
32			$self->init();
33			return $self;
34			}
35
36			sub init {
37			my $self=shift;
38			$self->{switch}=ActiveDoc::SimpleDoc->new();
39			$self->{switch}->newparse("setup");
40			$self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,
41			"", $self,
42			\&Tool_End, $self);
43			$self->{switch}->addtag("setup","Lib",\&Lib, $self,
44			"", $self,
45			"", $self);
46			$self->{switch}->addtag("setup","External",\&External_Start, $self,
47			"", $self,
48			"", $self);
49			$self->{switch}->addtag("setup","Client",\&Client_start, $self,
50			"", $self,
51			\&Client_end, $self);
52			$self->{switch}->addtag("setup","Environment",
53			\&Environment_Start, $self,
54			\&Env_text, $self,
55			\&Environment_End, $self);
56			$self->{switch}->grouptag("Tool","setup");
57			$self->{switch}->addtag("setup","Architecture",
58			\&Arch_Start,$self,
59			"", $self,
60			\&Arch_End,$self);
61			$self->{Arch}=1;
62			push @{$self->{ARCHBLOCK}}, $self->{Arch};
63
64			}
65
66			sub interactive {
67			my $self=shift;
68
69			@_?$self->{interactive}=shift
70			:((defined $self->{interactive})?$self->{interactive}:0);
71			}
72
73			sub tool {
74			my $self=shift;
75			$self->{tool}=shift;
76			}
77
78			sub toolsearcher {
79			my $self=shift;
80			if ( @_ ) {
81			my $searcher=shift;
82			if ( ! defined $searcher ) {
83			$self->error("Undefined Value passed as a Searcher".
84			" in ToolDoc::toolsearcher");
85			}
86			$self->{toolboxsearcher}=$searcher;
87			}
88			return $self->{toolboxsearcher};
89			}
90
91			sub setup {
92			my $self=shift;
93			my $file=shift;
94			my $name=shift;
95			my $version=shift;
96
97			$self->{ToolEnv}{'SCRAMtoolname'}=$name;
98			$self->{ToolEnv}{'SCRAMtoolversion'}=$version;
99			$self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};
100
101			$name=~tr[A-Z][a-z];
102			$self->{tool}->name($name);
103			$self->{tool}->version($version);
104			$self->{switch}->filetoparse($file);
105			$self->{toolfound}=1;
106			# -- check the type of document - can we parse it?
107			my($doctype,$docversion)=$self->{switch}->doctype();
108			if ( ($doctype ne $self->{mydoctype}) \|\|
109			($self->{mydocversion} ne $docversion) ) {
110			$self->error("Unable to Parse Document of type $doctype $docversion".
111			"\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")");
112			}
113			$self->{switch}->parse("setup");
114			return $self->{toolfound};
115			}
116
117			sub featuretext {
118			my $self=shift;
119			my $feature=shift;
120
121			if ( @_ ) {
122			$self->{featuretext}{$feature}=shift;
123			}
124			else {
125			return ($self->{featuretext}{$feature});
126			}
127			}
128
129			sub _checkdefault {
130			my $self=shift;
131			my $hashref=shift;
132
133			if ( defined $$hashref{'default'} ) { #check default
134			my $default;
135			foreach $default ( split /:/, $$hashref{'default'} ) {
136			$default=~s/\"//;
137			if ($self->_testlocation($default,
138			[ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
139			}
140			}
141			return 0;
142			}
143
144			sub _testlocation {
145			my $self=shift;
146			my $default=shift;
147			my $testfiles=shift;
148			my $OK='false';
149			my $file;
150
151			chomp $default;
152			$default=$self->_expandvars($default);
153			print "Trying $default .... ";
154			if ( -f $default ) {
155			$OK="true";
156			}
157			else {
158			my $fh=FileHandle->new();
159			opendir $fh, $default or do { print "No \n"; return 0; };
160			($#{$testfiles}==-1) ? $OK='false' : $OK='true';
161			print "\n";
162			my @files=readdir $fh;
163			undef $fh;
164			foreach $file ( @$testfiles ) {
165			print " Checking for $file .... ";
166			# now check that the required files are actually there
167			if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
168			$OK='false';
169			print "not found\n";
170			last;
171			}
172			print "found\n";
173			}
174			}
175			if ( $OK eq 'true' ) {
176			print "Directory Check Complete\n";
177			return 1
178			}
179			return 0
180			}
181
182			sub _expandvars {
183			my $self=shift;
184			my $string=shift;
185
186			return "" , if ( ! defined $string );
187			$string=~s{
188			\$\((\w+)\)
189			}{
190			if (defined $self->{ToolEnv}{$1}) {
191			$self->_expandvars($self->{ToolEnv}{$1});
192			} else {
193			"\$$1";
194			}
195			}egx;
196			$string=~s{
197			\$(\w+)
198			}{
199			if (defined $self->{ToolEnv}{$1}) {
200			$self->_expandvars($self->{ToolEnv}{$1});
201			} else {
202			"\$$1";
203			}
204			}egx;
205			return $string;
206			}
207
208	williamc	1.3	sub _askusermenu {
209			my $self=shift;
210			my $querystring=shift;
211			my @items=@_;
212
213			my $path=-1;
214			while ( ($path!~/^\d+$/) \|\| ($path > $#items) \|\| ($path < 0) ) {
215			for (my $i=0; $i<=$#items; $i++ ) {
216			print $i.") ".$items[$i]."\n";
217			}
218			print "\n".$querystring;
219			$path=<STDIN>;
220			chomp $path;
221			}
222			return $path;
223			}
224	williamc	1.2
225			sub _askuser {
226			my $self=shift;
227			my $querystring=shift;
228			my $varname=shift;
229
230			print $self->featuretext($self->{EnvContext});
231			for ( ;; ) {
232			print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
233			$path=<STDIN>;
234			chomp $path;
235			if ( $path ne "" ) {
236			if ( defined $self->{'client'}) { # must be a location
237			if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
238			return $path;
239			}
240			print "Error : ".$path." does not exist.\n";
241			next;
242			}
243			}
244			else {
245			return $path;
246			}
247			} #end for
248
249			}
250
251			#
252			# Propgate through the searcher collecting matching tools
253			#
254			sub _searchtools {
255			my $self=shift;
256			my $tool=shift;
257
258			my @tools=();
259			my $area;
260			my $rtool;
261			if ( defined $self->{toolboxsearcher} ) {
262			my $it=$self->{toolboxsearcher}->newiterator();
263			while ( ! $it->last() ) {
264			$area=$it->next();
265			if ( defined $area ) {
266			$self->verbose("Searching for ".$tool->name()." ".
267			$tool->version()." in ".$area->location());
268			$rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
269	williamc	1.3	if ( defined $rtool ) {
270			if ( $rtool->equals($tool) ) {
271			$self->verbose("Found matching tool");
272	williamc	1.2	push @tools,$rtool;
273	williamc	1.3	}
274			else {
275			$self->verbose("Rejected tool ".$rtool->name()." "
276			.$rtool->version());
277			}
278	williamc	1.2	}
279			}
280	williamc	1.3	else {
281			$self->verbose("Area passed is not defined");
282			}
283	williamc	1.2	}
284			}
285			return @tools;
286			}
287
288			# search toolboxes for a nice list
289			#
290			sub _toolparamcopy {
291			my $self=shift;
292			my $tool=shift;
293			my $param=shift;
294
295			my $rv=0;
296			my @params=();
297			$self->verbose("Check Other Projects for tool");
298			my @validtools=$self->_searchtools($tool);
299			if ( ! $self->interactive() ) {
300			if ( $#validtools >=0 ) {
301			@params=$validtools[0]->getfeature($param);
302			if ( $#params >=0 ) {
303			$self->verbose("Extracting Feature $param from tool".
304			" (= @params )\n");
305			#$tool->setfeature($param,@params);
306			$rv=1;
307			}
308			}
309			}
310			return ($rv,@params);
311			}
312
313			# -- Tag Routines
314
315			sub Client_start {
316			my $self=shift;
317			my $name=shift;
318			my $hashref=shift;
319
320			if ( $self->{Arch} ) {
321			$self->{'client'}=1;
322			}
323			}
324
325			sub Client_end {
326			my $self=shift;
327			if ( $self->{Arch} ) {
328			undef $self->{'client'};
329			}
330			}
331
332			sub Tool_Start {
333			my $self=shift;
334			my $name=shift;
335			my $hashref=shift;
336
337			$self->{switch}->checktag($name, $hashref, 'name');
338			$self->{switch}->checktag($name, $hashref, 'version');
339			$self->{switch}->opengroup("Toolactive");
340
341			# lower case the name
342			$$hashref{'name'}=~tr[A-Z][a-z];
343			# make sure we only pick up the tool requested
344			if ( ( $self->{tool}->name() eq $$hashref{'name'} ) &&
345			($self->{tool}->version() eq $$hashref{'version'})) {
346			$self->{switch}->
347			allowgroup("Toolactive",$self->{switch}->currentparsename());
348			$self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
349			$self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
350			$self->{toolfound}=0;
351			}
352			else {
353			$self->{switch}->disallowgroup("Toolactive",
354			$self->{switch}->currentparsename());
355			}
356			}
357
358			sub Tool_End {
359			my $self=shift;
360			my $name=shift;
361			my $hashref=shift;
362
363			$self->{switch}->closegroup("Toolactive");
364			}
365
366			sub Environment_Start {
367			my $self=shift;
368			my $name=shift;
369			my $hashref=shift;
370
371			$self->{switch}->checktag($name, $hashref, 'name');
372			if ( $self->{Arch} ) {
373			if ( defined $self->{EnvContext} ) {
374			$self->parserror(" Attempted to open new <$name> context".
375			" without closing the previous one");
376			}
377			$self->{currentenvtext}="";
378			$self->{EnvContext}=$$hashref{'name'};
379			undef $self->{Envvalue};
380			if ( exists $$hashref{'type'} ) {
381			$$hashref{'type'}=~tr[A-Z][a-z];
382			$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
383			}
384			if ( exists $$hashref{'value'}) {
385			$self->{Envvalue}=$$hashref{'value'};
386			}
387			elsif ( ! $self->interactive() ) {
388			# check other installed copies of the tool
389			my ($rv,@params)=
390			$self->_toolparamcopy($self->{tool},$$hashref{'name'});
391			if ( $rv && ($#params == 0)) { #dont use multivalued params!
392	williamc	1.3	# -- if default is OK as well ask user which one to choose
393			my $val=$params[0];
394			if ( $self->_checkdefault($hashref) ) {
395			# -- many options - just ask the user
396			my $expdef=$self->_expandvars($$hashref{'default'});
397			if ( $expdef ne $val ) {
398			my $in=$self->_askusermenu(
399			"Multiple possibilities found. Please Choose:",
400			($params[0],$expdef,"Other"));
401			if ( $in == 1 ) {
402			$val=$expdef;
403			}
404			elsif ( $in == 2 ) {
405			$val=$self->_askuser("Please Enter Value:",$$hashref{'name'});
406			}
407			}
408			}
409			$self->{Envvalue}=$val; # single val parameter
410	williamc	1.2	}
411			elsif ( defined $ENV{$$hashref{'name'}} ) {
412			# check the environment
413			$self->{Envvalue}=$ENV{$$hashref{'name'}};
414			}
415			elsif ( $self->_checkdefault($hashref) ) {
416			$self->{Envvalue}=$$hashref{'default'};
417			}
418			}
419			}
420			}
421
422			sub Env_text {
423			my $self=shift;
424			my $name=shift;
425			my $string=shift;
426
427			if ( $self->{Arch} ) {
428			$self->{currentenvtext}=$self->{currentenvtext}.$string;
429			}
430			}
431
432			sub Environment_End {
433			my $self=shift;
434			my $name=shift;
435
436			if ( $self->{Arch} ) {
437			if ( ! defined $self->{EnvContext} ) {
438			$self->{switch}->parseerror("</$name> without an opening context");
439			}
440			# - set the help text
441			$self->featuretext($self->{EnvContext},$self->{currentenvtext});
442			if ( ! defined $self->{Envvalue} ) {
443			$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
444			$self->{EnvContext});
445			}
446			$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
447			$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
448			$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
449			undef $self->{EnvContext};
450			undef $self->{Envvalue};
451			}
452			}
453
454			sub Lib {
455			my $self=shift;
456			my $name=shift;
457			my $hashref=shift;
458
459			$self->{switch}->checktag($name, $hashref, 'name');
460			if ( $self->{Arch} ) {
461			$self->{tool}->addfeature("lib",$$hashref{'name'});
462			}
463			}
464
465			sub External_Start {
466			my $self=shift;
467			my $name=shift;
468			my $hashref=shift;
469
470			$self->{switch}->checktag($name, $hashref,'ref');
471			if ( $self->{Arch} ) {
472			$self->{tool}->addfeature("_externals",$$hashref{'ref'});
473			}
474			}
475
476			sub Arch_Start {
477			my $self=shift;
478			my $name=shift;
479			my $hashref=shift;
480
481			$self->{switch}->checktag($name, $hashref,'name');
482			( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
483			: ($self->{Arch}=0);
484			push @{$self->{ARCHBLOCK}}, $self->{Arch};
485			}
486
487			sub Arch_End {
488			my $self=shift;
489			my $name=shift;
490
491			pop @{$self->{ARCHBLOCK}};
492			$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
493			}
494
495