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