This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH for _66] Makefile.SH problem on dos/djgpp
[perl5.git] / utils / perldoc.PL
index 53219a7..ac71dd6 100644 (file)
@@ -2,6 +2,7 @@
 
 use Config;
 use File::Basename qw(&basename &dirname);
+use Cwd;
 
 # List explicitly here the variables you want Configure to
 # generate.  Metaconfig only looks for shell variables, so you
@@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname);
 
 # This forces PL files to create target in same directory as PL file.
 # This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
 chdir dirname($0);
 $file = basename($0, '.PL');
 $file .= '.com' if $^O eq 'VMS';
@@ -48,8 +50,9 @@ if(@ARGV<1) {
        $me = $0;               # Editing $0 is unportable
        $me =~ s,.*/,,;
        die <<EOF;
-Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
+Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
        $me -f PerlFunc
+       $me -q FAQKeywords
 
 The -h option prints more help.  Also try "perldoc perldoc" to get
 aquainted with the system.
@@ -73,18 +76,22 @@ sub usage{
     die <<EOF;
 perldoc [options] PageName|ModuleName|ProgramName...
 perldoc [options] -f BuiltinFunction
+perldoc [options] -q FAQRegex
 
 Options:
     -h   Display this help message
+    -r   Recursive search (slow)
+    -i   Ignore case 
     -t   Display pod using pod2text instead of pod2man and nroff
              (-t is the default on win32)
     -u  Display unformatted pod text
-    -m   Display modules file in its entirety
-    -l   Display the modules file name
+    -m   Display module's file in its entirety
+    -l   Display the module's file name
     -F   Arguments are file names, not modules
     -v  Verbosely describe what's going on
     -X  use index if present (looks for pod.idx at $Config{archlib})
 
+
 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
@@ -95,7 +102,11 @@ PageName|ModuleName...
 BuiltinFunction
          is the name of a perl function.  Will extract documentation from
          `perlfunc'.
-         
+
+FAQRegex
+         is a regex. Will search perlfaq[1-9] for and extract any
+         questions that match.
+
 Any switches in the PERLDOC environment variable will be used before the 
 command line arguments.  The optional pod index file contains a list of
 filenames, one per line.
@@ -108,7 +119,7 @@ use Text::ParseWords;
 
 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
 
-getopts("mhtluvFf:X") || usage;
+getopts("mhtluvriFf:Xq") || usage;
 
 usage if $opt_h || $opt_h; # avoid -w warning
 
@@ -125,6 +136,8 @@ if ($opt_t) { require Pod::Text; import Pod::Text; }
 
 if ($opt_f) {
    @pages = ("perlfunc");
+} elsif ($opt_q) {
+   @pages = ("perlfaq1" .. "perlfaq9");
 } else {
    @pages = @ARGV;
 }
@@ -155,16 +168,19 @@ sub containspod {
 }
 
 sub minus_f_nocase {
-     my($file) = @_;
-     # on a case-forgiving file system we can simply use -f $file
-     if ($Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
-        return $file if -f $file and -r _;
+     my($dir,$file) = @_;
+     my $path = join('/',$dir,$file);
+     return $path if -f $path and -r _;
+     if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
+        # on a case-forgiving file system or if case is important 
+       # that is it all we can do
        warn "Ignored $file: unreadable\n" if -f _;
        return '';
      }
      local *DIR;
      local($")="/";
-     my(@p,$p,$cip);
+     my @p = ($dir);
+     my($p,$cip);
      foreach $p (split(/\//, $file)){
        my $try = "@p/$p";
        stat $try;
@@ -200,13 +216,19 @@ sub minus_f_nocase {
            warn "Ignored $file: unreadable\n" if -f _;
        }
      }
-     return; # is not a file
+     return "";
 }
  
 
 sub check_file {
-    my($file) = @_;
-    return minus_f_nocase($file) && containspod($file) ? $file : "";
+    my($dir,$file) = @_;
+    if ($opt_m) {
+       return minus_f_nocase($dir,$file);
+    } else {
+       my $path = minus_f_nocase($dir,$file);
+        return $path if containspod($path);
+    }
+    return "";
 }
 
 
@@ -223,17 +245,17 @@ sub searchfor {
     for ($i=0; $i<@dirs; $i++) {
        $dir = $dirs[$i];
        ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
-       if (       ( $ret = check_file "$dir/$s.pod")
-               or ( $ret = check_file "$dir/$s.pm")
-               or ( $ret = check_file "$dir/$s")
+       if (       ( $ret = check_file $dir,"$s.pod")
+               or ( $ret = check_file $dir,"$s.pm")
+               or ( $ret = check_file $dir,$s)
                or ( $Is_VMS and
-                    $ret = check_file "$dir/$s.com")
+                    $ret = check_file $dir,"$s.com")
                or ( $^O eq 'os2' and 
-                    $ret = check_file "$dir/$s.cmd")
+                    $ret = check_file $dir,"$s.cmd")
                or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
-                    $ret = check_file "$dir/$s.bat")
-               or ( $ret = check_file "$dir/pod/$s.pod")
-               or ( $ret = check_file "$dir/pod/$s")
+                    $ret = check_file $dir,"$s.bat")
+               or ( $ret = check_file "$dir/pod","$s.pod")
+               or ( $ret = check_file "$dir/pod",$s)
        ) {
            return $ret;
        }
@@ -284,6 +306,7 @@ foreach (@pages) {
                for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
                    push(@searchdirs,$trn);
                }
+           push(@dirs,'perl_root:[lib.pod]')  # installed pods
            } else {
                push(@searchdirs, grep(-d, split($Config{path_sep}, 
                                                 $ENV{'PATH'})));
@@ -297,7 +320,7 @@ foreach (@pages) {
                
                @searchdirs = grep(!/^\.$/,@INC);
                
-               @files= searchfor(1,$_,@searchdirs);
+               @files= searchfor(1,$_,@searchdirs) if $opt_r;
                if( @files ) {
                        print STDERR "Loosely found as @files\n" if $opt_v;
                } else {
@@ -347,6 +370,7 @@ if ($Is_MSWin32) {
        if ($^O eq 'os2') {
          require POSIX;
          $tmp = POSIX::tmpnam();
+         unshift @pagers, 'less', 'cmd /c more <';
        } else {
          $tmp = "/tmp/perldoc1.$$";      
        }
@@ -386,14 +410,23 @@ if ($opt_f) {
        ++$found if /^\w/;      # found descriptive text
    }
    if (@pod) {
+       my $lines = $ENV{LINES} || 24;
+
        if ($opt_t) {
           open(FORMATTER, "| pod2text") || die "Can't start filter";
           print FORMATTER "=over 8\n\n";
           print FORMATTER @pod;
           print FORMATTER "=back\n";
           close(FORMATTER);
-       } else {
+       } elsif (@pod < $lines-2) {
           print @pod;
+       } else {
+          foreach $pager (@pagers) {
+               open (PAGER, "| $pager") or next;
+               print PAGER @pod ;
+               close(PAGER) or next;
+               last;
+          }
        }
    } else {
        die "No documentation for perl function `$opt_f' found\n";
@@ -401,6 +434,39 @@ if ($opt_f) {
    exit;
 }
 
+if ($opt_q) {
+   local @ARGV = @found;       # I'm lazy, sue me.
+   my $found = 0;
+   my %found_in;
+   my @pod;
+
+   while (<>) {
+      if (/^=head2\s+.*$opt_q/oi) {
+        $found = 1;
+        push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
+      } elsif (/^=head2/) {
+        $found = 0;
+      }
+      next unless $found;
+      push @pod, $_;
+   }
+   
+   if (@pod) {
+      if ($opt_t) {
+        open(FORMATTER, "| pod2text") || die "Can't start filter";
+        print FORMATTER "=over 8\n\n";
+        print FORMATTER @pod;
+        print FORMATTER "=back\n";
+        close(FORMATTER);
+      } else {
+        print @pod;
+      }
+   } else {
+      die "No documentation for perl function `$opt_f' found\n";
+   }
+   exit;
+}
+
 foreach (@found) {
 
        if($opt_t) {
@@ -534,7 +600,10 @@ command line arguments.  C<perldoc> also searches directories
 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
 defined) and C<PATH> environment variables.
 (The latter is so that embedded pods for executables, such as
-C<perldoc> itself, are available.)
+C<perldoc> itself, are available.)  C<perldoc> will use, in order of
+preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
+C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
+used if C<perldoc> was told to display plain text or unformatted pod.)
 
 =head1 AUTHOR
 
@@ -581,3 +650,4 @@ Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
 close OUT or die "Can't close $file: $!";
 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;