ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolDoc.pm

Comparing COMP/SCRAM/src/BuildSystem/ToolDoc.pm (file contents):
Revision 1.3 by williamc, Mon Oct 23 12:56:03 2000 UTC vs.
Revision 1.9 by sashby, Mon Nov 19 18:46:39 2001 UTC

#	Line 28 | Line 28 | sub new {
28		bless $self, $class;
29		$self->{cache}=shift;
30		$self->{mydoctype}="BuildSystem::ToolDoc";
31	<	$self->{mydocversion}="1.0";
31	>	$self->{mydocversion}="1.1";
32		$self->init();
33		return $self;
34		}
#	Line 36 | Line 36 | sub new {
36		sub init {
37		my $self=shift;
38		$self->{switch}=ActiveDoc::SimpleDoc->new();
39	+	$self->{switch}->newparse("setupinit");
40	+	$self->{switch}->addtag("setupinit","Tool",\&Tool_Start, $self,
41	+	"", $self,
42	+	\&Tool_End, $self);
43	+	$self->{switch}->addtag("setupinit", "Architecture",
44	+	\&Arch_Start,$self,
45	+	"", $self,
46	+	\&Arch_End,$self);
47	+	$self->{switch}->addtag("setupinit","Environment",
48	+	\&Environment_init, $self,
49	+	"", $self,
50	+	"", $self);
51	+	$self->{switch}->grouptag("Tool","setupinit");
52	+
53		$self->{switch}->newparse("setup");
54		$self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,
55		"", $self,
#	Line 53 | Line 67 | sub init {
67		\&Environment_Start, $self,
68		\&Env_text, $self,
69		\&Environment_End, $self);
70	+	$self->{switch}->addtag("setup","Makefile",
71	+	\&Makefile_Start, $self,
72	+	\&Makefile_text, $self,
73	+	\&Makefile_end, $self);
74		$self->{switch}->grouptag("Tool","setup");
75		$self->{switch}->addtag("setup","Architecture",
76		\&Arch_Start,$self,
#	Line 77 | Line 95 | sub tool {
95
96		sub toolsearcher {
97		my $self=shift;
98	+
99		if ( @_ ) {
100		my $searcher=shift;
101		if ( ! defined $searcher ) {
#	Line 93 | Line 112 | sub setup {
112		my $file=shift;
113		my $name=shift;
114		my $version=shift;
115	+	my $toolbox=shift;
116
117		$self->{ToolEnv}{'SCRAMtoolname'}=$name;
118		$self->{ToolEnv}{'SCRAMtoolversion'}=$version;
#	Line 105 | Line 125 | sub setup {
125		$self->{toolfound}=1;
126		# -- check the type of document - can we parse it?
127		my($doctype,$docversion)=$self->{switch}->doctype();
128	<	if ( ($doctype ne $self->{mydoctype}) ||
129	<	($self->{mydocversion} ne $docversion) ) {
128	>	if (($doctype ne $self->{mydoctype}) ||
129	>	(($self->{mydocversion} ne $docversion) && ($docversion ne "1.0")) ) {
130		$self->error("Unable to Parse Document of type $doctype $docversion".
131		"\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")");
132		}
133	+	delete $self->{envcount};
134	+	$self->verbose("Pre-Parse");
135	+	$self->{switch}->parse("setupinit");
136	+	$self->{toolmakefile}=$toolbox->toolmakefile($name,$version);
137	+	$self->verbose("Setup Parse");
138		$self->{switch}->parse("setup");
139	+	undef $self->{toolmakefilefh};
140	+
141		return $self->{toolfound};
142		}
143
#	Line 141 | Line 168 | sub _checkdefault {
168		return 0;
169		}
170
171	<	sub _testlocation {
172	<	my $self=shift;
173	<	my $default=shift;
174	<	my $testfiles=shift;
175	<	my $OK='false';
176	<	my $file;
177	<
178	<	chomp $default;
179	<	$default=$self->_expandvars($default);
180	<	print "Trying $default .... ";
181	<	if ( -f $default ) {
182	<	$OK="true";
183	<	}
184	<	else {
185	<	my $fh=FileHandle->new();
186	<	opendir $fh,  $default or do { print "No \n"; return 0; };
187	<	($#{$testfiles}==-1) ? $OK='false' : $OK='true';
188	<	print "\n";
189	<	my @files=readdir $fh;
190	<	undef $fh;
191	<	foreach $file ( @$testfiles ) {
192	<	print "   Checking for $file .... ";
193	<	# now check that the required files are actually there
194	<	if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
195	<	$OK='false';
196	<	print "not found\n";
197	<	last;
198	<	}
199	<	print "found\n";
200	<	}
201	<	}
202	<	if ( $OK eq 'true' ) {
203	<	print "Directory Check Complete\n";
204	<	return 1
205	<	}
206	<	return 0
207	<	}
171	>	sub _testlocation
172	>	{
173	>	my $self=shift;
174	>	my $default=shift;
175	>	my $testfiles=shift;
176	>	my $OK='false';
177	>	my $file;
178	>	my $statusgood = $main::bold."OK".$main::normal;
179	>	my $statusbad = $main::bold."Not found".$main::normal;
180	>
181	>	chomp $default;
182	>	$default=$self->_expandvars($default);
183	>	$self->verbose("Testing location");
184	>
185	>	if ( -f $default )
186	>	{
187	>	$OK="true";
188	>	$self->verbose("File OK");
189	>	}
190	>	else
191	>	{
192	>	my $dh=DirHandle->new();
193	>
194	>	opendir $dh, $default or do
195	>	{
196	>	printf ("\nTrying %-s ...... >> %s <<\n",$default,$main::bold.$!.$main::normal);
197	>	return 0;
198	>	};
199	>
200	>	($#{$testfiles}==-1) ? $OK='false' : $OK='true';
201	>
202	>	my @files=readdir $dh;
203	>	undef $dh;
204	>
205	>	foreach $file ( @$testfiles )
206	>	{
207	>	# now check that the required files are actually there
208	>	if ( ( $number = grep /\Q$file\L/, @files) == 0 )
209	>	{
210	>	$OK='false';
211	>	$status = $statusbad;
212	>	last;
213	>	}
214	>	$status = $statusgood;
215	>
216	>	printf ("\t\tChecking for %-22s............ [%s]\n",$file,$status);
217	>	}
218	>	print "\n";
219	>	}
220	>
221	>	if ( $OK eq 'true' )
222	>	{
223	>	printf ("Existence check for %-30s ............ [%s]\n",$default.":",$statusgood);
224	>	return 1;
225	>	}
226	>
227	>	return 0;
228	>	}
229
230		sub _expandvars {
231		my $self=shift;
#	Line 209 | Line 257 | sub _askusermenu {
257		my $self=shift;
258		my $querystring=shift;
259		my @items=@_;
260	<
260	>
261		my $path=-1;
262	<	while ( ($path!~/^\d+$/) || ($path > $#items) || ($path < 0) ) {
262	>	my $n;
263	>	while ( ($path!~/^\d+$/) || ($path > ($#items+1)) || ($path < 1) ) {
264		for (my $i=0; $i<=$#items; $i++ ) {
265	<	print $i.") ".$items[$i]."\n";
265	>	$n=$i+1;
266	>	print $n.") ".$items[$i]."\n";
267		}
268		print "\n".$querystring;
269		$path=<STDIN>;
270		chomp $path;
271		}
272	+	$path--;
273		return $path;
274		}
275
276	<	sub _askuser {
277	<	my $self=shift;
278	<	my $querystring=shift;
279	<	my $varname=shift;
280	<
281	<	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	<	if ( $path ne "" ) {
287	<	if ( defined $self->{'client'}) { # must be a location
288	<	if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
289	<	return $path;
290	<	}
291	<	print "Error : ".$path." does not exist.\n";
292	<	next;
276	>	sub _askuser
277	>	{
278	>	###############################################################
279	>	# _askuser()                                                  #
280	>	###############################################################
281	>	# modified : Mon Nov 19 15:51:01 2001 / SFA                   #
282	>	# params   :                                                  #
283	>	#          :                                                  #
284	>	#          :                                                  #
285	>	#          :                                                  #
286	>	# function : Looks for valid path to tool, either using a     #
287	>	#          : default path, or by using the lookup table.      #
288	>	#          :                                                  #
289	>	#          :                                                  #
290	>	###############################################################
291	>	my $self=shift;
292	>
293	>	# First, check for interactive flag. If "on", call the original
294	>	# version of this routine:
295	>	if ( $self->{interactive} )
296	>	{
297	>	my $ipath=$self->_askuseri(@_);
298	>	return $ipath;
299	>	}
300	>
301	>	my $querystring=shift;
302	>	my $varname=shift;
303	>	my $lookupdb = $main::lookupobject;
304	>	my $type=$self->{tool}->type($varname);
305	>	my $path;
306	>	my $oldpath;
307	>	my $defaultpath = $lookupdb->lhcxxPath();
308	>
309	>	# Print the feature info:
310	>	print $self->featuretext($self->{EnvContext});
311	>
312	>	# Check if tool is listed in the lookupdb:
313	>	if ($lookupdb->checkTool(${$self->{tool}}{name}))
314	>	{
315	>	$self->verbose(">> Tool ${$self->{tool}}{name} exists in DB...");
316	>	# Check if $varname is a tag that's listed in our lookup table for this tool:
317	>	if ($lookupdb->lookupTag(${$self->{tool}}{name},$varname))
318	>	{
319	>	$self->verbose(">> Tag $varname is defined for tool ${$self->{tool}}{name}");
320	>	# Get the value for this tag:
321	>	$path = $lookupdb->lookupTag(${$self->{tool}}{name},$varname);
322		}
323	+	else
324	+	# No known tag for this tool so try the default path:
325	+	{
326	+	$path = $defaultpath;
327	+	}
328	+	}
329	+	# If the defaultpath is valid then try that:
330	+	elsif ( -d $defaultpath)
331	+	{
332	+	$path = $defaultpath;
333	+	}
334	+	# We'll have to ask the user:
335	+	else
336	+	{
337	+	# Infinite loop while there isn't a valid path:
338	+	for (;;)
339	+	{
340	+	print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
341	+	$path=<STDIN>;
342	+	chomp $path;
343	+	$oldpath=$path;
344	+
345	+	if ( $path ne "" )
346	+	{
347	+	($path)=$self->_validateparam($type,$path);
348	+	# If the path is not defined, print
349	+	# a message and repeat the prompt:
350	+	if ( ! defined $path )
351	+	{
352	+	print "Error : ".$oldpath." is not valid.\n";
353	+	next;
354	+	}
355	+	}
356	+	return $path;
357		}
358	<	else {
359	<	return $path;
358	>	}
359	>	return $path;
360	>	}
361	>
362	>
363	>	sub _askuseri
364	>	{
365	>	###############################################################
366	>	# _askuseri()                                                 #
367	>	###############################################################
368	>	# modified : Mon Nov 19 15:46:36 2001 / SFA                   #
369	>	# params   :                                                  #
370	>	#          :                                                  #
371	>	#          :                                                  #
372	>	#          :                                                  #
373	>	# function : Interactive version of askuser routine. Called   #
374	>	#          : when "-i" flag set in scramcli.                  #
375	>	#          :                                                  #
376	>	#          :                                                  #
377	>	###############################################################
378	>	my $self = shift;
379	>	my $querystring = shift;
380	>	my $varname = shift;
381	>
382	>	my $type=$self->{tool}->type($varname);
383	>	my $path;
384	>	my $oldpath;
385	>
386	>	print $self->featuretext($self->{EnvContext});
387	>
388	>	for  ( ;; )
389	>	{
390	>	print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
391	>	$path=<STDIN>;
392	>	chomp $path;
393	>	$oldpath=$path;
394	>
395	>	if ( $path ne "" )
396	>	{
397	>	($path)=$self->_validateparam($type,$path);
398	>	if ( ! defined $path )
399	>	{
400	>	print "Error : ".$oldpath." is not valid.\n";
401	>	next;
402	>	}
403		}
404	<	} #end for
405	<
404	>	return $path;
405	>	}
406	>	}
407	>
408	>
409	>	sub _validateparam {
410	>	my $self=shift;
411	>	my $type=shift;
412	>	my @params=@_;
413	>
414	>	my @newparams=();
415	>	foreach $param ( @params ) {
416	>	if ( defined $self->{'client'}) { # must be a location
417	>	if ( $self->_testlocation($param ,
418	>	[ $self->{tool}->getfeature($type)] )) {
419	>	$self->verbose("$param passed validation");
420	>	push @newparams,$param;
421	>	}
422	>	else {
423	>	$self->verbose("$param failed validation");
424	>	}
425	>	}
426	>	else {
427	>	# --- no other tests to pass so it must be OK
428	>	push @newparams,$param;
429	>	}
430	>	}
431	>	return @newparams;
432		}
433
434		#
#	Line 254 | Line 437 | sub _askuser {
437		sub _searchtools {
438		my $self=shift;
439		my $tool=shift;
440	+	my $searcher=shift;
441
442		my @tools=();
443		my $area;
444		my $rtool;
445	<	if ( defined $self->{toolboxsearcher} ) {
446	<	my $it=$self->{toolboxsearcher}->newiterator();
447	<	while ( ! $it->last()  ) {
445	>	my $it=$searcher->newiterator();
446	>
447	>	while ( ! $it->last()  ) {
448		$area=$it->next();
449		if ( defined $area ) {
450		$self->verbose("Searching for ".$tool->name()." ".
#	Line 276 | Line 460 | sub _searchtools {
460		.$rtool->version());
461		}
462		}
463	+	else {
464	+	$self->verbose("Tool Passed as Undefined");
465	+	}
466		}
467		else {
468		$self->verbose("Area passed is not defined");
469		}
283	–	}
470		}
471		return @tools;
472		}
#	Line 295 | Line 481 | sub _toolparamcopy {
481		my $rv=0;
482		my @params=();
483		$self->verbose("Check Other Projects for tool");
484	<	my @validtools=$self->_searchtools($tool);
485	<	if ( ! $self->interactive() ) {
486	<	if ( $#validtools >=0 ) {
484	>	my @validtools=();
485	>	if ( defined $self->{toolboxsearcher} ) {
486	>	@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
487	>	}
488	>	if ( $#validtools >=0 ) {
489	>	if ( ! $self->interactive() ) {
490		@params=$validtools[0]->getfeature($param);
491		if ( $#params >=0 ) {
492		$self->verbose("Extracting Feature $param from tool".
493		" (= @params )\n");
305	–	#$tool->setfeature($param,@params);
494		$rv=1;
495		}
496		}
#	Line 310 | Line 498 | sub _toolparamcopy {
498		return ($rv,@params);
499		}
500
501	+	sub _getparamsets {
502	+	my $self=shift;
503	+	my $tool=shift;
504	+	my $param=shift;
505	+
506	+	my @paramlist=();
507	+	my @params=();
508	+	$self->verbose("Searching for parameter settings in other tools");
509	+	my @validtools=();
510	+	if ( defined $self->{toolboxsearcher} ) {
511	+	@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
512	+	}
513	+	else {
514	+	$self->verbose("No tool searcher available");
515	+	}
516	+	if ( $#validtools >=0 ) {
517	+	foreach $t ( @validtools ) {
518	+	@params=$t->getfeature($param);
519	+	if ( $#params >=0 ) {
520	+	push @paramlist, [ @params ];
521	+	$self->verbose("Found @params");
522	+	}
523	+	}
524	+	}
525	+	return @paramlist;
526	+	}
527	+
528		# -- Tag Routines
529
530		sub Client_start {
#	Line 363 | Line 578 | sub Tool_End {
578		$self->{switch}->closegroup("Toolactive");
579		}
580
581	<	sub Environment_Start {
581	>	sub Makefile_Start {
582		my $self=shift;
583	<	my $name=shift;
584	<	my $hashref=shift;
583	>	my $name=shift;
584	>	my $hashref=shift;
585
371	–	$self->{switch}->checktag($name, $hashref, 'name');
586		if ( $self->{Arch} ) {
587	<	if ( defined $self->{EnvContext} ) {
588	<	$self->parserror(" Attempted to open new <$name> context".
589	<	" without closing the previous one");
590	<	}
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	<	# -- 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	<	}
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	<	}
587	>	if ( ! defined $self->{toolmakefilefh} ) {
588	>	$self->{toolmakefilefh}=FileHandle->new();
589	>	$self->{toolmakefilefh}->open(">".$self->{toolmakefile});
590	>	}
591		}
592		}
593
594	<	sub Env_text {
594	>	sub Makefile_text {
595		my $self=shift;
596		my $name=shift;
597		my $string=shift;
598
599	<	if ( $self->{Arch} ) {
600	<	$self->{currentenvtext}=$self->{currentenvtext}.$string;
599	>	if ( $self->{Arch} ) {
600	>	print {$self->{toolmakefilefh}} $string;
601		}
602		}
603
604	<	sub Environment_End {
604	>	sub Makefile_end {
605		my $self=shift;
606	<	my $name=shift;
606	>	my $name=shift;
607	>	my $hashref=shift;
608	>
609	>	if ( $self->{Arch} ) {
610	>	print {$self->{toolmakefilefh}} "\n";
611	>	}
612	>	}
613	>
614	>	# -- collect number of variables of the same name - need to know how many
615	>	#    before main setup processing
616	>	sub Environment_init {
617	>	my $self=shift;
618	>	my $name=shift;
619	>	my $hashref=shift;
620
621	+	$self->{switch}->checktag($name, $hashref, 'name');
622		if ( $self->{Arch} ) {
623	<	if ( ! defined $self->{EnvContext} ) {
624	<	$self->{switch}->parseerror("</$name> without an opening context");
625	<	}
626	<	# - set the help text
627	<	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
628	<	if ( ! defined $self->{Envvalue} ) {
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};
623	>	if ( exists $self->{envcount}{$$hashref{'name'}} ) {
624	>	$self->{envcount}{$$hashref{'name'}}++;
625	>	}
626	>	else {
627	>	$self->{envcount}{$$hashref{'name'}}=0;
628	>	}
629		}
630		}
631
632	+	sub Environment_Start
633	+	{
634	+	my $self=shift;
635	+	my $name=shift;
636	+	my $hashref=shift;
637	+
638	+	$self->{switch}->checktag($name, $hashref, 'name');
639	+
640	+	if ( $self->{Arch} )
641	+	{
642	+	my $val=undef;
643	+	if ( defined $self->{EnvContext} )
644	+	{
645	+	$self->parserror(" Attempted to open new <$name> context".
646	+	" without closing the previous one");
647	+	}
648	+	# -- keep a counter of the number of times we see this variable
649	+	if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} )
650	+	{
651	+	$self->{EnvironmentCount}{$$hashref{'name'}}++;
652	+	}
653	+	else
654	+	{
655	+	$self->{EnvironmentCount}{$$hashref{'name'}}=0;
656	+	}
657	+
658	+	$self->{currentenvtext}="";
659	+	$self->{EnvContext}=$$hashref{'name'};
660	+	undef $self->{Envvalue};
661	+
662	+	if ( exists $$hashref{'type'} )
663	+	{
664	+	$$hashref{'type'}=~tr[A-Z][a-z];
665	+	$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
666	+	}
667	+	# check other installed copies of the tool
668	+	# -- construct a menu of options
669	+	my @menulist=();
670	+	# -- a value is fixed - unless interactive switch is on
671	+	if ( exists $$hashref{'value'})
672	+	{
673	+	$val=$$hashref{'value'};
674	+	if ( $self->interactive() )
675	+	{
676	+	unshift @menulist,$$hashref{'value'};
677	+	}
678	+	}
679	+	# -- add any default values to the selection
680	+	if ( ! defined $val )
681	+	{
682	+	if ( $self->_checkdefault($hashref) )
683	+	{
684	+	my $var=$self->_expandvars($$hashref{'default'});
685	+	if ( !grep { $_ eq $var }  @menulist )
686	+	{
687	+	unshift @menulist, $var;
688	+	}
689	+	}
690	+	# -- check the environment
691	+	if ( defined $ENV{$$hashref{'name'}} )
692	+	{
693	+	if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist )
694	+	{
695	+	unshift @menulist, $ENV{$$hashref{'name'}};
696	+	}
697	+	}
698	+	my @paramlist=$self->_getparamsets($self->{tool},
699	+	$$hashref{'name'});
700	+	foreach $p ( @paramlist )
701	+	{
702	+	# -- only add them if there are the same number of variables
703	+	if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} )
704	+	{
705	+	if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
706	+	{$$hashref{'name'}}] } @menulist)
707	+	{
708	+	push @menulist,$$p[$self->{EnvironmentCount}
709	+	{$$hashref{'name'}}];
710	+	}
711	+	}
712	+	else
713	+	{
714	+	$self->verbose("Ignoring tool params - not the same number".
715	+	" defined (".$#{$p}." != ".
716	+	$self->{envcount}{$$hashref{'name'}}.")");
717	+	}
718	+	}
719	+	if ( $#menulist >=0 )
720	+	{
721	+	print "Validating Values for Variable: ".$$hashref{'name'}."\n";
722	+	@menulist=$self->_validateparam($$hashref{'type'},@menulist);
723	+	}
724	+	print "\n";
725	+	# -- If theres only one option take it without asking
726	+	if ( $#menulist == 0 && ( ! $self->interactive() ))
727	+	{
728	+	$val=$menulist[0];
729	+	}
730	+	elsif ( $#menulist > 0 )
731	+	{
732	+	my $in=$self->_askusermenu(
733	+	"Multiple possibilities found for ".
734	+	$$hashref{'name'}." ( occurrance ".
735	+	($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
736	+	"\nPlease Choose: ",
737	+	(@menulist,"Other"));
738	+	if ( $in <=$#menulist )
739	+	{
740	+	$val=$menulist[$in];
741	+	}
742	+	else
743	+	{
744	+	undef $val;
745	+	}
746	+	}
747	+	}
748	+	$self->{Envvalue}=$val; # single val parameter
749	+	}
750	+	}
751	+
752	+	sub Env_text {
753	+	my $self=shift;
754	+	my $name=shift;
755	+	my $string=shift;
756	+
757	+	if ( $self->{Arch} ) {
758	+	$self->{currentenvtext}=$self->{currentenvtext}.$string;
759	+	}
760	+	}
761	+
762	+	sub Environment_End
763	+	{
764	+	my $self=shift;
765	+	my $name=shift;
766	+
767	+	if ( $self->{Arch} )
768	+	{
769	+	if ( ! defined $self->{EnvContext} )
770	+	{
771	+	$self->{switch}->parseerror("</$name> without an opening context");
772	+	}
773	+	# - set the help text
774	+	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
775	+
776	+	if ( ! defined $self->{Envvalue} )
777	+	{
778	+	$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
779	+	$self->{EnvContext});
780	+	}
781	+
782	+	$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
783	+	$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
784	+	$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
785	+
786	+	# Undefine in time for next pass:
787	+	undef $self->{EnvContext};
788	+	undef $self->{Envvalue};
789	+	}
790	+	}
791	+
792		sub Lib {
793		my $self=shift;
794		my $name=shift;
#	Line 491 | Line 829 | sub Arch_End {
829		pop @{$self->{ARCHBLOCK}};
830		$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
831		}
494	–
495	–

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines