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.7 by sashby, Thu Nov 15 21:18:16 2001 UTC vs.
Revision 1.9 by sashby, Mon Nov 19 18:46:39 2001 UTC

#	Line 175 | Line 175 | sub _testlocation
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);
#	Line 191 | Line 193 | sub _testlocation
193
194		opendir $dh, $default or do
195		{
196	<	printf ("\nTrying %-s ...... >>%s<<\n",$default,$!,);
196	>	printf ("\nTrying %-s ...... >> %s <<\n",$default,$main::bold.$!.$main::normal);
197		return 0;
198		};
199
200		($#{$testfiles}==-1) ? $OK='false' : $OK='true';
201	<	#print "\n";
201	>
202		my @files=readdir $dh;
203		undef $dh;
204
#	Line 206 | Line 208 | sub _testlocation
208		if ( ( $number = grep /\Q$file\L/, @files) == 0 )
209		{
210		$OK='false';
211	<	$status = "[not found]";
211	>	$status = $statusbad;
212		last;
213		}
214	<	$status = "[OK]";
215	<	printf ("\t\tChecking for %-22s............ %-s\n",$file,$status);
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 ............ [OK]\n",$default.":");
223	>	printf ("Existence check for %-30s ............ [%s]\n",$default.":",$statusgood);
224		return 1;
225		}
226
#	Line 254 | Line 257 | sub _askusermenu {
257		my $self=shift;
258		my $querystring=shift;
259		my @items=@_;
260	<
260	>
261		my $path=-1;
262		my $n;
263		while ( ($path!~/^\d+$/) || ($path > ($#items+1)) || ($path < 1) ) {
#	Line 270 | Line 273 | sub _askusermenu {
273		return $path;
274		}
275
276	<	sub _askuser {
277	<	my $self=shift;
278	<	my $querystring=shift;
279	<	my $varname=shift;
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 $type=$self->{tool}->type($varname);
302	<	my $path;
303	<	my $oldpath;
304	<	print $self->featuretext($self->{EnvContext});
305	<	for  ( ;; ) {
306	<	print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
307	<	$path=<STDIN>;
308	<	chomp $path;
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	<	if ( $path ne "" ) {
345	<	($path)=$self->_validateparam($type,$path);
346	<	if ( ! defined $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	>	}
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	<	}
402	>	}
403		}
404	<	return $path;
405	<	} #end for
404	>	return $path;
405	>	}
406	>	}
407
297	–	}
408
409		sub _validateparam {
410		my $self=shift;
#	Line 519 | Line 629 | sub Environment_init {
629		}
630		}
631
632	<	sub Environment_Start {
633	<	my $self=shift;
634	<	my $name=shift;
635	<	my $hashref=shift;
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');
528	<	if ( $self->{Arch} ) {
529	<	my $val=undef;
530	<	if ( defined $self->{EnvContext} ) {
531	<	$self->parserror(" Attempted to open new <$name> context".
532	<	" without closing the previous one");
533	<	}
534	<	# -- 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	<	}
638	>	$self->{switch}->checktag($name, $hashref, 'name');
639
640	<	$self->{currentenvtext}="";
641	<	$self->{EnvContext}=$$hashref{'name'};
642	<	undef $self->{Envvalue};
643	<	if ( exists $$hashref{'type'} ) {
644	<	$$hashref{'type'}=~tr[A-Z][a-z];
645	<	$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
646	<	}
647	<	# check other installed copies of the tool
648	<	# -- construct a menu of options
649	<	my @menulist=();
650	<	# -- a value is fixed - unless interactive switch is on
651	<	if ( exists $$hashref{'value'}) {
652	<	$val=$$hashref{'value'};
653	<	if ( $self->interactive() ) {
654	<	unshift @menulist,$$hashref{'value'};
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	<	if ( $self->_checkdefault($hashref) ) {
682	<	my $var=$self->_expandvars($$hashref{'default'});
683	<	if ( !grep { $_ eq $var }  @menulist ) {
684	<	unshift @menulist, $var;
685	<	}
686	<	}
687	<	# -- check the environment
688	<	if ( defined $ENV{$$hashref{'name'}} ) {
689	<	if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) {
690	<	unshift @menulist, $ENV{$$hashref{'name'}};
691	<	}
692	<	}
693	<	my @paramlist=$self->_getparamsets($self->{tool},
694	<	$$hashref{'name'});
695	<	foreach $p ( @paramlist ) {
696	<	# -- only add them if there are the same number of variables
697	<	if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) {
698	<	if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
699	<	{$$hashref{'name'}}] } @menulist) {
700	<	push @menulist,$$p[$self->{EnvironmentCount}
701	<	{$$hashref{'name'}}];
702	<	}
703	<	}
704	<	else {
705	<	$self->verbose("Ignoring tool params - not the same number".
706	<	" defined (".$#{$p}." != ".
707	<	$self->{envcount}{$$hashref{'name'}}.")");
708	<	}
709	<	}
710	<	if ( $#menulist >=0 ) {
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	<	print "VALUE: ",$val,"\n";
729	<	$val=$menulist[0];
730	<	}
731	<	elsif ( $#menulist > 0 ) {
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	<	$val=$menulist[$in];
740	<	}
741	<	else {
742	<	undef $val;
743	<	}
744	<	}
745	<	}
746	<	$self->{Envvalue}=$val; # single val parameter
747	<	}
748	<	}
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;
#	Line 627 | Line 759 | sub Env_text {
759		}
760		}
761
762	<	sub Environment_End {
763	<	my $self=shift;
764	<	my $name=shift;
765	<
766	<	if ( $self->{Arch} ) {
767	<	if ( ! defined $self->{EnvContext} ) {
768	<	$self->{switch}->parseerror("</$name> without an opening context");
769	<	}
770	<	# - set the help text
771	<	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
772	<	if ( ! defined $self->{Envvalue} ) {
773	<	$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
774	<	$self->{EnvContext});
775	<	}
776	<	$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
777	<	$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
778	<	$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
779	<	undef $self->{EnvContext};
780	<	undef $self->{Envvalue};
781	<	}
782	<	}
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;

Diff Legend

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