2 eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
8 # make sure creat()s are neither too much nor too little
9 INIT { eval { umask(0077) } } # doubtless someone has no mask
11 (my $pager = <<'/../') =~ s/\s*\z//;
15 push @pagers, $pager if -x
$pager;
17 (my $bindir = <<'/../') =~ s/\s*\z//;
22 use Fcntl
; # for sysopen
25 use File
::Spec
::Functions
qw(catfile splitdir);
28 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
29 # is embedded in the perl installation tree.
31 # This is not to be confused with Tom Christiansen's perlman, which is a
32 # man replacement, written in perl. This perldoc is strictly for reading
33 # the perl manuals, though it too is written in perl.
35 # Massive security and correctness patches applied to this
36 # noisome program by Tom Christiansen Sat Mar 11 15:22:33 MST 2000
39 my $me = $0; # Editing $0 is unportable
42 Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageName|ModuleName|ProgramName
46 The -h option prints more help. Also try "perldoc perldoc" to get
47 acquainted with the system.
51 my @global_found = ();
52 my $global_target = "";
54 my $Is_VMS = $^O
eq 'VMS';
55 my $Is_MSWin32 = $^O
eq 'MSWin32';
56 my $Is_Dos = $^O
eq 'dos';
57 my $Is_OS2 = $^O
eq 'os2';
61 # Erase evidence of previous errors (if any), so exit status is simple.
64 perldoc [options] PageName|ModuleName|ProgramName...
65 perldoc [options] -f BuiltinFunction
66 perldoc [options] -q FAQRegex
69 -h Display this help message
70 -r Recursive search (slow)
72 -t Display pod using pod2text instead of pod2man and nroff
73 (-t is the default on win32)
74 -u Display unformatted pod text
75 -m Display module's file in its entirety
76 -n Specify replacement for nroff
77 -l Display the module's file name
78 -F Arguments are file names, not modules
79 -v Verbosely describe what's going on
80 -X use index if present (looks for pod.idx at $Config{archlib})
81 -q Search the text of questions (not answers) in perlfaq[1-9]
82 -U Run in insecure mode (superuser only)
84 PageName|ModuleName...
85 is the name of a piece of documentation that you want to look at. You
86 may either give a descriptive name of the page (as in the case of
87 `perlfunc') the name of a module, either like `Term::Info',
88 `Term/Info', the partial name of a module, like `info', or
89 `makemaker', or the name of a program, like `perldoc'.
92 is the name of a perl function. Will extract documentation from
96 is a regex. Will search perlfaq[1-9] for and extract any
99 Any switches in the PERLDOC environment variable will be used before the
100 command line arguments. The optional pod index file contains a list of
101 filenames, one per line.
106 if (defined $ENV{"PERLDOC"}) {
107 require Text
::ParseWords
;
108 unshift(@ARGV, Text
::ParseWords
::shellwords
($ENV{"PERLDOC"}));
111 use vars
qw( $opt_m $opt_h $opt_t $opt_l $opt_u $opt_v $opt_r $opt_i $opt_F $opt_f $opt_X $opt_q $opt_n $opt_U );
113 getopts("mhtluvriFf:Xq:n:U") || usage;
117 # refuse to run if we should be tainting and aren't
118 # (but regular users deserve protection too, though!)
119 if (!($Is_VMS || $Is_MSWin32 || $Is_Dos || $Is_OS2) && ($> == 0 || $< == 0)
120 && !am_taint_checking())
123 my $id = eval { getpwnam("nobody") };
124 $id = eval { getpwnam("nouser") } unless defined $id;
125 $id = -2 unless defined $id;
127 $> = $id; # must do this one first!
130 last if !$@ && $< && $>;
132 die "Superuser must not run $0 without security audit and taint checks.\n";
135 $opt_n = "nroff" if !$opt_n;
139 $podidx = "$Config{'archlib'}/pod.idx";
140 $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
143 if ((my $opts = do{ no warnings; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
144 usage("only one of -t, -u, -m or -l")
148 || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
150 $opt_t = 1 unless $opts;
153 if ($opt_t) { require Pod::Text; import Pod::Text; }
157 @pages = ("perlfunc");
160 @pages = ("perlfaq1" .. "perlfaq9");
166 # Does this look like a module or extension directory?
167 if (-f "Makefile.PL") {
169 # Add ., lib to @INC (if they exist)
170 eval q{ use lib qw(. lib); 1; } or die;
172 # don't add if superuser
173 if ($< && $> && -f
"blib") { # don't be looking too hard now!
174 eval q{ use blib; 1 };
175 warn $@
if $@
&& $opt_v;
180 my($file, $readit) = @_;
181 return 1 if !$readit && $file =~ /\.pod\z/i;
183 open(TEST
,"<", $file) or die "Can't open $file: $!";
186 close(TEST
) or die "Can't close $file: $!";
190 close(TEST
) or die "Can't close $file: $!";
196 my $path = catfile
($dir,$file);
197 return $path if -f
$path and -r _
;
198 if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O
eq 'os2') {
199 # on a case-forgiving file system or if case is important
200 # that is it all we can do
201 warn "Ignored $path: unreadable\n" if -f _
;
205 # this is completely wicked. don't mess with $", and if
206 # you do, don't assume / is the dirsep!
210 foreach $p (splitdir $file){
211 my $try = catfile @p, $p;
215 if ( $p eq $global_target) {
216 my $tmp_path = catfile @p;
218 for (@global_found) {
219 $path_f = 1 if $_ eq $tmp_path;
221 push (@global_found, $tmp_path) unless $path_f;
222 print STDERR "Found as
@p but directory
\n" if $opt_v;
225 elsif (-f _ && -r _) {
229 warn "Ignored
$try: unreadable
\n";
234 opendir DIR, "@p" or die "opendir @p: $!";
235 while ($cip=readdir(DIR)) {
236 if (lc $cip eq $lcp){
241 closedir DIR or die "closedir @p: $!";
242 return "" unless $found;
244 return "@p" if -f "@p" and -r _;
245 warn "Ignored
@p: unreadable
\n" if -f _;
254 return "" if length $dir and not -d $dir;
256 return minus_f_nocase($dir,$file);
259 my $path = minus_f_nocase($dir,$file);
260 return $path if length $path and containspod($path);
267 my($recurse,$s,@dirs) = @_;
269 $s = VMS::Filespec::unixify($s) if $Is_VMS;
270 return $s if -f $s && containspod($s);
271 printf STDERR "Looking
for $s in @dirs\n" if $opt_v;
275 $global_target = (splitdir $s)[-1]; # XXX: why not use File::Basename?
276 for ($i=0; $i<@dirs; $i++) {
278 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
279 if ( ( $ret = check_file $dir,"$s.pod
")
280 or ( $ret = check_file $dir,"$s.pm
")
281 or ( $ret = check_file $dir,$s)
283 $ret = check_file $dir,"$s.com
")
284 or ( $^O eq 'os2' and
285 $ret = check_file $dir,"$s.cmd
")
286 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
287 $ret = check_file $dir,"$s.bat
")
288 or ( $ret = check_file "$dir/pod
","$s.pod
")
289 or ( $ret = check_file "$dir/pod
",$s)
290 or ( $ret = check_file "$dir/pods
","$s.pod
")
291 or ( $ret = check_file "$dir/pods
",$s)
297 opendir(D,$dir) or die "Can
't opendir $dir: $!";
298 my @newdirs = map catfile($dir, $_), grep {
300 not /^auto\z/s and # save time! don't search auto dirs
303 closedir(D
) or die "Can't closedir $dir: $!";
304 next unless @newdirs;
306 @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $Is_VMS;
307 print STDERR
"Also looking in @newdirs\n" if $opt_v;
308 push(@dirs,@newdirs);
315 my @data = split /\n{2,}/, shift;
316 shift @data while @data and $data[0] !~ /\S/; # Go to header
317 shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
318 pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
319 # 28/Jan/99 perl 5.005, patch 53 1
324 my ($file, $tmp, $filter) = @_;
328 # why was this append?
329 sysopen(OUT
, $tmp, O_WRONLY
| O_EXCL
| O_CREAT
, 0600)
330 or die ("Can't open $tmp: $!");
331 Pod
::Text
->new()->parse_from_file($file,\
*OUT
);
332 close OUT
or die "can't close $tmp: $!";
335 my $cmd = catfile
($bindir, 'pod2man') . " --lax $file | $opt_n -man";
336 $cmd .= " | col -x" if $^O
=~ /hpux/;
338 $rslt = filter_nroff
($rslt) if $filter;
339 unless (($err = $?
)) {
340 # why was this append?
341 sysopen(TMP
, $tmp, O_WRONLY
| O_EXCL
| O_CREAT
, 0600)
342 or die "Can't open $tmp: $!";
344 or die "Can't print $tmp: $!";
346 or die "Can't close $tmp: $!";
349 if ($opt_u or $err or -z
$tmp) { # XXX: race with -z
350 # why was this append?
351 sysopen(OUT
, $tmp, O_WRONLY
| O_EXCL
| O_CREAT
, 0600)
352 or die "Can't open $tmp: $!";
353 open(IN
,"<", $file) or die("Can't open $file: $!");
357 $cut = $1 eq 'cut' if /^=(\w+)/;
360 or die "Can't print $tmp: $!";
362 close IN
or die "Can't close $file: $!";
363 close OUT
or die "Can't close $tmp: $!";
368 my ($tmp, $no_tty, @pagers) = @_;
370 open(TMP
,"<", $tmp) or die "Can't open $tmp: $!";
373 print or die "Can't print to stdout: $!";
375 close TMP
or die "Can't close while $tmp: $!";
378 foreach my $pager (@pagers) {
380 last if system("$pager $tmp") == 0; # quoting prevents logical expansion
382 last if system("$pager \"$tmp\"") == 0;
392 1 while unlink($_); # XXX: expect failure
394 unlink($_); # or die "Can't unlink $_: $!";
401 if ($podidx && open(PODIDX
, $podidx)) {
402 my $searchfor = catfile
split '::';
403 print STDERR
"Searching for '$searchfor' in $podidx\n" if $opt_v;
407 push(@found, $_) if m
,/$searchfor(?
:\
.(?
:pod
|pm
))?\z
,i
;
409 close(PODIDX
) or die "Can't close $podidx: $!";
412 print STDERR
"Searching for $_\n" if $opt_v;
413 # We must look both in @INC for library modules and in $bindir
414 # for executables, like h2xs or perldoc itself.
415 my @searchdirs = (@INC, $bindir);
418 push @found, $_ if $opt_m or containspod
($_);
424 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
425 push(@searchdirs,$trn);
427 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
430 push(@searchdirs, grep(-d
, split($Config{path_sep
},
434 my @files = searchfor
(0,$_,@searchdirs);
436 print STDERR
"Found as @files\n" if $opt_v;
439 # no match, try recursive search
440 @searchdirs = grep(!/^\.\z/s,@INC);
441 @files= searchfor
(1,$_,@searchdirs) if $opt_r;
443 print STDERR
"Loosely found as @files\n" if $opt_v;
446 print STDERR
"No documentation found for \"$_\".\n";
448 print STDERR
"However, try\n";
449 for my $dir (@global_found) {
450 opendir(DIR
, $dir) or die "opendir $dir: $!";
451 while (my $file = readdir(DIR
)) {
452 next if ($file =~ /^\./s);
453 $file =~ s/\.(pm|pod)\z//; # XXX: badfs
454 print STDERR
"\tperldoc $_\::$file\n";
456 closedir DIR
or die "closedir $dir: $!";
465 exit ($Is_VMS ?
98962 : 1);
469 print join("\n", @found), "\n";
473 my $lines = $ENV{LINES
} || 24;
476 if (! -t STDOUT
) { $no_tty = 1 }
477 END { close(STDOUT
) || die "Can't close STDOUT: $!" }
479 # until here we could simply exit or die
480 # now we create temporary files that we have to clean up
481 # namely $tmp, $buffer
482 # that's because you did it wrong, should be descriptor based --tchrist
487 $tmp = "$ENV{TEMP}\\perldoc1.$$";
488 $buffer = "$ENV{TEMP}\\perldoc1.b$$";
489 push @pagers, qw( more< less notepad );
490 unshift @pagers, $ENV{PAGER
} if $ENV{PAGER
};
491 for (@found) { s
,/,\\,g
}
494 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
495 $buffer = 'Sys$Scratch:perldoc.tmp1_b'.$$;
496 push @pagers, qw( most more less type/page );
499 $tmp = "$ENV{TEMP}/perldoc1.$$";
500 $buffer = "$ENV{TEMP}/perldoc1.b$$";
502 $buffer =~ tr!\\/!//!s;
503 push @pagers, qw( less.exe more.com< );
504 unshift @pagers, $ENV{PAGER
} if $ENV{PAGER
};
509 $tmp = POSIX
::tmpnam
();
510 $buffer = POSIX
::tmpnam
();
511 unshift @pagers, 'less', 'cmd /c more <';
514 # XXX: this is not secure, because it doesn't open it
515 ($tmp, $buffer) = eval { require POSIX
}
516 ?
(POSIX
::tmpnam
(), POSIX
::tmpnam
() )
517 : ("/tmp/perldoc1.$$", "/tmp/perldoc1.b$$" );
519 push @pagers, qw( more less pg view cat );
520 unshift @pagers, $ENV{PAGER
} if $ENV{PAGER
};
522 unshift @pagers, $ENV{PERLDOC_PAGER
} if $ENV{PERLDOC_PAGER
};
524 # make sure cleanup called
526 sub END { cleanup($tmp, $buffer) }
530 # exit/die in a windows sighandler is dangerous, so let it do the
531 # default thing, which is to exit
532 eval q{ use sigtrap qw(die INT TERM HUP QUIT) } unless $^O
eq 'MSWin32';
535 foreach my $pager (@pagers) {
536 if (system($pager, @found) == 0) {
542 use vmsish qw(status exit);
552 my $perlfunc = shift @found;
553 open(PFUNC
, "<", $perlfunc)
554 or die("Can't open $perlfunc: $!");
556 # Functions like -r, -e, etc. are listed under `-X'.
557 my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
563 last if /^=head2 Alphabetical Listing of Perl Functions/;
566 # Look for our function
570 if (/^=item\s+\Q$search_string\E\b/o) {
574 last if $found > 1 and not $inlist;
584 ++$found if /^\w/; # found descriptive text
587 die "No documentation for perl function `$opt_f' found\n";
589 close PFUNC
or die "Can't open $perlfunc: $!";
593 local @ARGV = @found; # I'm lazy, sue me.
596 my $rx = eval { qr/$opt_q/ } or die <<EOD;
597 Invalid regular expression '$opt_q' given as -q pattern:
599 Did you mean \\Q$opt_q ?
603 for (@found) { die "invalid file spec: $!" if /[<>|]/ }
606 if (/^=head2\s+.*(?:$opt_q)/oi) {
608 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
617 die("No documentation for perl FAQ keyword `$opt_q' found\n");
624 sysopen(TMP
, $buffer, O_WRONLY
| O_EXCL
| O_CREAT
)
625 or die("Can't open $buffer: $!");
626 print TMP
"=over 8\n\n";
627 print TMP
@pod or die "Can't print $buffer: $!";
629 close TMP
or die "Can't close $buffer: $!";
635 printout
($_, $tmp, $filter);
637 page
($tmp, $no_tty, @pagers);
643 my $nada = substr($arg, 0, 0); # zero-length
644 local $@
; # preserve caller's version
645 eval { eval "# $nada" };
646 return length($@
) != 0;
649 sub am_taint_checking
{
650 my($k,$v) = each %ENV;
651 return is_tainted
($v);
659 perldoc - Look up Perl documentation in pod format.
663 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
665 B<perldoc> B<-f> BuiltinFunction
667 B<perldoc> B<-q> FAQ Keyword
671 I<perldoc> looks up a piece of documentation in .pod format that is embedded
672 in the perl installation tree or in a perl script, and displays it via
673 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
674 C<col -x> will be used.) This is primarily used for the documentation for
675 the perl library modules.
677 Your system may also have man pages installed for those modules, in
678 which case you can probably just use the man(1) command.
686 Prints out a brief help message.
690 Describes search for the item in detail.
692 =item B<-t> text output
694 Display docs using plain text converter, instead of nroff. This may be faster,
695 but it won't look as nice.
697 =item B<-u> unformatted
699 Find docs only; skip reformatting by pod2*
703 Display the entire module: both code and unformatted pod documentation.
704 This may be useful if the docs don't explain a function in the detail
705 you need, and you'd like to inspect the code directly; perldoc will find
706 the file for you and simply hand it off for display.
708 =item B<-l> file name only
710 Display the file name of the module found.
712 =item B<-F> file names
714 Consider arguments as file names, no search in directories will be performed.
718 The B<-f> option followed by the name of a perl built in function will
719 extract the documentation of this function from L<perlfunc>.
723 The B<-q> option takes a regular expression as an argument. It will search
724 the question headings in perlfaq[1-9] and print the entries matching
725 the regular expression.
727 =item B<-X> use an index if present
729 The B<-X> option looks for a entry whose basename matches the name given on the
730 command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
731 contain fully qualified filenames, one per line.
733 =item B<-U> run insecurely
735 Because B<perldoc> does not run properly tainted, and is known to
736 have security issues, it will not normally execute as the superuser.
737 If you use the B<-U> flag, it will do so, but only after setting
738 the effective and real IDs to nobody's or nouser's account, or -2
739 if unavailable. If it cannot relinguish its privileges, it will not
742 =item B<PageName|ModuleName|ProgramName>
744 The item you want to look up. Nested modules (such as C<File::Basename>)
745 are specified either as C<File::Basename> or C<File/Basename>. You may also
746 give a descriptive name of a page, such as C<perlfunc>. You may also give a
747 partial or wrong-case name, such as "basename" for "File::Basename", but
748 this will be slower, if there is more then one page with the same partial
749 name, you will only get the first one.
755 Any switches in the C<PERLDOC> environment variable will be used before the
756 command line arguments. C<perldoc> also searches directories
757 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
758 defined) and C<PATH> environment variables.
759 (The latter is so that embedded pods for executables, such as
760 C<perldoc> itself, are available.) C<perldoc> will use, in order of
761 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
762 C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
763 used if C<perldoc> was told to display plain text or unformatted pod.)
765 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
769 This is perldoc v2.03.
773 Kenneth Albanowski <kjahds@kjahds.com>
775 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
781 # Version 2.03: Sun Apr 23 16:56:34 BST 2000
782 # Hugo van der Sanden <hv@crypt0.demon.co.uk>
783 # don't die when 'use blib' fails
784 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
785 # Tom Christiansen <tchrist@perl.com>
786 # Added -U insecurity option
787 # Version 2.01: Sat Mar 11 15:22:33 MST 2000
788 # Tom Christiansen <tchrist@perl.com>, querulously.
789 # Security and correctness patches.
790 # What a twisted bit of distasteful spaghetti code.
792 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
793 # Charles Wilson <cwilson@ece.gatech.edu>
794 # changed /pod/ directory to /pods/ for cygwin
795 # to support cygwin/win32
796 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
797 # Robin Barker <rmb1@cise.npl.co.uk>
798 # -strict, -w cleanups
799 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
800 # Gurusamy Sarathy <gsar@activestate.com>
801 # -doc tweaks for -F and -X options
802 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
803 # Gurusamy Sarathy <gsar@activestate.com>
804 # -various fixes for win32
805 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
806 # Kenneth Albanowski <kjahds@kjahds.com>
807 # -added Charles Bailey's further VMS patches, and -u switch
808 # -added -t switch, with pod2text support
810 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
811 # Kenneth Albanowski <kjahds@kjahds.com>
813 # -added better error recognition (on no found pages, just exit. On
814 # missing nroff/pod2man, just display raw pod.)
815 # -added recursive/case-insensitive matching (thanks, Andreas). This
816 # slows things down a bit, unfortunately. Give a precise name, and
819 # Version 1.01: Tue May 30 14:47:34 EDT 1995
820 # Andy Dougherty <doughera@lafcol.lafayette.edu>
821 # -added pod documentation.
822 # -added PATH searching.
823 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
829 # Cache directories read during sloppy match