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 my $versiononly = $Config{versiononly} ? $Config{version} : '';
30 print OUT <<"!GROK!THIS!";
32 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
38 # make sure creat()s are neither too much nor too little
39 INIT { eval { umask(0077) } } # doubtless someone has no mask
41 (my \$pager = <<'/../') =~ s/\\s*\\z//;
45 push \@pagers, \$pager if -x \$pager;
47 (my \$bindir = <<'/../') =~ s/\\s*\\z//;
51 (my \$pod2man = <<'/../') =~ s/\\s*\\z//;
57 # In the following, perl variables are not expanded during extraction.
59 print OUT <<'!NO!SUBS!';
61 use Fcntl; # for sysopen
64 use File::Spec::Functions qw(catfile splitdir);
67 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
68 # is embedded in the perl installation tree.
70 # This is not to be confused with Tom Christiansen's perlman, which is a
71 # man replacement, written in perl. This perldoc is strictly for reading
72 # the perl manuals, though it too is written in perl.
74 # Massive security and correctness patches applied to this
75 # noisome program by Tom Christiansen Sat Mar 11 15:22:33 MST 2000
78 my $me = $0; # Editing $0 is unportable
81 Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageName|ModuleName|ProgramName
85 The -h option prints more help. Also try "perldoc perldoc" to get
86 acquainted with the system.
90 my @global_found = ();
91 my $global_target = "";
93 my $Is_VMS = $^O eq 'VMS';
94 my $Is_MSWin32 = $^O eq 'MSWin32';
95 my $Is_Dos = $^O eq 'dos';
96 my $Is_OS2 = $^O eq 'os2';
100 # Erase evidence of previous errors (if any), so exit status is simple.
103 perldoc [options] PageName|ModuleName|ProgramName...
104 perldoc [options] -f BuiltinFunction
105 perldoc [options] -q FAQRegex
108 -h Display this help message
109 -r Recursive search (slow)
111 -t Display pod using pod2text instead of pod2man and nroff
112 (-t is the default on win32)
113 -u Display unformatted pod text
114 -m Display module's file in its entirety
115 -n Specify replacement for nroff
116 -l Display the module's file name
117 -F Arguments are file names, not modules
118 -v Verbosely describe what's going on
119 -X use index if present (looks for pod.idx at $Config{archlib})
120 -q Search the text of questions (not answers) in perlfaq[1-9]
121 -U Run in insecure mode (superuser only)
123 PageName|ModuleName...
124 is the name of a piece of documentation that you want to look at. You
125 may either give a descriptive name of the page (as in the case of
126 `perlfunc') the name of a module, either like `Term::Info',
127 `Term/Info', the partial name of a module, like `info', or
128 `makemaker', or the name of a program, like `perldoc'.
131 is the name of a perl function. Will extract documentation from
135 is a regex. Will search perlfaq[1-9] for and extract any
136 questions that match.
138 Any switches in the PERLDOC environment variable will be used before the
139 command line arguments. The optional pod index file contains a list of
140 filenames, one per line.
145 if (defined $ENV{"PERLDOC"}) {
146 require Text::ParseWords;
147 unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
151 my $getopts = "mhtluvriFf:Xq:n:U";
152 print OUT <<"!GET!OPTS!";
154 use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
156 getopts("$getopts") || usage;
159 print OUT <<'!NO!SUBS!';
163 # refuse to run if we should be tainting and aren't
164 # (but regular users deserve protection too, though!)
165 if (!($Is_VMS || $Is_MSWin32 || $Is_Dos || $Is_OS2) && ($> == 0 || $< == 0)
166 && !am_taint_checking())
169 my $id = eval { getpwnam("nobody") };
170 $id = eval { getpwnam("nouser") } unless defined $id;
171 $id = -2 unless defined $id;
173 $> = $id; # must do this one first!
176 last if !$@ && $< && $>;
178 die "Superuser must not run $0 without security audit and taint checks.\n";
181 $opt_n = "nroff" if !$opt_n;
185 $podidx = "$Config{'archlib'}/pod.idx";
186 $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
189 if ((my $opts = do{ no warnings; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
190 usage("only one of -t, -u, -m or -l")
194 || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
196 $opt_t = 1 unless $opts;
199 if ($opt_t) { require Pod::Text; import Pod::Text; }
203 @pages = ("perlfunc");
206 @pages = ("perlfaq1" .. "perlfaq9");
212 # Does this look like a module or extension directory?
213 if (-f "Makefile.PL") {
215 # Add ., lib to @INC (if they exist)
216 eval q{ use lib qw(. lib); 1; } or die;
218 # don't add if superuser
219 if ($< && $> && -f "blib") { # don't be looking too hard now!
220 eval q{ use blib; 1 };
221 warn $@ if $@ && $opt_v;
226 my($file, $readit) = @_;
227 return 1 if !$readit && $file =~ /\.pod\z/i;
229 open(TEST,"<", $file) or die "Can't open $file: $!";
232 close(TEST) or die "Can't close $file: $!";
236 close(TEST) or die "Can't close $file: $!";
242 my $path = catfile($dir,$file);
243 return $path if -f $path and -r _;
244 if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
245 # on a case-forgiving file system or if case is important
246 # that is it all we can do
247 warn "Ignored $path: unreadable\n" if -f _;
251 # this is completely wicked. don't mess with $", and if
252 # you do, don't assume / is the dirsep!
256 foreach $p (splitdir $file){
257 my $try = catfile @p, $p;
261 if ( $p eq $global_target) {
262 my $tmp_path = catfile @p;
264 for (@global_found) {
265 $path_f = 1 if $_ eq $tmp_path;
267 push (@global_found, $tmp_path) unless $path_f;
268 print STDERR "Found as @p but directory\n" if $opt_v;
271 elsif (-f _ && -r _) {
275 warn "Ignored $try: unreadable\n";
280 opendir DIR, "@p" or die "opendir @p: $!";
281 while ($cip=readdir(DIR)) {
282 if (lc $cip eq $lcp){
287 closedir DIR or die "closedir @p: $!";
288 return "" unless $found;
290 return "@p" if -f "@p" and -r _;
291 warn "Ignored @p: unreadable\n" if -f _;
300 return "" if length $dir and not -d $dir;
302 return minus_f_nocase($dir,$file);
305 my $path = minus_f_nocase($dir,$file);
306 return $path if length $path and containspod($path);
313 my($recurse,$s,@dirs) = @_;
315 $s = VMS::Filespec::unixify($s) if $Is_VMS;
316 return $s if -f $s && containspod($s);
317 printf STDERR "Looking for $s in @dirs\n" if $opt_v;
321 $global_target = (splitdir $s)[-1]; # XXX: why not use File::Basename?
322 for ($i=0; $i<@dirs; $i++) {
324 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
325 if ( ( $ret = check_file $dir,"$s.pod")
326 or ( $ret = check_file $dir,"$s.pm")
327 or ( $ret = check_file $dir,$s)
329 $ret = check_file $dir,"$s.com")
330 or ( $^O eq 'os2' and
331 $ret = check_file $dir,"$s.cmd")
332 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
333 $ret = check_file $dir,"$s.bat")
334 or ( $ret = check_file "$dir/pod","$s.pod")
335 or ( $ret = check_file "$dir/pod",$s)
336 or ( $ret = check_file "$dir/pods","$s.pod")
337 or ( $ret = check_file "$dir/pods",$s)
343 opendir(D,$dir) or die "Can't opendir $dir: $!";
344 my @newdirs = map catfile($dir, $_), grep {
346 not /^auto\z/s and # save time! don't search auto dirs
349 closedir(D) or die "Can't closedir $dir: $!";
350 next unless @newdirs;
352 @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $Is_VMS;
353 print STDERR "Also looking in @newdirs\n" if $opt_v;
354 push(@dirs,@newdirs);
361 my @data = split /\n{2,}/, shift;
362 shift @data while @data and $data[0] !~ /\S/; # Go to header
363 shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
364 pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
365 # 28/Jan/99 perl 5.005, patch 53 1
370 my ($tmp, $no_tty, @pagers) = @_;
372 open(TMP,"<", $tmp) or die "Can't open $tmp: $!";
375 print or die "Can't print to stdout: $!";
377 close TMP or die "Can't close while $tmp: $!";
380 # On VMS, quoting prevents logical expansion, and temp files with no
381 # extension get the wrong default extension (such as .LIS for TYPE)
383 $tmp = VMS::Filespec::rmsexpand($tmp, '.') if ($Is_VMS);
384 foreach my $pager (@pagers) {
386 last if system("$pager $tmp") == 0;
388 last if system("$pager \"$tmp\"") == 0;
396 if ($podidx && open(PODIDX, $podidx)) {
397 my $searchfor = catfile split '::';
398 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
402 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
404 close(PODIDX) or die "Can't close $podidx: $!";
407 print STDERR "Searching for $_\n" if $opt_v;
410 push @found, $_ if $opt_m or containspod($_);
413 # We must look both in @INC for library modules and in $bindir
414 # for executables, like h2xs or perldoc itself.
415 my @searchdirs = ($bindir, @INC);
419 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
420 push(@searchdirs,$trn);
422 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
425 push(@searchdirs, grep(-d, split($Config{path_sep},
429 my @files = searchfor(0,$_,@searchdirs);
431 print STDERR "Found as @files\n" if $opt_v;
434 # no match, try recursive search
435 @searchdirs = grep(!/^\.\z/s,@INC);
436 @files= searchfor(1,$_,@searchdirs) if $opt_r;
438 print STDERR "Loosely found as @files\n" if $opt_v;
441 print STDERR "No documentation found for \"$_\".\n";
443 print STDERR "However, try\n";
444 for my $dir (@global_found) {
445 opendir(DIR, $dir) or die "opendir $dir: $!";
446 while (my $file = readdir(DIR)) {
447 next if ($file =~ /^\./s);
448 $file =~ s/\.(pm|pod)\z//; # XXX: badfs
449 print STDERR "\tperldoc $_\::$file\n";
451 closedir DIR or die "closedir $dir: $!";
460 exit ($Is_VMS ? 98962 : 1);
464 print join("\n", @found), "\n";
468 my $lines = $ENV{LINES} || 24;
471 if (! -t STDOUT) { $no_tty = 1 }
472 END { close(STDOUT) || die "Can't close STDOUT: $!" }
475 push @pagers, qw( more< less notepad );
476 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
477 for (@found) { s,/,\\,g }
480 push @pagers, qw( most more less type/page );
483 push @pagers, qw( less.exe more.com< );
484 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
488 unshift @pagers, 'less', 'cmd /c more <';
490 push @pagers, qw( more less pg view cat );
491 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
493 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
496 foreach my $pager (@pagers) {
497 if (system($pager, @found) == 0) {
503 use vmsish qw(status exit);
513 my $perlfunc = shift @found;
514 open(PFUNC, "<", $perlfunc)
515 or die("Can't open $perlfunc: $!");
517 # Functions like -r, -e, etc. are listed under `-X'.
518 my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
524 last if /^=head2 Alphabetical Listing of Perl Functions/;
527 # Look for our function
531 if (/^=item\s+\Q$search_string\E\b/o) {
535 last if $found > 1 and not $inlist;
545 ++$found if /^\w/; # found descriptive text
548 die "No documentation for perl function `$opt_f' found\n";
550 close PFUNC or die "Can't open $perlfunc: $!";
554 local @ARGV = @found; # I'm lazy, sue me.
557 my $rx = eval { qr/$opt_q/ } or die <<EOD;
558 Invalid regular expression '$opt_q' given as -q pattern:
560 Did you mean \\Q$opt_q ?
564 for (@found) { die "invalid file spec: $!" if /[<>|]/ }
567 if (/^=head2\s+.*(?:$opt_q)/oi) {
569 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
578 die("No documentation for perl FAQ keyword `$opt_q' found\n");
584 my ($tmpfd, $tmp) = File::Temp::tempfile(UNLINK => 1);
589 my ($buffd, $buffer) = File::Temp::tempfile(UNLINK => 1);
590 print $buffd "=over 8\n\n";
591 print $buffd @pod or die "Can't print $buffer: $!";
592 print $buffd "=back\n";
593 close $buffd or die "Can't close $buffer: $!";
603 Pod::Text->new()->parse_from_file($file, $tmpfd);
606 my $cmd = catfile($bindir, $pod2man) . " --lax $file | $opt_n -man";
607 $cmd .= " | col -x" if $^O =~ /hpux/;
609 $rslt = filter_nroff($rslt) if $filter;
610 unless (($err = $?)) {
612 or die "Can't print $tmp: $!";
615 if ($opt_u or $err) {
616 open(IN,"<", $file) or die("Can't open $file: $!");
620 $cut = $1 eq 'cut' if /^=(\w+)/;
623 or die "Can't print $tmp: $!";
625 close IN or die "Can't close $file: $!";
629 or die "Can't close $tmp: $!";
630 page($tmp, $no_tty, @pagers);
636 my $nada = substr($arg, 0, 0); # zero-length
637 local $@; # preserve caller's version
638 eval { eval "# $nada" };
639 return length($@) != 0;
642 sub am_taint_checking {
643 my($k,$v) = each %ENV;
644 return is_tainted($v);
652 perldoc - Look up Perl documentation in pod format.
656 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
658 B<perldoc> B<-f> BuiltinFunction
660 B<perldoc> B<-q> FAQ Keyword
664 I<perldoc> looks up a piece of documentation in .pod format that is embedded
665 in the perl installation tree or in a perl script, and displays it via
666 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
667 C<col -x> will be used.) This is primarily used for the documentation for
668 the perl library modules.
670 Your system may also have man pages installed for those modules, in
671 which case you can probably just use the man(1) command.
679 Prints out a brief help message.
683 Describes search for the item in detail.
685 =item B<-t> text output
687 Display docs using plain text converter, instead of nroff. This may be faster,
688 but it won't look as nice.
690 =item B<-u> unformatted
692 Find docs only; skip reformatting by pod2*
696 Display the entire module: both code and unformatted pod documentation.
697 This may be useful if the docs don't explain a function in the detail
698 you need, and you'd like to inspect the code directly; perldoc will find
699 the file for you and simply hand it off for display.
701 =item B<-l> file name only
703 Display the file name of the module found.
705 =item B<-F> file names
707 Consider arguments as file names, no search in directories will be performed.
711 The B<-f> option followed by the name of a perl built in function will
712 extract the documentation of this function from L<perlfunc>.
716 The B<-q> option takes a regular expression as an argument. It will search
717 the question headings in perlfaq[1-9] and print the entries matching
718 the regular expression.
720 =item B<-X> use an index if present
722 The B<-X> option looks for an entry whose basename matches the name given on the
723 command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
724 contain fully qualified filenames, one per line.
726 =item B<-U> run insecurely
728 Because B<perldoc> does not run properly tainted, and is known to
729 have security issues, it will not normally execute as the superuser.
730 If you use the B<-U> flag, it will do so, but only after setting
731 the effective and real IDs to nobody's or nouser's account, or -2
732 if unavailable. If it cannot relinquish its privileges, it will not
735 =item B<PageName|ModuleName|ProgramName>
737 The item you want to look up. Nested modules (such as C<File::Basename>)
738 are specified either as C<File::Basename> or C<File/Basename>. You may also
739 give a descriptive name of a page, such as C<perlfunc>. You may also give a
740 partial or wrong-case name, such as "basename" for "File::Basename", but
741 this will be slower, if there is more then one page with the same partial
742 name, you will only get the first one.
748 Any switches in the C<PERLDOC> environment variable will be used before the
749 command line arguments. C<perldoc> also searches directories
750 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
751 defined) and C<PATH> environment variables.
752 (The latter is so that embedded pods for executables, such as
753 C<perldoc> itself, are available.) C<perldoc> will use, in order of
754 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
755 C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
756 used if C<perldoc> was told to display plain text or unformatted pod.)
758 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
762 This is perldoc v2.03.
766 Kenneth Albanowski <kjahds@kjahds.com>
768 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
774 # Version 2.03: Sun Apr 23 16:56:34 BST 2000
775 # Hugo van der Sanden <hv@crypt0.demon.co.uk>
776 # don't die when 'use blib' fails
777 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
778 # Tom Christiansen <tchrist@perl.com>
779 # Added -U insecurity option
780 # Version 2.01: Sat Mar 11 15:22:33 MST 2000
781 # Tom Christiansen <tchrist@perl.com>, querulously.
782 # Security and correctness patches.
783 # What a twisted bit of distasteful spaghetti code.
785 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
786 # Charles Wilson <cwilson@ece.gatech.edu>
787 # changed /pod/ directory to /pods/ for cygwin
788 # to support cygwin/win32
789 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
790 # Robin Barker <rmb1@cise.npl.co.uk>
791 # -strict, -w cleanups
792 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
793 # Gurusamy Sarathy <gsar@activestate.com>
794 # -doc tweaks for -F and -X options
795 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
796 # Gurusamy Sarathy <gsar@activestate.com>
797 # -various fixes for win32
798 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
799 # Kenneth Albanowski <kjahds@kjahds.com>
800 # -added Charles Bailey's further VMS patches, and -u switch
801 # -added -t switch, with pod2text support
803 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
804 # Kenneth Albanowski <kjahds@kjahds.com>
806 # -added better error recognition (on no found pages, just exit. On
807 # missing nroff/pod2man, just display raw pod.)
808 # -added recursive/case-insensitive matching (thanks, Andreas). This
809 # slows things down a bit, unfortunately. Give a precise name, and
812 # Version 1.01: Tue May 30 14:47:34 EDT 1995
813 # Andy Dougherty <doughera@lafcol.lafayette.edu>
814 # -added pod documentation.
815 # -added PATH searching.
816 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
822 # Cache directories read during sloppy match
825 close OUT or die "Can't close $file: $!";
826 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
827 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';