4 use File::Basename qw(&basename &dirname);
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
12 # to ensure Configure will look for $Config{startperl}.
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.
18 $file = basename($0, '.PL');
19 $file .= '.com' if $^O eq 'VMS';
21 open OUT,">$file" or die "Can't create $file: $!";
23 print "Extracting $file (with variable substitutions)\n";
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
28 print OUT <<"!GROK!THIS!";
30 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
36 # make sure creat()s are neither too much nor too little
37 INIT { eval { umask(0077) } } # doubtless someone has no mask
39 (my \$pager = <<'/../') =~ s/\\s*\\z//;
43 push \@pagers, \$pager if -x \$pager;
45 (my \$bindir = <<'/../') =~ s/\\s*\\z//;
51 # In the following, perl variables are not expanded during extraction.
53 print OUT <<'!NO!SUBS!';
55 use Fcntl; # for sysopen
58 use File::Spec::Functions qw(catfile splitdir);
61 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
62 # is embedded in the perl installation tree.
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.
68 # Massive security and correctness patches applied to this
69 # noisome program by Tom Christiansen Sat Mar 11 15:22:33 MST 2000
72 my $me = $0; # Editing $0 is unportable
75 Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageName|ModuleName|ProgramName
79 The -h option prints more help. Also try "perldoc perldoc" to get
80 acquainted with the system.
84 my @global_found = ();
85 my $global_target = "";
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';
94 # Erase evidence of previous errors (if any), so exit status is simple.
97 perldoc [options] PageName|ModuleName|ProgramName...
98 perldoc [options] -f BuiltinFunction
99 perldoc [options] -q FAQRegex
102 -h Display this help message
103 -r Recursive search (slow)
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)
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'.
125 is the name of a perl function. Will extract documentation from
129 is a regex. Will search perlfaq[1-9] for and extract any
130 questions that match.
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.
139 if (defined $ENV{"PERLDOC"}) {
140 require Text::ParseWords;
141 unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
145 my $getopts = "mhtluvriFf:Xq:n:U";
146 print OUT <<"!GET!OPTS!";
148 use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
150 getopts("$getopts") || usage;
153 print OUT <<'!NO!SUBS!';
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())
163 my $id = eval { getpwnam("nobody") };
164 $id = eval { getpwnam("nouser") } unless defined $id;
165 $id = -2 unless defined $id;
167 $> = $id; # must do this one first!
170 last if !$@ && $< && $>;
172 die "Superuser must not run $0 without security audit and taint checks.\n";
175 $opt_n = "nroff" if !$opt_n;
179 $podidx = "$Config{'archlib'}/pod.idx";
180 $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
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")
188 || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
190 $opt_t = 1 unless $opts;
193 if ($opt_t) { require Pod::Text; import Pod::Text; }
197 @pages = ("perlfunc");
200 @pages = ("perlfaq1" .. "perlfaq9");
206 # Does this look like a module or extension directory?
207 if (-f "Makefile.PL") {
209 # Add ., lib to @INC (if they exist)
210 eval q{ use lib qw(. lib); 1; } or die;
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;
220 my($file, $readit) = @_;
221 return 1 if !$readit && $file =~ /\.pod\z/i;
223 open(TEST,"<", $file) or die "Can't open $file: $!";
226 close(TEST) or die "Can't close $file: $!";
230 close(TEST) or die "Can't close $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 _;
245 # this is completely wicked. don't mess with $", and if
246 # you do, don't assume / is the dirsep!
250 foreach $p (splitdir $file){
251 my $try = catfile @p, $p;
255 if ( $p eq $global_target) {
256 my $tmp_path = catfile @p;
258 for (@global_found) {
259 $path_f = 1 if $_ eq $tmp_path;
261 push (@global_found, $tmp_path) unless $path_f;
262 print STDERR "Found as @p but directory\n" if $opt_v;
265 elsif (-f _ && -r _) {
269 warn "Ignored $try: unreadable\n";
274 opendir DIR, "@p" or die "opendir @p: $!";
275 while ($cip=readdir(DIR)) {
276 if (lc $cip eq $lcp){
281 closedir DIR or die "closedir @p: $!";
282 return "" unless $found;
284 return "@p" if -f "@p" and -r _;
285 warn "Ignored @p: unreadable\n" if -f _;
294 return "" if length $dir and not -d $dir;
296 return minus_f_nocase($dir,$file);
299 my $path = minus_f_nocase($dir,$file);
300 return $path if length $path and containspod($path);
307 my($recurse,$s,@dirs) = @_;
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;
315 $global_target = (splitdir $s)[-1]; # XXX: why not use File::Basename?
316 for ($i=0; $i<@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)
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)
337 opendir(D,$dir) or die "Can't opendir $dir: $!";
338 my @newdirs = map catfile($dir, $_), grep {
340 not /^auto\z/s and # save time! don't search auto dirs
343 closedir(D) or die "Can't closedir $dir: $!";
344 next unless @newdirs;
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);
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
364 my ($tmp, $no_tty, @pagers) = @_;
366 open(TMP,"<", $tmp) or die "Can't open $tmp: $!";
369 print or die "Can't print to stdout: $!";
371 close TMP or die "Can't close while $tmp: $!";
374 foreach my $pager (@pagers) {
376 last if system("$pager $tmp") == 0; # quoting prevents logical expansion
378 last if system("$pager \"$tmp\"") == 0;
389 1 while unlink($_); # XXX: expect failure
391 unlink($_); # or die "Can't unlink $_: $!";
398 if ($podidx && open(PODIDX, $podidx)) {
399 my $searchfor = catfile split '::';
400 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
404 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
406 close(PODIDX) or die "Can't close $podidx: $!";
409 print STDERR "Searching for $_\n" if $opt_v;
412 push @found, $_ if $opt_m or containspod($_);
415 # We must look both in @INC for library modules and in $bindir
416 # for executables, like h2xs or perldoc itself.
417 my @searchdirs = ($bindir, @INC);
421 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
422 push(@searchdirs,$trn);
424 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
427 push(@searchdirs, grep(-d, split($Config{path_sep},
431 my @files = searchfor(0,$_,@searchdirs);
433 print STDERR "Found as @files\n" if $opt_v;
436 # no match, try recursive search
437 @searchdirs = grep(!/^\.\z/s,@INC);
438 @files= searchfor(1,$_,@searchdirs) if $opt_r;
440 print STDERR "Loosely found as @files\n" if $opt_v;
443 print STDERR "No documentation found for \"$_\".\n";
445 print STDERR "However, try\n";
446 for my $dir (@global_found) {
447 opendir(DIR, $dir) or die "opendir $dir: $!";
448 while (my $file = readdir(DIR)) {
449 next if ($file =~ /^\./s);
450 $file =~ s/\.(pm|pod)\z//; # XXX: badfs
451 print STDERR "\tperldoc $_\::$file\n";
453 closedir DIR or die "closedir $dir: $!";
462 exit ($Is_VMS ? 98962 : 1);
466 print join("\n", @found), "\n";
470 my $lines = $ENV{LINES} || 24;
473 if (! -t STDOUT) { $no_tty = 1 }
474 END { close(STDOUT) || die "Can't close STDOUT: $!" }
477 push @pagers, qw( more< less notepad );
478 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
479 for (@found) { s,/,\\,g }
482 push @pagers, qw( most more less type/page );
485 push @pagers, qw( less.exe more.com< );
486 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
490 unshift @pagers, 'less', 'cmd /c more <';
492 push @pagers, qw( more less pg view cat );
493 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
495 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
498 foreach my $pager (@pagers) {
499 if (system($pager, @found) == 0) {
505 use vmsish qw(status exit);
515 my $perlfunc = shift @found;
516 open(PFUNC, "<", $perlfunc)
517 or die("Can't open $perlfunc: $!");
519 # Functions like -r, -e, etc. are listed under `-X'.
520 my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
526 last if /^=head2 Alphabetical Listing of Perl Functions/;
529 # Look for our function
533 if (/^=item\s+\Q$search_string\E\b/o) {
537 last if $found > 1 and not $inlist;
547 ++$found if /^\w/; # found descriptive text
550 die "No documentation for perl function `$opt_f' found\n";
552 close PFUNC or die "Can't open $perlfunc: $!";
556 local @ARGV = @found; # I'm lazy, sue me.
559 my $rx = eval { qr/$opt_q/ } or die <<EOD;
560 Invalid regular expression '$opt_q' given as -q pattern:
562 Did you mean \\Q$opt_q ?
566 for (@found) { die "invalid file spec: $!" if /[<>|]/ }
569 if (/^=head2\s+.*(?:$opt_q)/oi) {
571 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
580 die("No documentation for perl FAQ keyword `$opt_q' found\n");
584 # until here we could simply exit or die
585 # now we create temporary files that we have to clean up
586 # namely $tmp, $buffer
587 # that's because you did it wrong, should be descriptor based --tchrist
595 ($tmpfd, $tmp) = File::Temp::tempfile();
597 # make sure cleanup called
599 sub END { cleanup($tmp, $buffer) }
603 # exit/die in a windows sighandler is dangerous, so let it do the
604 # default thing, which is to exit
605 eval q{ use sigtrap qw(die INT TERM HUP QUIT) } unless $^O eq 'MSWin32';
611 ($buffd, $buffer) = File::Temp::tempfile();
612 print $buffd "=over 8\n\n";
613 print $buffd @pod or die "Can't print $buffer: $!";
614 print $buffd "=back\n";
615 close $buffd or die "Can't close $buffer: $!";
625 Pod::Text->new()->parse_from_file($file, $tmpfd);
628 my $cmd = catfile($bindir, 'pod2man') . " --lax $file | $opt_n -man";
629 $cmd .= " | col -x" if $^O =~ /hpux/;
631 $rslt = filter_nroff($rslt) if $filter;
632 unless (($err = $?)) {
634 or die "Can't print $tmp: $!";
637 if ($opt_u or $err) {
638 open(IN,"<", $file) or die("Can't open $file: $!");
642 $cut = $1 eq 'cut' if /^=(\w+)/;
645 or die "Can't print $tmp: $!";
647 close IN or die "Can't close $file: $!";
651 or die "Can't close $tmp: $!";
652 page($tmp, $no_tty, @pagers);
658 my $nada = substr($arg, 0, 0); # zero-length
659 local $@; # preserve caller's version
660 eval { eval "# $nada" };
661 return length($@) != 0;
664 sub am_taint_checking {
665 my($k,$v) = each %ENV;
666 return is_tainted($v);
674 perldoc - Look up Perl documentation in pod format.
678 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
680 B<perldoc> B<-f> BuiltinFunction
682 B<perldoc> B<-q> FAQ Keyword
686 I<perldoc> looks up a piece of documentation in .pod format that is embedded
687 in the perl installation tree or in a perl script, and displays it via
688 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
689 C<col -x> will be used.) This is primarily used for the documentation for
690 the perl library modules.
692 Your system may also have man pages installed for those modules, in
693 which case you can probably just use the man(1) command.
701 Prints out a brief help message.
705 Describes search for the item in detail.
707 =item B<-t> text output
709 Display docs using plain text converter, instead of nroff. This may be faster,
710 but it won't look as nice.
712 =item B<-u> unformatted
714 Find docs only; skip reformatting by pod2*
718 Display the entire module: both code and unformatted pod documentation.
719 This may be useful if the docs don't explain a function in the detail
720 you need, and you'd like to inspect the code directly; perldoc will find
721 the file for you and simply hand it off for display.
723 =item B<-l> file name only
725 Display the file name of the module found.
727 =item B<-F> file names
729 Consider arguments as file names, no search in directories will be performed.
733 The B<-f> option followed by the name of a perl built in function will
734 extract the documentation of this function from L<perlfunc>.
738 The B<-q> option takes a regular expression as an argument. It will search
739 the question headings in perlfaq[1-9] and print the entries matching
740 the regular expression.
742 =item B<-X> use an index if present
744 The B<-X> option looks for a entry whose basename matches the name given on the
745 command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
746 contain fully qualified filenames, one per line.
748 =item B<-U> run insecurely
750 Because B<perldoc> does not run properly tainted, and is known to
751 have security issues, it will not normally execute as the superuser.
752 If you use the B<-U> flag, it will do so, but only after setting
753 the effective and real IDs to nobody's or nouser's account, or -2
754 if unavailable. If it cannot relinguish its privileges, it will not
757 =item B<PageName|ModuleName|ProgramName>
759 The item you want to look up. Nested modules (such as C<File::Basename>)
760 are specified either as C<File::Basename> or C<File/Basename>. You may also
761 give a descriptive name of a page, such as C<perlfunc>. You may also give a
762 partial or wrong-case name, such as "basename" for "File::Basename", but
763 this will be slower, if there is more then one page with the same partial
764 name, you will only get the first one.
770 Any switches in the C<PERLDOC> environment variable will be used before the
771 command line arguments. C<perldoc> also searches directories
772 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
773 defined) and C<PATH> environment variables.
774 (The latter is so that embedded pods for executables, such as
775 C<perldoc> itself, are available.) C<perldoc> will use, in order of
776 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
777 C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
778 used if C<perldoc> was told to display plain text or unformatted pod.)
780 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
784 This is perldoc v2.03.
788 Kenneth Albanowski <kjahds@kjahds.com>
790 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
796 # Version 2.03: Sun Apr 23 16:56:34 BST 2000
797 # Hugo van der Sanden <hv@crypt0.demon.co.uk>
798 # don't die when 'use blib' fails
799 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
800 # Tom Christiansen <tchrist@perl.com>
801 # Added -U insecurity option
802 # Version 2.01: Sat Mar 11 15:22:33 MST 2000
803 # Tom Christiansen <tchrist@perl.com>, querulously.
804 # Security and correctness patches.
805 # What a twisted bit of distasteful spaghetti code.
807 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
808 # Charles Wilson <cwilson@ece.gatech.edu>
809 # changed /pod/ directory to /pods/ for cygwin
810 # to support cygwin/win32
811 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
812 # Robin Barker <rmb1@cise.npl.co.uk>
813 # -strict, -w cleanups
814 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
815 # Gurusamy Sarathy <gsar@activestate.com>
816 # -doc tweaks for -F and -X options
817 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
818 # Gurusamy Sarathy <gsar@activestate.com>
819 # -various fixes for win32
820 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
821 # Kenneth Albanowski <kjahds@kjahds.com>
822 # -added Charles Bailey's further VMS patches, and -u switch
823 # -added -t switch, with pod2text support
825 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
826 # Kenneth Albanowski <kjahds@kjahds.com>
828 # -added better error recognition (on no found pages, just exit. On
829 # missing nroff/pod2man, just display raw pod.)
830 # -added recursive/case-insensitive matching (thanks, Andreas). This
831 # slows things down a bit, unfortunately. Give a precise name, and
834 # Version 1.01: Tue May 30 14:47:34 EDT 1995
835 # Andy Dougherty <doughera@lafcol.lafayette.edu>
836 # -added pod documentation.
837 # -added PATH searching.
838 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
844 # Cache directories read during sloppy match
847 close OUT or die "Can't close $file: $!";
848 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
849 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';