A patch for perldoc, over 5.001n. This adds imprecise matching (All of
"term::info", "Term::Info", and "info" will match "Term::Info.pm") and
should act dramatically better on various errors. (If no pages were found,
say so. If pod2man or nroff is broken/uninstalled, then you'll get the
raw pod.)
As the comment mentions, this version is a bit slower then the original.
Sorry about that. Without indexing, there is a limit to how fast a sloppy
file lookup can be.
Charles hasn't gotten back to me about any problems with VMS, so
hopefully the comment about "VMS support" isn't completely inaccurate.
*** perldoc.orig Mon Nov 6 12:04:12 1995
--- perldoc Thu Nov 9 07:33:50 1995
***************
*** 9,12 ****
--- 9,21 ----
# the perl manuals, though it too is written in perl.
#
+ # Version 1.1: Thu Nov 9 07:23:47 EST 1995
+ # Kenneth Albanowski <kjahds@kjahds.com>
+ # -added VMS support
+ # -added better error recognition (on no found pages, just exit. On
+ # missing nroff/pod2man, just display raw pod.)
+ # -added recursive/case-insensitive matching (thanks, Andreas). This
+ # slows things down a bit, unfortunately. Give a precise name, and
+ # it'll run faster.
+ #
# Version 1.01: Tue May 30 14:47:34 EDT 1995
# Andy Dougherty <doughera@lafcol.lafayette.edu>
***************
*** 15,18 ****
--- 24,33 ----
# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
# and friends.
+ #
+ #
+ # TODO:
+ #
+ # Cache directories read during sloppy match
+ #
=head1 NAME
***************
*** 22,26 ****
=head1 SYNOPSIS
! B<perldoc> [B<-h>] PageName|ModuleName
=head1 DESCRIPTION
--- 37,41 ----
=head1 SYNOPSIS
! B<perldoc> [B<-h>] [B<-v>] PageName|ModuleName|ProgramName
=head1 DESCRIPTION
***************
*** 42,50 ****
Prints out a brief help message.
! =item B<PageName|ModuleName>
The item you want to look up. Nested modules (such as C<File::Basename>)
! are specified either as C<File::Basename> or C<File/Basename>. You
! may also give a descriptive name of a page, such as C<perlfunc>.
=back
--- 57,72 ----
Prints out a brief help message.
! =item B<-v> verbose
!
! Describes search for the item in detail.
!
! =item B<PageName|ModuleName|ProgramName>
The item you want to look up. Nested modules (such as C<File::Basename>)
! are specified either as C<File::Basename> or C<File/Basename>. You may also
! give a descriptive name of a page, such as C<perlfunc>. You make also give a
! partial or wrong-case name, such as "basename" for "File::Basename", but
! this will be slower, if there is more then one page with the same partial
! name, you will only get the first one.
=back
***************
*** 73,77 ****
if(@ARGV<1) {
die <<EOF;
! Usage: $0 [-h] PageName|ModuleName
We suggest you use "perldoc perldoc" to get aquainted
--- 95,99 ----
if(@ARGV<1) {
die <<EOF;
! Usage: $0 [-h] [-v] PageName|ModuleName|ProgramName
We suggest you use "perldoc perldoc" to get aquainted
***************
*** 85,95 ****
warn "@_\n" if @_;
die <<EOF;
! perlman [-h] PageName|ModuleName...
-h Display this help message.
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
may either give a descriptive name of the page (as in the case of
! `perlfunc') or the name of a module, either like `Term::Info',
! `Term/Info'.
Any switches in the PERLDOC environment variable will be used before the
--- 107,119 ----
warn "@_\n" if @_;
die <<EOF;
! perldoc [-h] [-v] PageName|ModuleName|ProgramName...
-h Display this help message.
+ -v Verbosely describe what's going on.
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
may either give a descriptive name of the page (as in the case of
! `perlfunc') the name of a module, either like `Term::Info',
! `Term/Info', the partial name of a module, like `info', or
! `makemaker', or the name of a program, like `perldoc'.
Any switches in the PERLDOC environment variable will be used before the
***************
*** 101,107 ****
use Text::ParseWords;
unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
! getopts("h") || usage;
usage if $opt_h;
--- 125,132 ----
use Text::ParseWords;
+
unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
! getopts("hv") || usage;
usage if $opt_h;
***************
*** 124,175 ****
}
! sub searchfor {
! my($s,@dirs) = @_;
! $s =~ s!::!/!g;
! # printf STDERR "looking for $s in @dirs\n";
!
! foreach $dir (@dirs) {
! if( -f "$dir/$s.pod") { return "$dir/$s.pod" }
! elsif( -f "$dir/$s.pm" and containspod("$dir/$s.pm"))
! { return "$dir/$s.pm" }
! elsif( -f "$dir/$s" and containspod("$dir/$s"))
! { return "$dir/$s" }
! elsif( -f "$dir/pod/$s.pod") { return "$dir/pod/$s.pod" }
! elsif( -f "$dir/pod/$s" and containspod("$dir/pod/$s"))
! { return "$dir/pod/$s" }
! }
! return ();
! }
- $ENV{PAGER} ||= "more";
-
foreach (@pages) {
! print STDERR "Searching for $_\n";
# We must look both in @INC for library modules and in PATH
# for executables, like h2xs or perldoc itself.
@searchdirs = @INC;
! push(@searchdirs, split(':', $ENV{'PATH'}) );
! @files= searchfor($_,@searchdirs);
if( @files ) {
! print STDERR "Found as @files\n";
} else {
! print STDERR "No documentation found for $_\n";
}
push(@found,@files);
}
$cmd=$filter="";
if( ! -t STDOUT ) { $opt_f = 1 }
! $cmd = "pod2man - | nroff -man";
! if( ! $opt_f ) { $filter = "|$ENV{PAGER}" };
- open(OUT,"|$cmd$filter");
foreach (@found) {
! open(IN,"<$_");
! print OUT while <IN>;
! close(IN);
}
! close(OUT);
--- 149,299 ----
}
! sub minus_f_nocase {
! my($file) = @_;
! local *DIR;
! local($")="/";
! my(@p,$p,$cip);
! foreach $p (split(/\//, $file)){
! if (-d ("@p/$p")){
! push @p, $p;
! } elsif (-f ("@p/$p")) {
! return "@p/$p";
! } else {
! my $found=0;
! my $lcp = lc $p;
! opendir DIR, "@p";
! while ($cip=readdir(DIR)) {
! if (lc $cip eq $lcp){
! $found++;
! last;
! }
! }
! closedir DIR;
! return "" unless $found;
! push @p, $cip;
! return "@p" if -f "@p";
! }
! }
! return; # is not a file
! }
!
! sub searchfor {
! my($recurse,$s,@dirs) = @_;
! $s =~ s!::!/!g;
! printf STDERR "looking for $s in @dirs\n" if $opt_v;
! my $ret;
! my $i;
! my $dir;
! for ($i=0;$i<@dirs;$i++) {
! $dir = $dirs[$i];
! if (( $ret = minus_f_nocase "$dir/$s.pod")
! or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
! or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
! or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
! or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
! { return $ret; }
!
! if($recurse) {
! opendir(D,$dir);
! my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
! closedir(D);
! print STDERR "Also looking in @newdirs\n" if $opt_v;
! push(@dirs,@newdirs);
! }
! }
! return ();
! }
foreach (@pages) {
! print STDERR "Searching for $_\n" if $opt_v;
# We must look both in @INC for library modules and in PATH
# for executables, like h2xs or perldoc itself.
@searchdirs = @INC;
! push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
! @files= searchfor(0,$_,@searchdirs);
if( @files ) {
! print STDERR "Found as @files\n" if $opt_v;
} else {
! # no match, try recursive search
!
! @searchdirs = grep(!/^\.$/,@INC);
!
!
! @files= searchfor(1,$_,@searchdirs);
! if( @files ) {
! print STDERR "Loosly found as @files\n" if $opt_v;
! } else {
! print STDERR "No documentation found for '$_'\n";
! }
}
push(@found,@files);
}
+ if(!@found) {
+ exit 1;
+ }
+
$cmd=$filter="";
if( ! -t STDOUT ) { $opt_f = 1 }
! require Config;
!
! $VMS = $Config::Config{'osname'} eq "VMS";
!
! unless($VMS) {
! $tmp = "/tmp/perldoc1.$$";
! $tmp2 = "/tmp/perldoc2.$$";
! $goodresult = 0;
! } else {
! $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
! $tmp2 = 'Sys$Scratch:perldoc.tmp2_'.$$;
! $goodresult = 1;
! }
foreach (@found) {
!
! open(TMP,">>$tmp");
! $rslt = `pod2man $_ | nroff -man`;
! if ($VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
! else { $err = $?; }
! print TMP $rslt unless $err;
! close TMP;
!
! 1 while unlink($tmp2); # Possibly pointless VMSism
!
! if( $err or -z $tmp) {
! open(OUT,">>$tmp");
! open(IN,"<$_");
! print OUT while <IN>;
! close(IN);
! close(OUT);
! }
}
!
! if( $opt_f ) {
! open(TMP,"<$tmp");
! print while <TMP>;
! close(TMP);
! } else {
! pager:
! {
! if( $ENV{PAGER} and system("$ENV{PAGER} $tmp")==$goodresult)
! { last pager }
! if( $Config{pager} and system("$Config{pager} $tmp")==$goodresult)
! { last pager }
! if( system("more $tmp")==$goodresult)
! { last pager }
! if( system("less $tmp")==$goodresult)
! { last pager }
! if( system("pg $tmp")==$goodresult)
! { last pager }
! if( system("view $tmp")==$goodresult)
! { last pager }
! }
! }
!
! 1 while unlink($tmp); #Possibly pointless VMSism
!
! exit 0;
--
Kenneth Albanowski (kjahds@kjahds.com, CIS: 70705,126)
"term::info", "Term::Info", and "info" will match "Term::Info.pm") and
should act dramatically better on various errors. (If no pages were found,
say so. If pod2man or nroff is broken/uninstalled, then you'll get the
raw pod.)
As the comment mentions, this version is a bit slower then the original.
Sorry about that. Without indexing, there is a limit to how fast a sloppy
file lookup can be.
Charles hasn't gotten back to me about any problems with VMS, so
hopefully the comment about "VMS support" isn't completely inaccurate.
*** perldoc.orig Mon Nov 6 12:04:12 1995
--- perldoc Thu Nov 9 07:33:50 1995
***************
*** 9,12 ****
--- 9,21 ----
# the perl manuals, though it too is written in perl.
#
+ # Version 1.1: Thu Nov 9 07:23:47 EST 1995
+ # Kenneth Albanowski <kjahds@kjahds.com>
+ # -added VMS support
+ # -added better error recognition (on no found pages, just exit. On
+ # missing nroff/pod2man, just display raw pod.)
+ # -added recursive/case-insensitive matching (thanks, Andreas). This
+ # slows things down a bit, unfortunately. Give a precise name, and
+ # it'll run faster.
+ #
# Version 1.01: Tue May 30 14:47:34 EDT 1995
# Andy Dougherty <doughera@lafcol.lafayette.edu>
***************
*** 15,18 ****
--- 24,33 ----
# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
# and friends.
+ #
+ #
+ # TODO:
+ #
+ # Cache directories read during sloppy match
+ #
=head1 NAME
***************
*** 22,26 ****
=head1 SYNOPSIS
! B<perldoc> [B<-h>] PageName|ModuleName
=head1 DESCRIPTION
--- 37,41 ----
=head1 SYNOPSIS
! B<perldoc> [B<-h>] [B<-v>] PageName|ModuleName|ProgramName
=head1 DESCRIPTION
***************
*** 42,50 ****
Prints out a brief help message.
! =item B<PageName|ModuleName>
The item you want to look up. Nested modules (such as C<File::Basename>)
! are specified either as C<File::Basename> or C<File/Basename>. You
! may also give a descriptive name of a page, such as C<perlfunc>.
=back
--- 57,72 ----
Prints out a brief help message.
! =item B<-v> verbose
!
! Describes search for the item in detail.
!
! =item B<PageName|ModuleName|ProgramName>
The item you want to look up. Nested modules (such as C<File::Basename>)
! are specified either as C<File::Basename> or C<File/Basename>. You may also
! give a descriptive name of a page, such as C<perlfunc>. You make also give a
! partial or wrong-case name, such as "basename" for "File::Basename", but
! this will be slower, if there is more then one page with the same partial
! name, you will only get the first one.
=back
***************
*** 73,77 ****
if(@ARGV<1) {
die <<EOF;
! Usage: $0 [-h] PageName|ModuleName
We suggest you use "perldoc perldoc" to get aquainted
--- 95,99 ----
if(@ARGV<1) {
die <<EOF;
! Usage: $0 [-h] [-v] PageName|ModuleName|ProgramName
We suggest you use "perldoc perldoc" to get aquainted
***************
*** 85,95 ****
warn "@_\n" if @_;
die <<EOF;
! perlman [-h] PageName|ModuleName...
-h Display this help message.
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
may either give a descriptive name of the page (as in the case of
! `perlfunc') or the name of a module, either like `Term::Info',
! `Term/Info'.
Any switches in the PERLDOC environment variable will be used before the
--- 107,119 ----
warn "@_\n" if @_;
die <<EOF;
! perldoc [-h] [-v] PageName|ModuleName|ProgramName...
-h Display this help message.
+ -v Verbosely describe what's going on.
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
may either give a descriptive name of the page (as in the case of
! `perlfunc') the name of a module, either like `Term::Info',
! `Term/Info', the partial name of a module, like `info', or
! `makemaker', or the name of a program, like `perldoc'.
Any switches in the PERLDOC environment variable will be used before the
***************
*** 101,107 ****
use Text::ParseWords;
unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
! getopts("h") || usage;
usage if $opt_h;
--- 125,132 ----
use Text::ParseWords;
+
unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
! getopts("hv") || usage;
usage if $opt_h;
***************
*** 124,175 ****
}
! sub searchfor {
! my($s,@dirs) = @_;
! $s =~ s!::!/!g;
! # printf STDERR "looking for $s in @dirs\n";
!
! foreach $dir (@dirs) {
! if( -f "$dir/$s.pod") { return "$dir/$s.pod" }
! elsif( -f "$dir/$s.pm" and containspod("$dir/$s.pm"))
! { return "$dir/$s.pm" }
! elsif( -f "$dir/$s" and containspod("$dir/$s"))
! { return "$dir/$s" }
! elsif( -f "$dir/pod/$s.pod") { return "$dir/pod/$s.pod" }
! elsif( -f "$dir/pod/$s" and containspod("$dir/pod/$s"))
! { return "$dir/pod/$s" }
! }
! return ();
! }
- $ENV{PAGER} ||= "more";
-
foreach (@pages) {
! print STDERR "Searching for $_\n";
# We must look both in @INC for library modules and in PATH
# for executables, like h2xs or perldoc itself.
@searchdirs = @INC;
! push(@searchdirs, split(':', $ENV{'PATH'}) );
! @files= searchfor($_,@searchdirs);
if( @files ) {
! print STDERR "Found as @files\n";
} else {
! print STDERR "No documentation found for $_\n";
}
push(@found,@files);
}
$cmd=$filter="";
if( ! -t STDOUT ) { $opt_f = 1 }
! $cmd = "pod2man - | nroff -man";
! if( ! $opt_f ) { $filter = "|$ENV{PAGER}" };
- open(OUT,"|$cmd$filter");
foreach (@found) {
! open(IN,"<$_");
! print OUT while <IN>;
! close(IN);
}
! close(OUT);
--- 149,299 ----
}
! sub minus_f_nocase {
! my($file) = @_;
! local *DIR;
! local($")="/";
! my(@p,$p,$cip);
! foreach $p (split(/\//, $file)){
! if (-d ("@p/$p")){
! push @p, $p;
! } elsif (-f ("@p/$p")) {
! return "@p/$p";
! } else {
! my $found=0;
! my $lcp = lc $p;
! opendir DIR, "@p";
! while ($cip=readdir(DIR)) {
! if (lc $cip eq $lcp){
! $found++;
! last;
! }
! }
! closedir DIR;
! return "" unless $found;
! push @p, $cip;
! return "@p" if -f "@p";
! }
! }
! return; # is not a file
! }
!
! sub searchfor {
! my($recurse,$s,@dirs) = @_;
! $s =~ s!::!/!g;
! printf STDERR "looking for $s in @dirs\n" if $opt_v;
! my $ret;
! my $i;
! my $dir;
! for ($i=0;$i<@dirs;$i++) {
! $dir = $dirs[$i];
! if (( $ret = minus_f_nocase "$dir/$s.pod")
! or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
! or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
! or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
! or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
! { return $ret; }
!
! if($recurse) {
! opendir(D,$dir);
! my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
! closedir(D);
! print STDERR "Also looking in @newdirs\n" if $opt_v;
! push(@dirs,@newdirs);
! }
! }
! return ();
! }
foreach (@pages) {
! print STDERR "Searching for $_\n" if $opt_v;
# We must look both in @INC for library modules and in PATH
# for executables, like h2xs or perldoc itself.
@searchdirs = @INC;
! push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
! @files= searchfor(0,$_,@searchdirs);
if( @files ) {
! print STDERR "Found as @files\n" if $opt_v;
} else {
! # no match, try recursive search
!
! @searchdirs = grep(!/^\.$/,@INC);
!
!
! @files= searchfor(1,$_,@searchdirs);
! if( @files ) {
! print STDERR "Loosly found as @files\n" if $opt_v;
! } else {
! print STDERR "No documentation found for '$_'\n";
! }
}
push(@found,@files);
}
+ if(!@found) {
+ exit 1;
+ }
+
$cmd=$filter="";
if( ! -t STDOUT ) { $opt_f = 1 }
! require Config;
!
! $VMS = $Config::Config{'osname'} eq "VMS";
!
! unless($VMS) {
! $tmp = "/tmp/perldoc1.$$";
! $tmp2 = "/tmp/perldoc2.$$";
! $goodresult = 0;
! } else {
! $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
! $tmp2 = 'Sys$Scratch:perldoc.tmp2_'.$$;
! $goodresult = 1;
! }
foreach (@found) {
!
! open(TMP,">>$tmp");
! $rslt = `pod2man $_ | nroff -man`;
! if ($VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
! else { $err = $?; }
! print TMP $rslt unless $err;
! close TMP;
!
! 1 while unlink($tmp2); # Possibly pointless VMSism
!
! if( $err or -z $tmp) {
! open(OUT,">>$tmp");
! open(IN,"<$_");
! print OUT while <IN>;
! close(IN);
! close(OUT);
! }
}
!
! if( $opt_f ) {
! open(TMP,"<$tmp");
! print while <TMP>;
! close(TMP);
! } else {
! pager:
! {
! if( $ENV{PAGER} and system("$ENV{PAGER} $tmp")==$goodresult)
! { last pager }
! if( $Config{pager} and system("$Config{pager} $tmp")==$goodresult)
! { last pager }
! if( system("more $tmp")==$goodresult)
! { last pager }
! if( system("less $tmp")==$goodresult)
! { last pager }
! if( system("pg $tmp")==$goodresult)
! { last pager }
! if( system("view $tmp")==$goodresult)
! { last pager }
! }
! }
!
! 1 while unlink($tmp); #Possibly pointless VMSism
!
! exit 0;
--
Kenneth Albanowski (kjahds@kjahds.com, CIS: 70705,126)