Suresh Govindachar wrote:
> Hello,
>
> What's a good way to put a wrapper on perldoc so that
> a call such as "perldoc -k [options] arg" acts as follows:
>
> if "perldoc [options] arg" succeeds, returns it;
> else if "perldoc [options] -f arg" succeeds, returns it;
> else if "perldoc [options] -q arg" succeeds, returns it;
> else returns failure message.
>
> (Note the -k above; when the perldoc wrapper is called
> without -k, it should act as the usual perldoc.)
>
> Aside: After reading "perldoc -h" and "perldoc perldoc" I
> thought perldoc -r would act like the -k I am suggesting,
> but it doesn't; what does -r do?
This should handle it (minimally tested - modify to suit) :
#!perl --
use strict;
use warnings;
our $argv = join ' ', @ARGV, ' '; # save orig args
our %A; # get commandline switches into %A
for (my $ii = 0; $ii < @ARGV; ) {
last if $ARGV[$ii] =~ /^--$/;
if ($ARGV[$ii] !~ /^-{1,2}(.*)$/) { $ii++; next; }
my $arg = $1; splice @ARGV, $ii, 1;
if ($arg =~ /^([\w]+)=(.*)$/) { $A{$1} = $2; } else { $A{$1}++; }
}
my $debug = $A{d} || 0;
(my $prog = $0) =~ s/^.*[\\\/]//;
my $usage = <<EOD;
Usage: $prog [-k] [<options>] <arg-list>
-k if present perform the following logic, else call perldoc
with <arglist> and return result of first successful :
"perldoc <options> arg-list"
"perldoc <options> -f arg"
"perldoc <options> -q arg"
or return failure message
EOD
$argv =~ s/\s*-[dk]\s+/ /g; $argv =~ s/\s\s+/ /g;
print "argv=$argv\n" if $debug;
if (not $A{k}) {
print `perldoc $argv`;
} else {
# if "perldoc [options] arg" succeeds, returns it;
my $res = `perldoc $argv 2>&1`;
print $res and exit if $? == 0;
print "results=$res\n" if $debug;
# else if "perldoc [options] -f arg" succeeds, returns it;
if ($argv !~ /\s*-f\s+/) {
$res = `perldoc -f $argv 2>&1`;
print $res and exit if $? == 0;
print "results=$res\n" if $debug;
}
# else if "perldoc [options] -q arg" succeeds, returns it;
if ($argv !~ /\s*-q\s+/) {
$res = `perldoc -q $argv 2>&1`;
print $res and exit if $? == 0;
print "results=$res\n" if $debug;
}
# else returns failure message.
print "Error finding any perldoc results\n";
}
__END__
--
,-/- __ _ _ $Bill Luebkert Mailto:[EMAIL PROTECTED]
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // Castle of Medieval Myth & Magic http://www.todbe.com/
-/-' /___/_<_</_</_ http://dbecoll.tripod.com/ (My Perl/Lakers stuff)
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
