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