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.5 by williamc, Wed Nov 15 10:50:57 2000 UTC vs.
Revision 1.11 by sashby, Fri Aug 16 11:54:15 2002 UTC

#	Line 95 | Line 95 | sub tool {
95
96		sub toolsearcher {
97		my $self=shift;
98	+
99		if ( @_ ) {
100		my $searcher=shift;
101		if ( ! defined $searcher ) {
#	Line 136 | Line 137 | sub setup {
137		$self->verbose("Setup Parse");
138		$self->{switch}->parse("setup");
139		undef $self->{toolmakefilefh};
140	+
141		return $self->{toolfound};
142		}
143
#	Line 166 | 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	<
176	<	my $OK='false';
177	<	my $file;
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	<	chomp $default;
217	<	$default=$self->_expandvars($default);
218	<	$self->verbose("Testing location");
219	<	print "Trying $default .... ";
220	<	if ( -f $default ) {
221	<	$OK="true";
222	<	$self->verbose("File OK");
223	<	}
224	<	else {
225	<	my $dh=DirHandle->new();
226	<	opendir $dh, $default or do { print "No $!\n"; return 0; };
227	<	($#{$testfiles}==-1) ? $OK='false' : $OK='true';
228	<	print "\n";
190	<	my @files=readdir $dh;
191	<	undef $dh;
192	<	foreach $file ( @$testfiles ) {
193	<	print "   Checking for $file .... ";
194	<	# now check that the required files are actually there
195	<	if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
196	<	$OK='false';
197	<	print "not found\n";
198	<	last;
199	<	}
200	<	print "found\n";
201	<	}
202	<	}
203	<	if ( $OK eq 'true' ) {
204	<	print "Existence Check Complete\n";
205	<	return 1
206	<	}
207	<	return 0
208	<	}
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 237 | 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 253 | Line 273 | sub _askusermenu {
273		return $path;
274		}
275
276	<	sub _askuser {
277	<	my $self=shift;
278	<	my $querystring=shift;
279	<	my $varname=shift;
280	<
281	<	my $type=$self->{tool}->type($varname);
282	<	my $path;
283	<	my $oldpath;
284	<	print $self->featuretext($self->{EnvContext});
285	<	for  ( ;; ) {
286	<	print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
287	<	$path=<STDIN>;
288	<	chomp $path;
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	<	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
280	–	}
408
409		sub _validateparam {
410		my $self=shift;
#	Line 316 | Line 443 | sub _searchtools {
443		my $area;
444		my $rtool;
445		my $it=$searcher->newiterator();
446	<
446	>
447		while ( ! $it->last()  ) {
448		$area=$it->next();
449		if ( defined $area ) {
#	Line 353 | Line 480 | sub _toolparamcopy {
480
481		my $rv=0;
482		my @params=();
483	+
484		$self->verbose("Check Other Projects for tool");
485		my @validtools=();
486		if ( defined $self->{toolboxsearcher} ) {
#	Line 378 | Line 506 | sub _getparamsets {
506
507		my @paramlist=();
508		my @params=();
509	+
510	+	# Check for an override of the searcher. If the
511	+	# variable SEARCHOVRD is set, we return an empty array:
512	+	if ( $ENV{'SEARCHOVRD'} eq 'true' )
513	+	{
514	+	$self->verbose("Searching for tool settings from other projects OVERRIDDEN");
515	+	# This bypasses the menu option presented to the user when there is more than one
516	+	# choice for the tool location:
517	+	return @paramlist;
518	+	}
519	+	# Otherwise we proceed as normal:
520		$self->verbose("Searching for parameter settings in other tools");
521		my @validtools=();
522		if ( defined $self->{toolboxsearcher} ) {
523	<	@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
524	<	}
523	>	@validtools=$self->_searchtools($tool,$self->{toolboxsearcher});
524	>	}
525		else {
526		$self->verbose("No tool searcher available");
527		}
#	Line 502 | Line 641 | sub Environment_init {
641		}
642		}
643
644	<	sub Environment_Start {
645	<	my $self=shift;
646	<	my $name=shift;
647	<	my $hashref=shift;
648	<
649	<	$self->{switch}->checktag($name, $hashref, 'name');
650	<	if ( $self->{Arch} ) {
512	<	my $val=undef;
513	<	if ( defined $self->{EnvContext} ) {
514	<	$self->parserror(" Attempted to open new <$name> context".
515	<	" without closing the previous one");
516	<	}
517	<	# -- keep a counter of the number of times we see this variable
518	<	if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} ) {
519	<	$self->{EnvironmentCount}{$$hashref{'name'}}++;
520	<	}
521	<	else {
522	<	$self->{EnvironmentCount}{$$hashref{'name'}}=0;
523	<	}
644	>	sub Environment_Start
645	>	{
646	>	my $self=shift;
647	>	my $name=shift;
648	>	my $hashref=shift;
649	>
650	>	$self->{switch}->checktag($name, $hashref, 'name');
651
652	<	$self->{currentenvtext}="";
653	<	$self->{EnvContext}=$$hashref{'name'};
654	<	undef $self->{Envvalue};
655	<	if ( exists $$hashref{'type'} ) {
656	<	$$hashref{'type'}=~tr[A-Z][a-z];
657	<	$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
658	<	}
659	<	# check other installed copies of the tool
660	<	# -- construct a menu of options
661	<	my @menulist=();
662	<	# -- a value is fixed - unless interactive switch is on
663	<	if ( exists $$hashref{'value'}) {
664	<	$val=$$hashref{'value'};
665	<	if ( $self->interactive() ) {
666	<	unshift @menulist,$$hashref{'value'};
652	>	if ( $self->{Arch} )
653	>	{
654	>	my $val=undef;
655	>	if ( defined $self->{EnvContext} )
656	>	{
657	>	$self->parserror(" Attempted to open new <$name> context".
658	>	" without closing the previous one");
659	>	}
660	>	# -- keep a counter of the number of times we see this variable
661	>	if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} )
662	>	{
663	>	$self->{EnvironmentCount}{$$hashref{'name'}}++;
664	>	}
665	>	else
666	>	{
667	>	$self->{EnvironmentCount}{$$hashref{'name'}}=0;
668	>	}
669	>
670	>	$self->{currentenvtext}="";
671	>	$self->{EnvContext}=$$hashref{'name'};
672	>	undef $self->{Envvalue};
673	>
674	>	if ( exists $$hashref{'type'} )
675	>	{
676	>	$$hashref{'type'}=~tr[A-Z][a-z];
677	>	$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
678	>	}
679	>	# check other installed copies of the tool
680	>	# -- construct a menu of options
681	>	my @menulist=();
682	>	# -- a value is fixed - unless interactive switch is on
683	>	if ( exists $$hashref{'value'})
684	>	{
685	>	$val=$$hashref{'value'};
686	>	if ( $self->interactive() )
687	>	{
688	>	unshift @menulist,$$hashref{'value'};
689		}
690	<	}
691	<	# -- add any default values to the selection
692	<	if ( ! defined $val ) {
693	<	if ( $self->_checkdefault($hashref) ) {
694	<	my $var=$self->_expandvars($$hashref{'default'});
695	<	if ( !grep { $_ eq $var }  @menulist ) {
696	<	unshift @menulist, $var;
697	<	}
698	<	}
699	<	# -- check the environment
700	<	if ( defined $ENV{$$hashref{'name'}} ) {
701	<	if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) {
702	<	unshift @menulist, $ENV{$$hashref{'name'}};
703	<	}
704	<	}
705	<	my @paramlist=$self->_getparamsets($self->{tool},
706	<	$$hashref{'name'});
707	<	foreach $p ( @paramlist ) {
708	<	# -- only add them if there are the same number of variables
709	<	if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) {
710	<	if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
711	<	{$$hashref{'name'}}] } @menulist) {
712	<	push @menulist,$$p[$self->{EnvironmentCount}
713	<	{$$hashref{'name'}}];
714	<	}
715	<	}
716	<	else {
717	<	$self->verbose("Ignoring tool params - not the same number".
718	<	" defined (".$#{$p}." != ".
719	<	$self->{envcount}{$$hashref{'name'}}.")");
720	<	}
721	<	}
722	<	if ( $#menulist >=0 ) {
723	<	print "Validating Values for Variable : ".$$hashref{'name'}."\n";
690	>	}
691	>	# -- add any default values to the selection
692	>	if ( ! defined $val )
693	>	{
694	>	if ( $self->_checkdefault($hashref) )
695	>	{
696	>	my $var=$self->_expandvars($$hashref{'default'});
697	>	if ( !grep { $_ eq $var }  @menulist )
698	>	{
699	>	unshift @menulist, $var;
700	>	}
701	>	}
702	>	# -- check the environment
703	>	if ( defined $ENV{$$hashref{'name'}} )
704	>	{
705	>	if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist )
706	>	{
707	>	unshift @menulist, $ENV{$$hashref{'name'}};
708	>	}
709	>	}
710	>	my @paramlist=$self->_getparamsets($self->{tool},
711	>	$$hashref{'name'});
712	>	foreach $p ( @paramlist )
713	>	{
714	>	# -- only add them if there are the same number of variables
715	>	if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} )
716	>	{
717	>	if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
718	>	{$$hashref{'name'}}] } @menulist)
719	>	{
720	>	push @menulist,$$p[$self->{EnvironmentCount}
721	>	{$$hashref{'name'}}];
722	>	}
723	>	}
724	>	else
725	>	{
726	>	$self->verbose("Ignoring tool params - not the same number".
727	>	" defined (".$#{$p}." != ".
728	>	$self->{envcount}{$$hashref{'name'}}.")");
729	>	}
730	>	}
731	>	if ( $#menulist >=0 )
732	>	{
733	>	print "Validating Values for Variable: ".$$hashref{'name'}."\n";
734		@menulist=$self->_validateparam($$hashref{'type'},@menulist);
735	<	}
736	<	# -- If theres only one option take it without asking
737	<	if ( $#menulist == 0 && ( ! $self->interactive() )) {
738	<	$val=$menulist[0];
739	<	}
740	<	elsif ( $#menulist > 0 ) {
741	<	my $in=$self->_askusermenu(
742	<	"Multiple possibilities found for ".
743	<	$$hashref{'name'}." ( occurance ".
744	<	($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
745	<	"\nPlease Choose: ",
746	<	(@menulist,"Other"));
747	<	if ( $in <=$#menulist ) {
748	<	$val=$menulist[$in];
749	<	}
750	<	else {
751	<	undef $val;
752	<	}
753	<	}
754	<	}
755	<	$self->{Envvalue}=$val; # single val parameter
756	<	}
757	<	}
735	>	}
736	>	print "\n";
737	>	# -- If theres only one option take it without asking
738	>	if ( $#menulist == 0 && ( ! $self->interactive() ))
739	>	{
740	>	$val=$menulist[0];
741	>	}
742	>	elsif ( $#menulist > 0 )
743	>	{
744	>	my $in=$self->_askusermenu(
745	>	"Multiple possibilities found for ".
746	>	$$hashref{'name'}." ( occurrence ".
747	>	($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
748	>	"\nPlease Choose: ",
749	>	(@menulist,"Other"));
750	>	if ( $in <=$#menulist )
751	>	{
752	>	$val=$menulist[$in];
753	>	}
754	>	else
755	>	{
756	>	undef $val;
757	>	}
758	>	}
759	>	}
760	>	$self->{Envvalue}=$val; # single val parameter
761	>	}
762	>	}
763
764		sub Env_text {
765		my $self=shift;
#	Line 607 | Line 771 | sub Env_text {
771		}
772		}
773
774	<	sub Environment_End {
775	<	my $self=shift;
776	<	my $name=shift;
777	<
778	<	if ( $self->{Arch} ) {
779	<	if ( ! defined $self->{EnvContext} ) {
780	<	$self->{switch}->parseerror("</$name> without an opening context");
781	<	}
782	<	# - set the help text
783	<	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
784	<	if ( ! defined $self->{Envvalue} ) {
785	<	$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
786	<	$self->{EnvContext});
787	<	}
788	<	$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
789	<	$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
790	<	$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
791	<	undef $self->{EnvContext};
792	<	undef $self->{Envvalue};
793	<	}
794	<	}
774	>	sub Environment_End
775	>	{
776	>	my $self=shift;
777	>	my $name=shift;
778	>
779	>	if ( $self->{Arch} )
780	>	{
781	>	if ( ! defined $self->{EnvContext} )
782	>	{
783	>	$self->{switch}->parseerror("</$name> without an opening context");
784	>	}
785	>	# - set the help text
786	>	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
787	>
788	>	if ( ! defined $self->{Envvalue} )
789	>	{
790	>	$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
791	>	$self->{EnvContext});
792	>	}
793	>
794	>	$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
795	>	$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
796	>	$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
797	>
798	>	# Undefine in time for next pass:
799	>	undef $self->{EnvContext};
800	>	undef $self->{Envvalue};
801	>	}
802	>	}
803
804		sub Lib {
805		my $self=shift;

Diff Legend

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