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