rudimentary support for remote debugging, from aeons ago (somewhat
[p5sagit/p5-mst-13.2.git] / utils / perldoc.PL
index 23ec12f..760a0ce 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';
@@ -26,9 +28,10 @@ print "Extracting $file (with variable substitutions)\n";
 print OUT <<"!GROK!THIS!";
 $Config{startperl}
     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
-       if \$running_under_some_shell;
+       if 0;
 
-\@pagers = ();
+use strict;
+my \@pagers = ();
 push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
 !GROK!THIS!
 
@@ -44,12 +47,13 @@ print OUT <<'!NO!SUBS!';
 # man replacement, written in perl. This perldoc is strictly for reading
 # the perl manuals, though it too is written in perl.
 
-if(@ARGV<1) {
-       $me = $0;               # Editing $0 is unportable
+if (@ARGV<1) {
+       my $me = $0;            # Editing $0 is unportable
        $me =~ s,.*/,,;
        die <<EOF;
-Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
+Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-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.
@@ -59,12 +63,12 @@ EOF
 use Getopt::Std;
 use Config '%Config';
 
-@global_found = ();
-$global_target = "";
+my @global_found = ();
+my $global_target = "";
 
-$Is_VMS = $^O eq 'VMS';
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_Dos = $^O eq 'dos';
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_Dos = $^O eq 'dos';
 
 sub usage{
     warn "@_\n" if @_;
@@ -73,62 +77,91 @@ 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 
+    -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
+    -n   Specify replacement for nroff
+    -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})
+    -q   Search the text of questions (not answers) in perlfaq[1-9]
 
 PageName|ModuleName...
-         is the name of a piece of documentation that you want to look at. You 
+         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 
+         `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'.
 
 BuiltinFunction
          is the name of a perl function.  Will extract documentation from
          `perlfunc'.
-         
-Any switches in the PERLDOC environment variable will be used before the 
+
+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.
 
 EOF
 }
 
-use Text::ParseWords;
+if (defined $ENV{"PERLDOC"}) {
+    require Text::ParseWords;
+    unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
+}
+!NO!SUBS!
+
+my $getopts = "mhtluvriFf:Xq:n:";
+print OUT <<"!GET!OPTS!";
 
+use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
 
-unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
+getopts("$getopts") || usage;
+!GET!OPTS!
 
-getopts("mhtluvriFf:X") || usage;
+print OUT <<'!NO!SUBS!';
 
-usage if $opt_h || $opt_h; # avoid -w warning
+usage if $opt_h;
+$opt_n = "nroff" if !$opt_n;
 
-$podidx = "$Config{'archlib'}/pod.idx";
-$podidx = "" if $opt_X || !-f "pod.idx" && !-r _ && -M _ > 7;
+my $podidx;
+if ($opt_X) {
+    $podidx = "$Config{'archlib'}/pod.idx";
+    $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
+}
 
-if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
+if ((my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
     usage("only one of -t, -u, -m or -l")
-} elsif ($Is_MSWin32 || $Is_Dos) {
-    $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
+}
+elsif ($Is_MSWin32
+       || $Is_Dos
+       || !(exists $ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
+{
+    $opt_t = 1 unless $opts
 }
 
 if ($opt_t) { require Pod::Text; import Pod::Text; }
 
+my @pages;
 if ($opt_f) {
-   @pages = ("perlfunc");
-} else {
-   @pages = @ARGV;
+    @pages = ("perlfunc");
+}
+elsif ($opt_q) {
+    @pages = ("perlfaq1" .. "perlfaq9");
+}
+else {
+    @pages = @ARGV;
 }
 
 # Does this look like a module or extension directory?
@@ -139,15 +172,13 @@ if (-f "Makefile.PL") {
        require ExtUtils::testlib;
 }
 
-
-
 sub containspod {
     my($file, $readit) = @_;
     return 1 if !$readit && $file =~ /\.pod$/i;
     local($_);
     open(TEST,"<$file");
-    while(<TEST>) {
-       if(/^=head/) {
+    while (<TEST>) {
+       if (/^=head/) {
            close(TEST);
            return 1;
        }
@@ -161,9 +192,9 @@ sub minus_f_nocase {
      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 
+        # 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 _;
+       warn "Ignored $path: unreadable\n" if -f _;
        return '';
      }
      local *DIR;
@@ -172,12 +203,11 @@ sub minus_f_nocase {
      my($p,$cip);
      foreach $p (split(/\//, $file)){
        my $try = "@p/$p";
-       warn "$try\n";
        stat $try;
-       if (-d _){
+       if (-d _) {
            push @p, $p;
            if ( $p eq $global_target) {
-               $tmp_path = join ('/', @p);
+               my $tmp_path = join ('/', @p);
                my $path_f = 0;
                for (@global_found) {
                    $path_f = 1 if $_ eq $tmp_path;
@@ -185,11 +215,14 @@ sub minus_f_nocase {
                push (@global_found, $tmp_path) unless $path_f;
                print STDERR "Found as @p but directory\n" if $opt_v;
            }
-       } elsif (-f _ && -r _) {
+       }
+       elsif (-f _ && -r _) {
            return $try;
-       } elsif (-f _) {
+       }
+       elsif (-f _) {
            warn "Ignored $try: unreadable\n";
-       } else {
+       }
+       else {
            my $found=0;
            my $lcp = lc $p;
            opendir DIR, "@p";
@@ -203,20 +236,22 @@ sub minus_f_nocase {
            return "" unless $found;
            push @p, $cip;
            return "@p" if -f "@p" and -r _;
-           warn "Ignored $file: unreadable\n" if -f _;
+           warn "Ignored @p: unreadable\n" if -f _;
        }
      }
      return "";
 }
+
 
 sub check_file {
     my($dir,$file) = @_;
+    return "" if length $dir and not -d $dir;
     if ($opt_m) {
        return minus_f_nocase($dir,$file);
-    } else {
+    }
+    else {
        my $path = minus_f_nocase($dir,$file);
-        return $path if containspod($path);
+        return $path if length $path and containspod($path);
     }
     return "";
 }
@@ -240,16 +275,18 @@ sub searchfor {
                or ( $ret = check_file $dir,$s)
                or ( $Is_VMS and
                     $ret = check_file $dir,"$s.com")
-               or ( $^O eq 'os2' and 
+               or ( $^O eq 'os2' and
                     $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)
+               or ( $ret = check_file "$dir/pods","$s.pod")
+               or ( $ret = check_file "$dir/pods",$s)
        ) {
            return $ret;
        }
-       
+
        if ($recurse) {
            opendir(D,$dir);
            my @newdirs = map "$dir/$_", grep {
@@ -267,74 +304,150 @@ sub searchfor {
     return ();
 }
 
+sub filter_nroff {
+  my @data = split /\n{2,}/, shift;
+  shift @data while @data and $data[0] !~ /\S/; # Go to header
+  shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
+  pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
+                               # 28/Jan/99 perl 5.005, patch 53 1
+  join "\n\n", @data;
+}
+
+sub printout {
+    my ($file, $tmp, $filter) = @_;
+    my $err;
 
+    if ($opt_t) {
+       open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return;
+       Pod::Text->new()->parse_from_file($file,\*OUT);
+       close OUT;
+    }
+    elsif (not $opt_u) {
+       my $cmd = "pod2man --lax $_ | $opt_n -man";
+       $cmd .= " | col -x" if $^O =~ /hpux/;
+       my $rslt = `$cmd`;
+       $rslt = filter_nroff($rslt) if $filter;
+       unless (($err = $?)) {
+           open(TMP,">>$tmp") or warn("Can't open $tmp: $!"), return;
+           print TMP $rslt;
+           close TMP;
+       }
+    }
+    if ($opt_u or $err or -z $tmp) {
+       open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return;
+       open(IN,"<$file") or warn("Can't open $file: $!"), return;
+       my $cut = 1;
+       while (<IN>) {
+           $cut = $1 eq 'cut' if /^=(\w+)/;
+           next if $cut;
+           print OUT;
+       }
+       close IN;
+       close OUT;
+    }
+}
+
+sub page {
+    my ($tmp, $no_tty, @pagers) = @_;
+    if ($no_tty) {
+       open(TMP,"<$tmp") or warn("Can't open $tmp: $!"), return;
+       print while <TMP>;
+       close TMP;
+    }
+    else {
+       foreach my $pager (@pagers) {
+           system("$pager $tmp") or last;
+       }
+    }
+}
+
+sub cleanup {
+    my @files = @_;
+    for (@files) {
+       1 while unlink($_); #Possibly pointless VMSism
+    }
+}
+
+sub safe_exit {
+    my ($val, @files) = @_;
+    cleanup(@files);
+    exit $val;
+}
+
+sub safe_die {
+    my ($msg, @files) = @_;
+    cleanup(@files);
+    die $msg;
+}
+
+my @found;
 foreach (@pages) {
-        if ($podidx && open(PODIDX, $podidx)) {
-           my $searchfor = $_;
-           local($_);
-           $searchfor =~ s,::,/,g;
-           print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
-           while (<PODIDX>) {
-               chomp;
-               push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
-           }
-           close(PODIDX);
-           next;
-        }
-       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;
-       if ($opt_F) {
-         next unless -r;
-         push @found, $_ if $opt_m or containspod($_);
-         next;
+    if ($podidx && open(PODIDX, $podidx)) {
+       my $searchfor = $_;
+       local($_);
+       $searchfor =~ s,::,/,g;
+       print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
+       while (<PODIDX>) {
+           chomp;
+           push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
        }
-       unless ($opt_m) { 
-           if ($Is_VMS) {
-               my($i,$trn);
-               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'})));
+       close(PODIDX);
+       next;
+    }
+    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.
+    my @searchdirs = @INC;
+    if ($opt_F) {
+       next unless -r;
+       push @found, $_ if $opt_m or containspod($_);
+       next;
+    }
+    unless ($opt_m) {
+       if ($Is_VMS) {
+           my($i,$trn);
+           for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
+               push(@searchdirs,$trn);
            }
-           @files= searchfor(0,$_,@searchdirs);
+           push(@searchdirs,'perl_root:[lib.pod]')  # installed pods
+       }
+       else {
+           push(@searchdirs, grep(-d, split($Config{path_sep},
+                                            $ENV{'PATH'})));
        }
-       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 $opt_r;
-               if( @files ) {
-                       print STDERR "Loosely found as @files\n" if $opt_v;
-               } else {
-                       print STDERR "No documentation found for \"$_\".\n";
-                       if (@global_found) {
-                           print STDERR "However, try\n";
-                           my $dir = $file = "";
-                           for $dir (@global_found) {
-                               opendir(DIR, $dir) or die "$!";
-                               while ($file = readdir(DIR)) {
-                                   next if ($file =~ /^\./);
-                                   $file =~ s/\.(pm|pod)$//;
-                                   print STDERR "\tperldoc $_\::$file\n";
-                               }
-                               closedir DIR;
-                           }
-                       }
+    }
+    my @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 $opt_r;
+       if (@files) {
+           print STDERR "Loosely found as @files\n" if $opt_v;
+       }
+       else {
+           print STDERR "No documentation found for \"$_\".\n";
+           if (@global_found) {
+               print STDERR "However, try\n";
+               for my $dir (@global_found) {
+                   opendir(DIR, $dir) or die "$!";
+                   while (my $file = readdir(DIR)) {
+                       next if ($file =~ /^\./);
+                       $file =~ s/\.(pm|pod)$//;
+                       print STDERR "\tperldoc $_\::$file\n";
+                   }
+                   closedir DIR;
                }
+           }
        }
-       push(@found,@files);
+    }
+    push(@found,@files);
 }
 
-if(!@found) {
-       exit ($Is_VMS ? 98962 : 1);
+if (!@found) {
+    exit ($Is_VMS ? 98962 : 1);
 }
 
 if ($opt_l) {
@@ -342,122 +455,146 @@ if ($opt_l) {
     exit;
 }
 
-if( ! -t STDOUT ) { $no_tty = 1 }
+my $lines = $ENV{LINES} || 24;
+
+my $no_tty;
+if (! -t STDOUT) { $no_tty = 1 }
 
+# until here we could simply exit or die
+# now we create temporary files that we have to clean up
+# namely $tmp, $buffer
+
+my $tmp;
+my $buffer;
 if ($Is_MSWin32) {
-       $tmp = "$ENV{TEMP}\\perldoc1.$$";
-       push @pagers, qw( more< less notepad );
-       unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
-} elsif ($Is_VMS) {
-       $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
-       push @pagers, qw( most more less type/page );
-} elsif ($Is_Dos) {
-       $tmp = "$ENV{TEMP}/perldoc1.$$";
-       $tmp =~ tr!\\/!//!s;
-       push @pagers, qw( less.exe more.com< );
-       unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
-} else {
-       if ($^O eq 'os2') {
-         require POSIX;
-         $tmp = POSIX::tmpnam();
-       } else {
-         $tmp = "/tmp/perldoc1.$$";      
-       }
-       push @pagers, qw( more less pg view cat );
-       unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
+    $tmp = "$ENV{TEMP}\\perldoc1.$$";
+    $buffer = "$ENV{TEMP}\\perldoc1.b$$";
+    push @pagers, qw( more< less notepad );
+    unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
+    for (@found) { s,/,\\,g }
+}
+elsif ($Is_VMS) {
+    $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
+    $buffer = 'Sys$Scratch:perldoc.tmp1_b'.$$;
+    push @pagers, qw( most more less type/page );
+}
+elsif ($Is_Dos) {
+    $tmp = "$ENV{TEMP}/perldoc1.$$";
+    $buffer = "$ENV{TEMP}/perldoc1.b$$";
+    $tmp =~ tr!\\/!//!s;
+    $buffer =~ tr!\\/!//!s;
+    push @pagers, qw( less.exe more.com< );
+    unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
+}
+else {
+    if ($^O eq 'os2') {
+      require POSIX;
+      $tmp = POSIX::tmpnam();
+      $buffer = POSIX::tmpnam();
+      unshift @pagers, 'less', 'cmd /c more <';
+    }
+    else {
+      $tmp = "/tmp/perldoc1.$$";
+      $buffer = "/tmp/perldoc1.b$$";
+    }
+    push @pagers, qw( more less pg view cat );
+    unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
 }
 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
 
+# all exit calls from here on have to be safe_exit calls (see above)
+# and all die calls safe_die calls to guarantee removal of files and
+# dir as needed
+
 if ($opt_m) {
-       foreach $pager (@pagers) {
-               system("$pager @found") or exit;
-       }
-       if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
-       exit 1;
-} 
+    foreach my $pager (@pagers) {
+       system("$pager @found") or safe_exit(0, $tmp, $buffer);
+    }
+    if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
+    # I don't get the line above. Please patch yourself as needed.
+    safe_exit(1, $tmp, $buffer);
+}
 
+my @pod;
 if ($opt_f) {
-   my $perlfunc = shift @found;
-   open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
-
-   # Skip introduction
-   while (<PFUNC>) {
-       last if /^=head2 Alphabetical Listing of Perl Functions/;
-   }
-
-   # Look for our function
-   my $found = 0;
-   my @pod;
-   while (<PFUNC>) {
-       if (/^=item\s+\Q$opt_f\E\b/o)  {
-          $found = 1;
-       } elsif (/^=item/) {
-          last if $found > 1;
-       }
-       next unless $found;
-       push @pod, $_;
-       ++$found if /^\w/;      # found descriptive text
-   }
-   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;
-}
+    my $perlfunc = shift @found;
+    open(PFUNC, $perlfunc)
+       or safe_die("Can't open $perlfunc: $!", $tmp, $buffer);
 
-foreach (@found) {
+    # Functions like -r, -e, etc. are listed under `-X'.
+    my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
+                       ? 'I<-X' : $opt_f ;
 
-       if($opt_t) {
-               open(TMP,">>$tmp");
-               Pod::Text::pod2text($_,*TMP);
-               close(TMP);
-       } elsif(not $opt_u) {
-               my $cmd = "pod2man --lax $_ | nroff -man";
-               $cmd .= " | col -x" if $^O =~ /hpux/;
-               $rslt = `$cmd`;
-               unless(($err = $?)) {
-                       open(TMP,">>$tmp");
-                       print TMP $rslt;
-                       close TMP;
-               }
+    # Skip introduction
+    while (<PFUNC>) {
+       last if /^=head2 Alphabetical Listing of Perl Functions/;
+    }
+
+    # Look for our function
+    my $found = 0;
+    my $inlist = 0;
+    while (<PFUNC>) {
+       if (/^=item\s+\Q$search_string\E\b/o)  {
+           $found = 1;
        }
-                                                       
-       if( $opt_u or $err or -z $tmp) {
-               open(OUT,">>$tmp");
-               open(IN,"<$_");
-               $cut = 1;
-               while (<IN>) {
-                       $cut = $1 eq 'cut' if /^=(\w+)/;
-                       next if $cut;
-                       print OUT;
-               }
-               close(IN);
-               close(OUT);
+       elsif (/^=item/) {
+           last if $found > 1 and not $inlist;
+       }
+       next unless $found;
+       if (/^=over/) {
+           ++$inlist;
+       }
+       elsif (/^=back/) {
+           --$inlist;
        }
+       push @pod, $_;
+       ++$found if /^\w/;      # found descriptive text
+    }
+    if (!@pod) {
+       die "No documentation for perl function `$opt_f' found\n";
+    }
 }
 
-if( $no_tty ) {
-       open(TMP,"<$tmp");
-       print while <TMP>;
-       close(TMP);
-} else {
-       foreach $pager (@pagers) {
-               system("$pager $tmp") or last;
+if ($opt_q) {
+    local @ARGV = @found;      # I'm lazy, sue me.
+    my $found = 0;
+    my %found_in;
+
+    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) {
+       safe_die("No documentation for perl FAQ keyword `$opt_q' found\n",
+                $tmp, $buffer);
+    }
+}
+
+my $filter;
+
+if (@pod) {
+    open(TMP,">$buffer") or safe_die("Can't open '$buffer': $!", $tmp, $buffer);
+    print TMP "=over 8\n\n";
+    print TMP @pod;
+    print TMP "=back\n";
+    close TMP;
+    @found = $buffer;
+    $filter = 1;
 }
 
-1 while unlink($tmp); #Possibly pointless VMSism
+foreach (@found) {
+    printout($_, $tmp, $filter);
+}
+page($tmp, $no_tty, @pagers);
 
-exit 0;
+safe_exit(0, $tmp, $buffer);
 
 __END__
 
@@ -471,6 +608,8 @@ B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]  [B<-X>] Page
 
 B<perldoc> B<-f> BuiltinFunction
 
+B<perldoc> B<-q> FAQ Keyword
+
 =head1 DESCRIPTION
 
 I<perldoc> looks up a piece of documentation in .pod format that is embedded
@@ -523,6 +662,12 @@ Consider arguments as file names, no search in directories will be performed.
 The B<-f> option followed by the name of a perl built in function will
 extract the documentation of this function from L<perlfunc>.
 
+=item B<-q> perlfaq
+
+The B<-q> option takes a regular expression as an argument.  It will search
+the question headings in perlfaq[1-9] and print the entries matching
+the regular expression.
+
 =item B<-X> use an index if present
 
 The B<-X> option looks for a entry whose basename matches the name given on the
@@ -533,7 +678,7 @@ contain fully qualified filenames, one per line.
 
 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
+give a descriptive name of a page, such as C<perlfunc>. You may 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.
@@ -542,22 +687,39 @@ name, you will only get the first one.
 
 =head1 ENVIRONMENT
 
-Any switches in the C<PERLDOC> environment variable will be used before the 
+Any switches in the C<PERLDOC> environment variable will be used before the
 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.)
+
+One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
+
+=head1 VERSION
+
+This is perldoc v2.0.
 
 =head1 AUTHOR
 
 Kenneth Albanowski <kjahds@kjahds.com>
 
-Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
+Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
+and others.
 
 =cut
 
 #
+# Version 1.15: Tue Aug 24 01:50:20 EST 1999
+#       Charles Wilson <cwilson@ece.gatech.edu>
+#      changed /pod/ directory to /pods/ for cygwin
+#         to support cygwin/win32
+# Version 1.14: Wed Jul 15 01:50:20 EST 1998
+#       Robin Barker <rmb1@cise.npl.co.uk>
+#      -strict, -w cleanups
 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
 #       Gurusamy Sarathy <gsar@umich.edu>
 #      -doc tweaks for -F and -X options
@@ -568,7 +730,7 @@ Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
 #       Kenneth Albanowski <kjahds@kjahds.com>
 #   -added Charles Bailey's further VMS patches, and -u switch
 #   -added -t switch, with pod2text support
-# 
+#
 # Version 1.10: Thu Nov  9 07:23:47 EST 1995
 #              Kenneth Albanowski <kjahds@kjahds.com>
 #      -added VMS support
@@ -594,3 +756,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;