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