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