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