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