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 80a721c..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';
@@ -50,6 +52,7 @@ if(@ARGV<1) {
        die <<EOF;
 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,6 +76,7 @@ sub usage{
     die <<EOF;
 perldoc [options] PageName|ModuleName|ProgramName...
 perldoc [options] -f BuiltinFunction
+perldoc [options] -q FAQRegex
 
 Options:
     -h   Display this help message
@@ -81,12 +85,13 @@ Options:
     -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
@@ -97,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.
@@ -110,7 +119,7 @@ use Text::ParseWords;
 
 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
 
-getopts("mhtluvriFf:X") || usage;
+getopts("mhtluvriFf:Xq") || usage;
 
 usage if $opt_h || $opt_h; # avoid -w warning
 
@@ -127,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;
 }
@@ -359,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.$$";      
        }
@@ -398,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";
@@ -413,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) {
@@ -546,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
 
@@ -593,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;