utils/perldoc.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename qw(&basename &dirname);
   5 use Cwd;
   6
   7 # List explicitly here the variables you want Configure to
   8 # generate.  Metaconfig only looks for shell variables, so you
   9 # have to mention them as if they were shell variables, not
  10 # %Config entries.  Thus you write
  11 #  $startperl
  12 # to ensure Configure will look for $Config{startperl}.
  13
  14 # This forces PL files to create target in same directory as PL file.
  15 # This is so that make depend always knows where to find PL derivatives.
  16 $origdir = cwd;
  17 chdir dirname($0);
  18 $file = basename($0, '.PL');
  19 $file .= '.com' if $^O eq 'VMS';
  20
  21 open OUT,">$file" or die "Can't create $file: $!";
  22
  23 print "Extracting $file (with variable substitutions)\n";
  24
  25 # In this section, perl variables will be expanded during extraction.
  26 # You can use $Config{...} to use Configure variables.
  27
  28 print OUT <<"!GROK!THIS!";
  29 $Config{startperl}
  30     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
  31         if 0;
  32
  33 use strict;
  34 my \@pagers = ();
  35 push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
  36 !GROK!THIS!
  37
  38 # In the following, perl variables are not expanded during extraction.
  39
  40 print OUT <<'!NO!SUBS!';
  41
  42 #
  43 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
  44 # is embedded in the perl installation tree.
  45 #
  46 # This is not to be confused with Tom Christianson's perlman, which is a
  47 # man replacement, written in perl. This perldoc is strictly for reading
  48 # the perl manuals, though it too is written in perl.
  49
  50 if (@ARGV<1) {
  51         my $me = $0;            # Editing $0 is unportable
  52         $me =~ s,.*/,,;
  53         die <<EOF;
  54 Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageName|ModuleName|ProgramName
  55        $me -f PerlFunc
  56        $me -q FAQKeywords
  57
  58 The -h option prints more help.  Also try "perldoc perldoc" to get
  59 aquainted with the system.
  60 EOF
  61 }
  62
  63 use Getopt::Std;
  64 use Config '%Config';
  65
  66 my @global_found = ();
  67 my $global_target = "";
  68
  69 my $Is_VMS = $^O eq 'VMS';
  70 my $Is_MSWin32 = $^O eq 'MSWin32';
  71 my $Is_Dos = $^O eq 'dos';
  72
  73 sub usage{
  74     warn "@_\n" if @_;
  75     # Erase evidence of previous errors (if any), so exit status is simple.
  76     $! = 0;
  77     die <<EOF;
  78 perldoc [options] PageName|ModuleName|ProgramName...
  79 perldoc [options] -f BuiltinFunction
  80 perldoc [options] -q FAQRegex
  81
  82 Options:
  83     -h   Display this help message
  84     -r   Recursive search (slow)
  85     -i   Ignore case
  86     -t   Display pod using pod2text instead of pod2man and nroff
  87              (-t is the default on win32)
  88     -u   Display unformatted pod text
  89     -m   Display module's file in its entirety
  90     -n   Specify replacement for nroff
  91     -l   Display the module's file name
  92     -F   Arguments are file names, not modules
  93     -v   Verbosely describe what's going on
  94     -X   use index if present (looks for pod.idx at $Config{archlib})
  95     -q   Search the text of questions (not answers) in perlfaq[1-9]
  96
  97 PageName|ModuleName...
  98          is the name of a piece of documentation that you want to look at. You
  99          may either give a descriptive name of the page (as in the case of
 100          `perlfunc') the name of a module, either like `Term::Info',
 101          `Term/Info', the partial name of a module, like `info', or
 102          `makemaker', or the name of a program, like `perldoc'.
 103
 104 BuiltinFunction
 105          is the name of a perl function.  Will extract documentation from
 106          `perlfunc'.
 107
 108 FAQRegex
 109          is a regex. Will search perlfaq[1-9] for and extract any
 110          questions that match.
 111
 112 Any switches in the PERLDOC environment variable will be used before the
 113 command line arguments.  The optional pod index file contains a list of
 114 filenames, one per line.
 115
 116 EOF
 117 }
 118
 119 if (defined $ENV{"PERLDOC"}) {
 120     require Text::ParseWords;
 121     unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
 122 }
 123 !NO!SUBS!
 124
 125 my $getopts = "mhtluvriFf:Xq:n:";
 126 print OUT <<"!GET!OPTS!";
 127
 128 use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
 129
 130 getopts("$getopts") || usage;
 131 !GET!OPTS!
 132
 133 print OUT <<'!NO!SUBS!';
 134
 135 usage if $opt_h;
 136 $opt_n = "nroff" if !$opt_n;
 137
 138 my $podidx;
 139 if ($opt_X) {
 140     $podidx = "$Config{'archlib'}/pod.idx";
 141     $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
 142 }
 143
 144 if ((my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
 145     usage("only one of -t, -u, -m or -l")
 146 }
 147 elsif ($Is_MSWin32
 148        || $Is_Dos
 149        || !(exists $ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
 150 {
 151     $opt_t = 1 unless $opts
 152 }
 153
 154 if ($opt_t) { require Pod::Text; import Pod::Text; }
 155
 156 my @pages;
 157 if ($opt_f) {
 158     @pages = ("perlfunc");
 159 }
 160 elsif ($opt_q) {
 161     @pages = ("perlfaq1" .. "perlfaq9");
 162 }
 163 else {
 164     @pages = @ARGV;
 165 }
 166
 167 # Does this look like a module or extension directory?
 168 if (-f "Makefile.PL") {
 169         # Add ., lib and blib/* libs to @INC (if they exist)
 170         unshift(@INC, '.');
 171         unshift(@INC, 'lib') if -d 'lib';
 172         require ExtUtils::testlib;
 173 }
 174
 175 sub containspod {
 176     my($file, $readit) = @_;
 177     return 1 if !$readit && $file =~ /\.pod$/i;
 178     local($_);
 179     open(TEST,"<$file");
 180     while (<TEST>) {
 181         if (/^=head/) {
 182             close(TEST);
 183             return 1;
 184         }
 185     }
 186     close(TEST);
 187     return 0;
 188 }
 189
 190 sub minus_f_nocase {
 191      my($dir,$file) = @_;
 192      my $path = join('/',$dir,$file);
 193      return $path if -f $path and -r _;
 194      if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
 195         # on a case-forgiving file system or if case is important
 196         # that is it all we can do
 197         warn "Ignored $path: unreadable\n" if -f _;
 198         return '';
 199      }
 200      local *DIR;
 201      local($")="/";
 202      my @p = ($dir);
 203      my($p,$cip);
 204      foreach $p (split(/\//, $file)){
 205         my $try = "@p/$p";
 206         stat $try;
 207         if (-d _) {
 208             push @p, $p;
 209             if ( $p eq $global_target) {
 210                 my $tmp_path = join ('/', @p);
 211                 my $path_f = 0;
 212                 for (@global_found) {
 213                     $path_f = 1 if $_ eq $tmp_path;
 214                 }
 215                 push (@global_found, $tmp_path) unless $path_f;
 216                 print STDERR "Found as @p but directory\n" if $opt_v;
 217             }
 218         }
 219         elsif (-f _ && -r _) {
 220             return $try;
 221         }
 222         elsif (-f _) {
 223             warn "Ignored $try: unreadable\n";
 224         }
 225         else {
 226             my $found=0;
 227             my $lcp = lc $p;
 228             opendir DIR, "@p";
 229             while ($cip=readdir(DIR)) {
 230                 if (lc $cip eq $lcp){
 231                     $found++;
 232                     last;
 233                 }
 234             }
 235             closedir DIR;
 236             return "" unless $found;
 237             push @p, $cip;
 238             return "@p" if -f "@p" and -r _;
 239             warn "Ignored @p: unreadable\n" if -f _;
 240         }
 241      }
 242      return "";
 243 }
 244
 245
 246 sub check_file {
 247     my($dir,$file) = @_;
 248     return "" if length $dir and not -d $dir;
 249     if ($opt_m) {
 250         return minus_f_nocase($dir,$file);
 251     }
 252     else {
 253         my $path = minus_f_nocase($dir,$file);
 254         return $path if length $path and containspod($path);
 255     }
 256     return "";
 257 }
 258
 259
 260 sub searchfor {
 261     my($recurse,$s,@dirs) = @_;
 262     $s =~ s!::!/!g;
 263     $s = VMS::Filespec::unixify($s) if $Is_VMS;
 264     return $s if -f $s && containspod($s);
 265     printf STDERR "Looking for $s in @dirs\n" if $opt_v;
 266     my $ret;
 267     my $i;
 268     my $dir;
 269     $global_target = (split('/', $s))[-1];
 270     for ($i=0; $i<@dirs; $i++) {
 271         $dir = $dirs[$i];
 272         ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
 273         if (       ( $ret = check_file $dir,"$s.pod")
 274                 or ( $ret = check_file $dir,"$s.pm")
 275                 or ( $ret = check_file $dir,$s)
 276                 or ( $Is_VMS and
 277                      $ret = check_file $dir,"$s.com")
 278                 or ( $^O eq 'os2' and
 279                      $ret = check_file $dir,"$s.cmd")
 280                 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
 281                      $ret = check_file $dir,"$s.bat")
 282                 or ( $ret = check_file "$dir/pod","$s.pod")
 283                 or ( $ret = check_file "$dir/pod",$s)
 284                 or ( $ret = check_file "$dir/pods","$s.pod")
 285                 or ( $ret = check_file "$dir/pods",$s)
 286         ) {
 287             return $ret;
 288         }
 289
 290         if ($recurse) {
 291             opendir(D,$dir);
 292             my @newdirs = map "$dir/$_", grep {
 293                 not /^\.\.?$/ and
 294                 not /^auto$/  and   # save time! don't search auto dirs
 295                 -d  "$dir/$_"
 296             } readdir D;
 297             closedir(D);
 298             next unless @newdirs;
 299             @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
 300             print STDERR "Also looking in @newdirs\n" if $opt_v;
 301             push(@dirs,@newdirs);
 302         }
 303     }
 304     return ();
 305 }
 306
 307 sub filter_nroff {
 308   my @data = split /\n{2,}/, shift;
 309   shift @data while @data and $data[0] !~ /\S/; # Go to header
 310   shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
 311   pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
 312                                 # 28/Jan/99 perl 5.005, patch 53 1
 313   join "\n\n", @data;
 314 }
 315
 316 sub printout {
 317     my ($file, $tmp, $filter) = @_;
 318     my $err;
 319
 320     if ($opt_t) {
 321         open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return;
 322         Pod::Text->new()->parse_from_file($file,\*OUT);
 323         close OUT;
 324     }
 325     elsif (not $opt_u) {
 326         my $cmd = "pod2man --lax $_ | $opt_n -man";
 327         $cmd .= " | col -x" if $^O =~ /hpux/;
 328         my $rslt = `$cmd`;
 329         $rslt = filter_nroff($rslt) if $filter;
 330         unless (($err = $?)) {
 331             open(TMP,">>$tmp") or warn("Can't open $tmp: $!"), return;
 332             print TMP $rslt;
 333             close TMP;
 334         }
 335     }
 336     if ($opt_u or $err or -z $tmp) {
 337         open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return;
 338         open(IN,"<$file") or warn("Can't open $file: $!"), return;
 339         my $cut = 1;
 340         while (<IN>) {
 341             $cut = $1 eq 'cut' if /^=(\w+)/;
 342             next if $cut;
 343             print OUT;
 344         }
 345         close IN;
 346         close OUT;
 347     }
 348 }
 349
 350 sub page {
 351     my ($tmp, $no_tty, @pagers) = @_;
 352     if ($no_tty) {
 353         open(TMP,"<$tmp") or warn("Can't open $tmp: $!"), return;
 354         print while <TMP>;
 355         close TMP;
 356     }
 357     else {
 358         foreach my $pager (@pagers) {
 359             system("$pager $tmp") or last;
 360         }
 361     }
 362 }
 363
 364 sub cleanup {
 365     my @files = @_;
 366     for (@files) {
 367         1 while unlink($_); #Possibly pointless VMSism
 368     }
 369 }
 370
 371 sub safe_exit {
 372     my ($val, @files) = @_;
 373     cleanup(@files);
 374     exit $val;
 375 }
 376
 377 sub safe_die {
 378     my ($msg, @files) = @_;
 379     cleanup(@files);
 380     die $msg;
 381 }
 382
 383 my @found;
 384 foreach (@pages) {
 385     if ($podidx && open(PODIDX, $podidx)) {
 386         my $searchfor = $_;
 387         local($_);
 388         $searchfor =~ s,::,/,g;
 389         print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
 390         while (<PODIDX>) {
 391             chomp;
 392             push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
 393         }
 394         close(PODIDX);
 395         next;
 396     }
 397     print STDERR "Searching for $_\n" if $opt_v;
 398     # We must look both in @INC for library modules and in PATH
 399     # for executables, like h2xs or perldoc itself.
 400     my @searchdirs = @INC;
 401     if ($opt_F) {
 402         next unless -r;
 403         push @found, $_ if $opt_m or containspod($_);
 404         next;
 405     }
 406     unless ($opt_m) {
 407         if ($Is_VMS) {
 408             my($i,$trn);
 409             for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
 410                 push(@searchdirs,$trn);
 411             }
 412             push(@searchdirs,'perl_root:[lib.pod]')  # installed pods
 413         }
 414         else {
 415             push(@searchdirs, grep(-d, split($Config{path_sep},
 416                                              $ENV{'PATH'})));
 417         }
 418     }
 419     my @files = searchfor(0,$_,@searchdirs);
 420     if (@files) {
 421         print STDERR "Found as @files\n" if $opt_v;
 422     }
 423     else {
 424         # no match, try recursive search
 425         @searchdirs = grep(!/^\.$/,@INC);
 426         @files= searchfor(1,$_,@searchdirs) if $opt_r;
 427         if (@files) {
 428             print STDERR "Loosely found as @files\n" if $opt_v;
 429         }
 430         else {
 431             print STDERR "No documentation found for \"$_\".\n";
 432             if (@global_found) {
 433                 print STDERR "However, try\n";
 434                 for my $dir (@global_found) {
 435                     opendir(DIR, $dir) or die "$!";
 436                     while (my $file = readdir(DIR)) {
 437                         next if ($file =~ /^\./);
 438                         $file =~ s/\.(pm|pod)$//;
 439                         print STDERR "\tperldoc $_\::$file\n";
 440                     }
 441                     closedir DIR;
 442                 }
 443             }
 444         }
 445     }
 446     push(@found,@files);
 447 }
 448
 449 if (!@found) {
 450     exit ($Is_VMS ? 98962 : 1);
 451 }
 452
 453 if ($opt_l) {
 454     print join("\n", @found), "\n";
 455     exit;
 456 }
 457
 458 my $lines = $ENV{LINES} || 24;
 459
 460 my $no_tty;
 461 if (! -t STDOUT) { $no_tty = 1 }
 462
 463 # until here we could simply exit or die
 464 # now we create temporary files that we have to clean up
 465 # namely $tmp, $buffer
 466
 467 my $tmp;
 468 my $buffer;
 469 if ($Is_MSWin32) {
 470     $tmp = "$ENV{TEMP}\\perldoc1.$$";
 471     $buffer = "$ENV{TEMP}\\perldoc1.b$$";
 472     push @pagers, qw( more< less notepad );
 473     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
 474     for (@found) { s,/,\\,g }
 475 }
 476 elsif ($Is_VMS) {
 477     $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
 478     $buffer = 'Sys$Scratch:perldoc.tmp1_b'.$$;
 479     push @pagers, qw( most more less type/page );
 480 }
 481 elsif ($Is_Dos) {
 482     $tmp = "$ENV{TEMP}/perldoc1.$$";
 483     $buffer = "$ENV{TEMP}/perldoc1.b$$";
 484     $tmp =~ tr!\\/!//!s;
 485     $buffer =~ tr!\\/!//!s;
 486     push @pagers, qw( less.exe more.com< );
 487     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
 488 }
 489 else {
 490     if ($^O eq 'os2') {
 491       require POSIX;
 492       $tmp = POSIX::tmpnam();
 493       $buffer = POSIX::tmpnam();
 494       unshift @pagers, 'less', 'cmd /c more <';
 495     }
 496     else {
 497       $tmp = "/tmp/perldoc1.$$";
 498       $buffer = "/tmp/perldoc1.b$$";
 499     }
 500     push @pagers, qw( more less pg view cat );
 501     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
 502 }
 503 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
 504
 505 # all exit calls from here on have to be safe_exit calls (see above)
 506 # and all die calls safe_die calls to guarantee removal of files and
 507 # dir as needed
 508
 509 if ($opt_m) {
 510     foreach my $pager (@pagers) {
 511         system("$pager @found") or safe_exit(0, $tmp, $buffer);
 512     }
 513     if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
 514     # I don't get the line above. Please patch yourself as needed.
 515     safe_exit(1, $tmp, $buffer);
 516 }
 517
 518 my @pod;
 519 if ($opt_f) {
 520     my $perlfunc = shift @found;
 521     open(PFUNC, $perlfunc)
 522         or safe_die("Can't open $perlfunc: $!", $tmp, $buffer);
 523
 524     # Functions like -r, -e, etc. are listed under `-X'.
 525     my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
 526                         ? 'I<-X' : $opt_f ;
 527
 528     # Skip introduction
 529     while (<PFUNC>) {
 530         last if /^=head2 Alphabetical Listing of Perl Functions/;
 531     }
 532
 533     # Look for our function
 534     my $found = 0;
 535     my $inlist = 0;
 536     while (<PFUNC>) {
 537         if (/^=item\s+\Q$search_string\E\b/o)  {
 538             $found = 1;
 539         }
 540         elsif (/^=item/) {
 541             last if $found > 1 and not $inlist;
 542         }
 543         next unless $found;
 544         if (/^=over/) {
 545             ++$inlist;
 546         }
 547         elsif (/^=back/) {
 548             --$inlist;
 549         }
 550         push @pod, $_;
 551         ++$found if /^\w/;      # found descriptive text
 552     }
 553     if (!@pod) {
 554         die "No documentation for perl function `$opt_f' found\n";
 555     }
 556 }
 557
 558 if ($opt_q) {
 559     local @ARGV = @found;       # I'm lazy, sue me.
 560     my $found = 0;
 561     my %found_in;
 562
 563     while (<>) {
 564         if (/^=head2\s+.*(?:$opt_q)/oi) {
 565             $found = 1;
 566             push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
 567         }
 568         elsif (/^=head2/) {
 569             $found = 0;
 570         }
 571         next unless $found;
 572         push @pod, $_;
 573     }
 574     if (!@pod) {
 575         safe_die("No documentation for perl FAQ keyword `$opt_q' found\n",
 576                  $tmp, $buffer);
 577     }
 578 }
 579
 580 my $filter;
 581
 582 if (@pod) {
 583     open(TMP,">$buffer") or safe_die("Can't open '$buffer': $!", $tmp, $buffer);
 584     print TMP "=over 8\n\n";
 585     print TMP @pod;
 586     print TMP "=back\n";
 587     close TMP;
 588     @found = $buffer;
 589     $filter = 1;
 590 }
 591
 592 foreach (@found) {
 593     printout($_, $tmp, $filter);
 594 }
 595 page($tmp, $no_tty, @pagers);
 596
 597 safe_exit(0, $tmp, $buffer);
 598
 599 __END__
 600
 601 =head1 NAME
 602
 603 perldoc - Look up Perl documentation in pod format.
 604
 605 =head1 SYNOPSIS
 606
 607 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]  [B<-X>] PageName|ModuleName|ProgramName
 608
 609 B<perldoc> B<-f> BuiltinFunction
 610
 611 B<perldoc> B<-q> FAQ Keyword
 612
 613 =head1 DESCRIPTION
 614
 615 I<perldoc> looks up a piece of documentation in .pod format that is embedded
 616 in the perl installation tree or in a perl script, and displays it via
 617 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
 618 C<col -x> will be used.) This is primarily used for the documentation for
 619 the perl library modules.
 620
 621 Your system may also have man pages installed for those modules, in
 622 which case you can probably just use the man(1) command.
 623
 624 =head1 OPTIONS
 625
 626 =over 5
 627
 628 =item B<-h> help
 629
 630 Prints out a brief help message.
 631
 632 =item B<-v> verbose
 633
 634 Describes search for the item in detail.
 635
 636 =item B<-t> text output
 637
 638 Display docs using plain text converter, instead of nroff. This may be faster,
 639 but it won't look as nice.
 640
 641 =item B<-u> unformatted
 642
 643 Find docs only; skip reformatting by pod2*
 644
 645 =item B<-m> module
 646
 647 Display the entire module: both code and unformatted pod documentation.
 648 This may be useful if the docs don't explain a function in the detail
 649 you need, and you'd like to inspect the code directly; perldoc will find
 650 the file for you and simply hand it off for display.
 651
 652 =item B<-l> file name only
 653
 654 Display the file name of the module found.
 655
 656 =item B<-F> file names
 657
 658 Consider arguments as file names, no search in directories will be performed.
 659
 660 =item B<-f> perlfunc
 661
 662 The B<-f> option followed by the name of a perl built in function will
 663 extract the documentation of this function from L<perlfunc>.
 664
 665 =item B<-q> perlfaq
 666
 667 The B<-q> option takes a regular expression as an argument.  It will search
 668 the question headings in perlfaq[1-9] and print the entries matching
 669 the regular expression.
 670
 671 =item B<-X> use an index if present
 672
 673 The B<-X> option looks for a entry whose basename matches the name given on the
 674 command line in the file C<$Config{archlib}/pod.idx>.  The pod.idx file should
 675 contain fully qualified filenames, one per line.
 676
 677 =item B<PageName|ModuleName|ProgramName>
 678
 679 The item you want to look up.  Nested modules (such as C<File::Basename>)
 680 are specified either as C<File::Basename> or C<File/Basename>.  You may also
 681 give a descriptive name of a page, such as C<perlfunc>. You may also give a
 682 partial or wrong-case name, such as "basename" for "File::Basename", but
 683 this will be slower, if there is more then one page with the same partial
 684 name, you will only get the first one.
 685
 686 =back
 687
 688 =head1 ENVIRONMENT
 689
 690 Any switches in the C<PERLDOC> environment variable will be used before the
 691 command line arguments.  C<perldoc> also searches directories
 692 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
 693 defined) and C<PATH> environment variables.
 694 (The latter is so that embedded pods for executables, such as
 695 C<perldoc> itself, are available.)  C<perldoc> will use, in order of
 696 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
 697 C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
 698 used if C<perldoc> was told to display plain text or unformatted pod.)
 699
 700 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
 701
 702 =head1 VERSION
 703
 704 This is perldoc v2.0.
 705
 706 =head1 AUTHOR
 707
 708 Kenneth Albanowski <kjahds@kjahds.com>
 709
 710 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
 711 and others.
 712
 713 =cut
 714
 715 #
 716 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
 717 #       Charles Wilson <cwilson@ece.gatech.edu>
 718 #       changed /pod/ directory to /pods/ for cygwin
 719 #         to support cygwin/win32
 720 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
 721 #       Robin Barker <rmb1@cise.npl.co.uk>
 722 #       -strict, -w cleanups
 723 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
 724 #       Gurusamy Sarathy <gsar@umich.edu>
 725 #       -doc tweaks for -F and -X options
 726 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
 727 #       Gurusamy Sarathy <gsar@umich.edu>
 728 #       -various fixes for win32
 729 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
 730 #       Kenneth Albanowski <kjahds@kjahds.com>
 731 #   -added Charles Bailey's further VMS patches, and -u switch
 732 #   -added -t switch, with pod2text support
 733 #
 734 # Version 1.10: Thu Nov  9 07:23:47 EST 1995
 735 #               Kenneth Albanowski <kjahds@kjahds.com>
 736 #       -added VMS support
 737 #       -added better error recognition (on no found pages, just exit. On
 738 #        missing nroff/pod2man, just display raw pod.)
 739 #       -added recursive/case-insensitive matching (thanks, Andreas). This
 740 #        slows things down a bit, unfortunately. Give a precise name, and
 741 #        it'll run faster.
 742 #
 743 # Version 1.01: Tue May 30 14:47:34 EDT 1995
 744 #               Andy Dougherty  <doughera@lafcol.lafayette.edu>
 745 #   -added pod documentation.
 746 #   -added PATH searching.
 747 #   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
 748 #    and friends.
 749 #
 750 #
 751 # TODO:
 752 #
 753 #       Cache directories read during sloppy match
 754 !NO!SUBS!
 755
 756 close OUT or die "Can't close $file: $!";
 757 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 758 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 759 chdir $origdir;