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.8 by sashby, Fri Nov 16 16:29:49 2001 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	>	my $self=shift;
279	>	my $querystring=shift;
280	>	my $varname=shift;
281	>	my $lookupdb = $main::lookupobject;
282	>	my $type=$self->{tool}->type($varname);
283	>	my $path;
284	>	my $oldpath;
285	>	my $defaultpath = $lookupdb->lhcxxPath();
286	>
287	>	# Print the feature info:
288	>	print $self->featuretext($self->{EnvContext});
289	>
290	>	# Check if tool is listed in the lookupdb:
291	>	if ($lookupdb->checkTool(${$self->{tool}}{name}))
292	>	{
293	>	$self->verbose(">> Tool ",${$self->{tool}}{name}," exists in DB...");
294	>	# Check if $varname is a tag that's listed in our lookup table for this tool:
295	>	if ($lookupdb->lookupTag(${$self->{tool}}{name},$varname))
296	>	{
297	>	$self->verbose(">> Tag ",$varname," is defined for tool ",${$self->{tool}}{name});
298	>	# Get the value for this tag:
299	>	$path = $lookupdb->lookupTag(${$self->{tool}}{name},$varname);
300	>	}
301	>	else
302	>	# No known tag for this tool so try the default path:
303	>	{
304	>	$path = $defaultpath;
305	>	}
306	>	}
307	>	# If the defaultpath is valid then try that:
308	>	elsif ( -d $defaultpath)
309	>	{
310	>	$path = $defaultpath;
311	>	}
312	>	# We'll have to ask the user:
313	>	else
314	>	{
315	>	# Infinite loop while there isn't a valid path:
316	>	for (;;)
317	>	{
318	>	print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
319	>	$path=<STDIN>;
320	>	chomp $path;
321		$oldpath=$path;
322	<	if ( $path ne "" ) {
323	<	($path)=$self->_validateparam($type,$path);
324	<	if ( ! defined $path ) {
325	<	print "Error : ".$oldpath." is not valid.\n";
326	<	next;
327	<	}
328	<	}
322	>
323	>	if ( $path ne "" )
324	>	{
325	>	($path)=$self->_validateparam($type,$path);
326	>	# If the path is not defined, print
327	>	# a message and repeat the prompt:
328	>	if ( ! defined $path )
329	>	{
330	>	print "Error : ".$oldpath." is not valid.\n";
331	>	next;
332	>	}
333	>	}
334		return $path;
335	<	} #end for
336	<
337	<	}
335	>	}
336	>	}
337	>	return $path;
338	>	}
339
340		sub _validateparam {
341		my $self=shift;
#	Line 316 | Line 374 | sub _searchtools {
374		my $area;
375		my $rtool;
376		my $it=$searcher->newiterator();
377	<
377	>
378		while ( ! $it->last()  ) {
379		$area=$it->next();
380		if ( defined $area ) {
#	Line 502 | Line 560 | sub Environment_init {
560		}
561		}
562
563	<	sub Environment_Start {
564	<	my $self=shift;
565	<	my $name=shift;
566	<	my $hashref=shift;
567	<
568	<	$self->{switch}->checktag($name, $hashref, 'name');
569	<	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	<	}
563	>	sub Environment_Start
564	>	{
565	>	my $self=shift;
566	>	my $name=shift;
567	>	my $hashref=shift;
568	>
569	>	$self->{switch}->checktag($name, $hashref, 'name');
570
571	<	$self->{currentenvtext}="";
572	<	$self->{EnvContext}=$$hashref{'name'};
573	<	undef $self->{Envvalue};
574	<	if ( exists $$hashref{'type'} ) {
575	<	$$hashref{'type'}=~tr[A-Z][a-z];
576	<	$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
577	<	}
578	<	# check other installed copies of the tool
579	<	# -- construct a menu of options
580	<	my @menulist=();
581	<	# -- a value is fixed - unless interactive switch is on
582	<	if ( exists $$hashref{'value'}) {
583	<	$val=$$hashref{'value'};
584	<	if ( $self->interactive() ) {
585	<	unshift @menulist,$$hashref{'value'};
571	>	if ( $self->{Arch} )
572	>	{
573	>	my $val=undef;
574	>	if ( defined $self->{EnvContext} )
575	>	{
576	>	$self->parserror(" Attempted to open new <$name> context".
577	>	" without closing the previous one");
578	>	}
579	>	# -- keep a counter of the number of times we see this variable
580	>	if ( exists $self->{EnvironmentCount}{$$hashref{'name'}} )
581	>	{
582	>	$self->{EnvironmentCount}{$$hashref{'name'}}++;
583	>	}
584	>	else
585	>	{
586	>	$self->{EnvironmentCount}{$$hashref{'name'}}=0;
587	>	}
588	>
589	>	$self->{currentenvtext}="";
590	>	$self->{EnvContext}=$$hashref{'name'};
591	>	undef $self->{Envvalue};
592	>
593	>	if ( exists $$hashref{'type'} )
594	>	{
595	>	$$hashref{'type'}=~tr[A-Z][a-z];
596	>	$self->{tool}->type($$hashref{'name'},$$hashref{'type'});
597	>	}
598	>	# check other installed copies of the tool
599	>	# -- construct a menu of options
600	>	my @menulist=();
601	>	# -- a value is fixed - unless interactive switch is on
602	>	if ( exists $$hashref{'value'})
603	>	{
604	>	$val=$$hashref{'value'};
605	>	if ( $self->interactive() )
606	>	{
607	>	unshift @menulist,$$hashref{'value'};
608		}
609	<	}
610	<	# -- add any default values to the selection
611	<	if ( ! defined $val ) {
612	<	if ( $self->_checkdefault($hashref) ) {
613	<	my $var=$self->_expandvars($$hashref{'default'});
614	<	if ( !grep { $_ eq $var }  @menulist ) {
615	<	unshift @menulist, $var;
616	<	}
617	<	}
618	<	# -- check the environment
619	<	if ( defined $ENV{$$hashref{'name'}} ) {
620	<	if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist ) {
621	<	unshift @menulist, $ENV{$$hashref{'name'}};
622	<	}
623	<	}
624	<	my @paramlist=$self->_getparamsets($self->{tool},
625	<	$$hashref{'name'});
626	<	foreach $p ( @paramlist ) {
627	<	# -- only add them if there are the same number of variables
628	<	if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} ) {
629	<	if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
630	<	{$$hashref{'name'}}] } @menulist) {
631	<	push @menulist,$$p[$self->{EnvironmentCount}
632	<	{$$hashref{'name'}}];
633	<	}
634	<	}
635	<	else {
636	<	$self->verbose("Ignoring tool params - not the same number".
637	<	" defined (".$#{$p}." != ".
638	<	$self->{envcount}{$$hashref{'name'}}.")");
639	<	}
640	<	}
641	<	if ( $#menulist >=0 ) {
642	<	print "Validating Values for Variable : ".$$hashref{'name'}."\n";
609	>	}
610	>	# -- add any default values to the selection
611	>	if ( ! defined $val )
612	>	{
613	>	if ( $self->_checkdefault($hashref) )
614	>	{
615	>	my $var=$self->_expandvars($$hashref{'default'});
616	>	if ( !grep { $_ eq $var }  @menulist )
617	>	{
618	>	unshift @menulist, $var;
619	>	}
620	>	}
621	>	# -- check the environment
622	>	if ( defined $ENV{$$hashref{'name'}} )
623	>	{
624	>	if ( !grep { $_ eq $ENV{$$hashref{'name'}}} @menulist )
625	>	{
626	>	unshift @menulist, $ENV{$$hashref{'name'}};
627	>	}
628	>	}
629	>	my @paramlist=$self->_getparamsets($self->{tool},
630	>	$$hashref{'name'});
631	>	foreach $p ( @paramlist )
632	>	{
633	>	# -- only add them if there are the same number of variables
634	>	if ( $#{$p} == $self->{envcount}{$$hashref{'name'}} )
635	>	{
636	>	if ( !grep {$_ eq $$p[$self->{EnvironmentCount}
637	>	{$$hashref{'name'}}] } @menulist)
638	>	{
639	>	push @menulist,$$p[$self->{EnvironmentCount}
640	>	{$$hashref{'name'}}];
641	>	}
642	>	}
643	>	else
644	>	{
645	>	$self->verbose("Ignoring tool params - not the same number".
646	>	" defined (".$#{$p}." != ".
647	>	$self->{envcount}{$$hashref{'name'}}.")");
648	>	}
649	>	}
650	>	if ( $#menulist >=0 )
651	>	{
652	>	print "Validating Values for Variable: ".$$hashref{'name'}."\n";
653		@menulist=$self->_validateparam($$hashref{'type'},@menulist);
654	<	}
655	<	# -- If theres only one option take it without asking
656	<	if ( $#menulist == 0 && ( ! $self->interactive() )) {
657	<	$val=$menulist[0];
658	<	}
659	<	elsif ( $#menulist > 0 ) {
660	<	my $in=$self->_askusermenu(
661	<	"Multiple possibilities found for ".
662	<	$$hashref{'name'}." ( occurance ".
663	<	($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
664	<	"\nPlease Choose: ",
665	<	(@menulist,"Other"));
666	<	if ( $in <=$#menulist ) {
667	<	$val=$menulist[$in];
668	<	}
669	<	else {
670	<	undef $val;
671	<	}
672	<	}
673	<	}
674	<	$self->{Envvalue}=$val; # single val parameter
675	<	}
676	<	}
654	>	}
655	>	print "\n";
656	>	# -- If theres only one option take it without asking
657	>	if ( $#menulist == 0 && ( ! $self->interactive() ))
658	>	{
659	>	$val=$menulist[0];
660	>	}
661	>	elsif ( $#menulist > 0 )
662	>	{
663	>	my $in=$self->_askusermenu(
664	>	"Multiple possibilities found for ".
665	>	$$hashref{'name'}." ( occurrance ".
666	>	($self->{EnvironmentCount}{$$hashref{'name'}}+1)." ) ".
667	>	"\nPlease Choose: ",
668	>	(@menulist,"Other"));
669	>	if ( $in <=$#menulist )
670	>	{
671	>	$val=$menulist[$in];
672	>	}
673	>	else
674	>	{
675	>	undef $val;
676	>	}
677	>	}
678	>	}
679	>	$self->{Envvalue}=$val; # single val parameter
680	>	}
681	>	}
682
683		sub Env_text {
684		my $self=shift;
#	Line 607 | Line 690 | sub Env_text {
690		}
691		}
692
693	<	sub Environment_End {
694	<	my $self=shift;
695	<	my $name=shift;
696	<
697	<	if ( $self->{Arch} ) {
698	<	if ( ! defined $self->{EnvContext} ) {
699	<	$self->{switch}->parseerror("</$name> without an opening context");
700	<	}
701	<	# - set the help text
702	<	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
703	<	if ( ! defined $self->{Envvalue} ) {
704	<	$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
705	<	$self->{EnvContext});
706	<	}
707	<	$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
708	<	$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
709	<	$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
710	<	undef $self->{EnvContext};
711	<	undef $self->{Envvalue};
712	<	}
713	<	}
693	>	sub Environment_End
694	>	{
695	>	my $self=shift;
696	>	my $name=shift;
697	>
698	>	if ( $self->{Arch} )
699	>	{
700	>	if ( ! defined $self->{EnvContext} )
701	>	{
702	>	$self->{switch}->parseerror("</$name> without an opening context");
703	>	}
704	>	# - set the help text
705	>	$self->featuretext($self->{EnvContext},$self->{currentenvtext});
706	>
707	>	if ( ! defined $self->{Envvalue} )
708	>	{
709	>	$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
710	>	$self->{EnvContext});
711	>	}
712	>
713	>	$self->{Envvalue}=$self->_expandvars($self->{Envvalue});
714	>	$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
715	>	$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
716	>
717	>	# Undefine in time for next pass:
718	>	undef $self->{EnvContext};
719	>	undef $self->{Envvalue};
720	>	}
721	>	}
722
723		sub Lib {
724		my $self=shift;

Diff Legend

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