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 # On VMS, quoting prevents logical expansion, and temp files with no
375 # extension get the wrong default extension (such as .LIS for TYPE)
377 $tmp = VMS::Filespec::rmsexpand($tmp, '.') if ($Is_VMS);
378 foreach my $pager (@pagers) {
380 last if system("$pager $tmp") == 0;
382 last if system("$pager \"$tmp\"") == 0;
393 1 while unlink($_); # XXX: expect failure
395 unlink($_); # or die "Can't unlink $_: $!";
402 if ($podidx && open(PODIDX, $podidx)) {
403 my $searchfor = catfile split '::';
404 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
408 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
410 close(PODIDX) or die "Can't close $podidx: $!";
413 print STDERR "Searching for $_\n" if $opt_v;
416 push @found, $_ if $opt_m or containspod($_);
419 # We must look both in @INC for library modules and in $bindir
420 # for executables, like h2xs or perldoc itself.
421 my @searchdirs = ($bindir, @INC);
425 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
426 push(@searchdirs,$trn);
428 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
431 push(@searchdirs, grep(-d, split($Config{path_sep},
435 my @files = searchfor(0,$_,@searchdirs);
437 print STDERR "Found as @files\n" if $opt_v;
440 # no match, try recursive search
441 @searchdirs = grep(!/^\.\z/s,@INC);
442 @files= searchfor(1,$_,@searchdirs) if $opt_r;
444 print STDERR "Loosely found as @files\n" if $opt_v;
447 print STDERR "No documentation found for \"$_\".\n";
449 print STDERR "However, try\n";
450 for my $dir (@global_found) {
451 opendir(DIR, $dir) or die "opendir $dir: $!";
452 while (my $file = readdir(DIR)) {
453 next if ($file =~ /^\./s);
454 $file =~ s/\.(pm|pod)\z//; # XXX: badfs
455 print STDERR "\tperldoc $_\::$file\n";
457 closedir DIR or die "closedir $dir: $!";
466 exit ($Is_VMS ? 98962 : 1);
470 print join("\n", @found), "\n";
474 my $lines = $ENV{LINES} || 24;
477 if (! -t STDOUT) { $no_tty = 1 }
478 END { close(STDOUT) || die "Can't close STDOUT: $!" }
481 push @pagers, qw( more< less notepad );
482 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
483 for (@found) { s,/,\\,g }
486 push @pagers, qw( most more less type/page );
489 push @pagers, qw( less.exe more.com< );
490 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
494 unshift @pagers, 'less', 'cmd /c more <';
496 push @pagers, qw( more less pg view cat );
497 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
499 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
502 foreach my $pager (@pagers) {
503 if (system($pager, @found) == 0) {
509 use vmsish qw(status exit);
519 my $perlfunc = shift @found;
520 open(PFUNC, "<", $perlfunc)
521 or die("Can't open $perlfunc: $!");
523 # Functions like -r, -e, etc. are listed under `-X'.
524 my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
530 last if /^=head2 Alphabetical Listing of Perl Functions/;
533 # Look for our function
537 if (/^=item\s+\Q$search_string\E\b/o) {
541 last if $found > 1 and not $inlist;
551 ++$found if /^\w/; # found descriptive text
554 die "No documentation for perl function `$opt_f' found\n";
556 close PFUNC or die "Can't open $perlfunc: $!";
560 local @ARGV = @found; # I'm lazy, sue me.
563 my $rx = eval { qr/$opt_q/ } or die <<EOD;
564 Invalid regular expression '$opt_q' given as -q pattern:
566 Did you mean \\Q$opt_q ?
570 for (@found) { die "invalid file spec: $!" if /[<>|]/ }
573 if (/^=head2\s+.*(?:$opt_q)/oi) {
575 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
584 die("No documentation for perl FAQ keyword `$opt_q' found\n");
588 # until here we could simply exit or die
589 # now we create temporary files that we have to clean up
590 # namely $tmp, $buffer
591 # that's because you did it wrong, should be descriptor based --tchrist
599 ($tmpfd, $tmp) = File::Temp::tempfile();
601 # make sure cleanup called
603 sub END { cleanup($tmp, $buffer) }
607 # exit/die in a windows sighandler is dangerous, so let it do the
608 # default thing, which is to exit
609 eval q{ use sigtrap qw(die INT TERM HUP QUIT) } unless $^O eq 'MSWin32';
615 ($buffd, $buffer) = File::Temp::tempfile();
616 print $buffd "=over 8\n\n";
617 print $buffd @pod or die "Can't print $buffer: $!";
618 print $buffd "=back\n";
619 close $buffd or die "Can't close $buffer: $!";
629 Pod::Text->new()->parse_from_file($file, $tmpfd);
632 my $cmd = catfile($bindir, 'pod2man') . " --lax $file | $opt_n -man";
633 $cmd .= " | col -x" if $^O =~ /hpux/;
635 $rslt = filter_nroff($rslt) if $filter;
636 unless (($err = $?)) {
638 or die "Can't print $tmp: $!";
641 if ($opt_u or $err) {
642 open(IN,"<", $file) or die("Can't open $file: $!");
646 $cut = $1 eq 'cut' if /^=(\w+)/;
649 or die "Can't print $tmp: $!";
651 close IN or die "Can't close $file: $!";
655 or die "Can't close $tmp: $!";
656 page($tmp, $no_tty, @pagers);
662 my $nada = substr($arg, 0, 0); # zero-length
663 local $@; # preserve caller's version
664 eval { eval "# $nada" };
665 return length($@) != 0;
668 sub am_taint_checking {
669 my($k,$v) = each %ENV;
670 return is_tainted($v);
678 perldoc - Look up Perl documentation in pod format.
682 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
684 B<perldoc> B<-f> BuiltinFunction
686 B<perldoc> B<-q> FAQ Keyword
690 I<perldoc> looks up a piece of documentation in .pod format that is embedded
691 in the perl installation tree or in a perl script, and displays it via
692 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
693 C<col -x> will be used.) This is primarily used for the documentation for
694 the perl library modules.
696 Your system may also have man pages installed for those modules, in
697 which case you can probably just use the man(1) command.
705 Prints out a brief help message.
709 Describes search for the item in detail.
711 =item B<-t> text output
713 Display docs using plain text converter, instead of nroff. This may be faster,
714 but it won't look as nice.
716 =item B<-u> unformatted
718 Find docs only; skip reformatting by pod2*
722 Display the entire module: both code and unformatted pod documentation.
723 This may be useful if the docs don't explain a function in the detail
724 you need, and you'd like to inspect the code directly; perldoc will find
725 the file for you and simply hand it off for display.
727 =item B<-l> file name only
729 Display the file name of the module found.
731 =item B<-F> file names
733 Consider arguments as file names, no search in directories will be performed.
737 The B<-f> option followed by the name of a perl built in function will
738 extract the documentation of this function from L<perlfunc>.
742 The B<-q> option takes a regular expression as an argument. It will search
743 the question headings in perlfaq[1-9] and print the entries matching
744 the regular expression.
746 =item B<-X> use an index if present
748 The B<-X> option looks for a entry whose basename matches the name given on the
749 command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
750 contain fully qualified filenames, one per line.
752 =item B<-U> run insecurely
754 Because B<perldoc> does not run properly tainted, and is known to
755 have security issues, it will not normally execute as the superuser.
756 If you use the B<-U> flag, it will do so, but only after setting
757 the effective and real IDs to nobody's or nouser's account, or -2
758 if unavailable. If it cannot relinguish its privileges, it will not
761 =item B<PageName|ModuleName|ProgramName>
763 The item you want to look up. Nested modules (such as C<File::Basename>)
764 are specified either as C<File::Basename> or C<File/Basename>. You may also
765 give a descriptive name of a page, such as C<perlfunc>. You may also give a
766 partial or wrong-case name, such as "basename" for "File::Basename", but
767 this will be slower, if there is more then one page with the same partial
768 name, you will only get the first one.
774 Any switches in the C<PERLDOC> environment variable will be used before the
775 command line arguments. C<perldoc> also searches directories
776 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
777 defined) and C<PATH> environment variables.
778 (The latter is so that embedded pods for executables, such as
779 C<perldoc> itself, are available.) C<perldoc> will use, in order of
780 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
781 C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
782 used if C<perldoc> was told to display plain text or unformatted pod.)
784 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
788 This is perldoc v2.03.
792 Kenneth Albanowski <kjahds@kjahds.com>
794 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
800 # Version 2.03: Sun Apr 23 16:56:34 BST 2000
801 # Hugo van der Sanden <hv@crypt0.demon.co.uk>
802 # don't die when 'use blib' fails
803 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
804 # Tom Christiansen <tchrist@perl.com>
805 # Added -U insecurity option
806 # Version 2.01: Sat Mar 11 15:22:33 MST 2000
807 # Tom Christiansen <tchrist@perl.com>, querulously.
808 # Security and correctness patches.
809 # What a twisted bit of distasteful spaghetti code.
811 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
812 # Charles Wilson <cwilson@ece.gatech.edu>
813 # changed /pod/ directory to /pods/ for cygwin
814 # to support cygwin/win32
815 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
816 # Robin Barker <rmb1@cise.npl.co.uk>
817 # -strict, -w cleanups
818 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
819 # Gurusamy Sarathy <gsar@activestate.com>
820 # -doc tweaks for -F and -X options
821 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
822 # Gurusamy Sarathy <gsar@activestate.com>
823 # -various fixes for win32
824 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
825 # Kenneth Albanowski <kjahds@kjahds.com>
826 # -added Charles Bailey's further VMS patches, and -u switch
827 # -added -t switch, with pod2text support
829 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
830 # Kenneth Albanowski <kjahds@kjahds.com>
832 # -added better error recognition (on no found pages, just exit. On
833 # missing nroff/pod2man, just display raw pod.)
834 # -added recursive/case-insensitive matching (thanks, Andreas). This
835 # slows things down a bit, unfortunately. Give a precise name, and
838 # Version 1.01: Tue May 30 14:47:34 EDT 1995
839 # Andy Dougherty <doughera@lafcol.lafayette.edu>
840 # -added pod documentation.
841 # -added PATH searching.
842 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
848 # Cache directories read during sloppy match
851 close OUT or die "Can't close $file: $!";
852 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
853 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';