utils/perldoc.PL

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