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