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