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