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