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+"\$@"}'
35 push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
38 # In the following, perl variables are not expanded during extraction.
40 print OUT <<'!NO!SUBS!';
43 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
44 # is embedded in the perl installation tree.
46 # This is not to be confused with Tom Christianson's perlman, which is a
47 # man replacement, written in perl. This perldoc is strictly for reading
48 # the perl manuals, though it too is written in perl.
51 my $me = $0; # Editing $0 is unportable
54 Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
58 The -h option prints more help. Also try "perldoc perldoc" to get
59 aquainted with the system.
66 my @global_found = ();
67 my $global_target = "";
69 my $Is_VMS = $^O eq 'VMS';
70 my $Is_MSWin32 = $^O eq 'MSWin32';
71 my $Is_Dos = $^O eq 'dos';
75 # Erase evidence of previous errors (if any), so exit status is simple.
78 perldoc [options] PageName|ModuleName|ProgramName...
79 perldoc [options] -f BuiltinFunction
80 perldoc [options] -q FAQRegex
83 -h Display this help message
84 -r Recursive search (slow)
86 -t Display pod using pod2text instead of pod2man and nroff
87 (-t is the default on win32)
88 -u Display unformatted pod text
89 -m Display module's file in its entirety
90 -l Display the module's file name
91 -F Arguments are file names, not modules
92 -v Verbosely describe what's going on
93 -X use index if present (looks for pod.idx at $Config{archlib})
94 -q Search the text of questions (not answers) in perlfaq[1-9]
96 PageName|ModuleName...
97 is the name of a piece of documentation that you want to look at. You
98 may either give a descriptive name of the page (as in the case of
99 `perlfunc') the name of a module, either like `Term::Info',
100 `Term/Info', the partial name of a module, like `info', or
101 `makemaker', or the name of a program, like `perldoc'.
104 is the name of a perl function. Will extract documentation from
108 is a regex. Will search perlfaq[1-9] for and extract any
109 questions that match.
111 Any switches in the PERLDOC environment variable will be used before the
112 command line arguments. The optional pod index file contains a list of
113 filenames, one per line.
118 if (defined $ENV{"PERLDOC"}) {
119 require Text::ParseWords;
120 unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
124 my $getopts = "mhtluvriFf:Xq:";
125 print OUT <<"!GET!OPTS!";
127 use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
129 getopts("$getopts") || usage;
132 print OUT <<'!NO!SUBS!';
138 $podidx = "$Config{'archlib'}/pod.idx";
139 $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
142 if ((my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
143 usage("only one of -t, -u, -m or -l")
145 elsif ($Is_MSWin32 || $Is_Dos) {
146 $opt_t = 1 unless $opts
149 if ($opt_t) { require Pod::Text; import Pod::Text; }
153 @pages = ("perlfunc");
156 @pages = ("perlfaq1" .. "perlfaq9");
162 # Does this look like a module or extension directory?
163 if (-f "Makefile.PL") {
164 # Add ., lib and blib/* libs to @INC (if they exist)
166 unshift(@INC, 'lib') if -d 'lib';
167 require ExtUtils::testlib;
171 my($file, $readit) = @_;
172 return 1 if !$readit && $file =~ /\.pod$/i;
187 my $path = join('/',$dir,$file);
188 return $path if -f $path and -r _;
189 if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
190 # on a case-forgiving file system or if case is important
191 # that is it all we can do
192 warn "Ignored $path: unreadable\n" if -f _;
199 foreach $p (split(/\//, $file)){
204 if ( $p eq $global_target) {
205 my $tmp_path = join ('/', @p);
207 for (@global_found) {
208 $path_f = 1 if $_ eq $tmp_path;
210 push (@global_found, $tmp_path) unless $path_f;
211 print STDERR "Found as @p but directory\n" if $opt_v;
214 elsif (-f _ && -r _) {
218 warn "Ignored $try: unreadable\n";
224 while ($cip=readdir(DIR)) {
225 if (lc $cip eq $lcp){
231 return "" unless $found;
233 return "@p" if -f "@p" and -r _;
234 warn "Ignored @p: unreadable\n" if -f _;
244 return minus_f_nocase($dir,$file);
247 my $path = minus_f_nocase($dir,$file);
248 return $path if length $path and containspod($path);
255 my($recurse,$s,@dirs) = @_;
257 $s = VMS::Filespec::unixify($s) if $Is_VMS;
258 return $s if -f $s && containspod($s);
259 printf STDERR "Looking for $s in @dirs\n" if $opt_v;
263 $global_target = (split('/', $s))[-1];
264 for ($i=0; $i<@dirs; $i++) {
266 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
267 if ( ( $ret = check_file $dir,"$s.pod")
268 or ( $ret = check_file $dir,"$s.pm")
269 or ( $ret = check_file $dir,$s)
271 $ret = check_file $dir,"$s.com")
272 or ( $^O eq 'os2' and
273 $ret = check_file $dir,"$s.cmd")
274 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
275 $ret = check_file $dir,"$s.bat")
276 or ( $ret = check_file "$dir/pod","$s.pod")
277 or ( $ret = check_file "$dir/pod",$s)
284 my @newdirs = map "$dir/$_", grep {
286 not /^auto$/ and # save time! don't search auto dirs
290 next unless @newdirs;
291 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
292 print STDERR "Also looking in @newdirs\n" if $opt_v;
293 push(@dirs,@newdirs);
300 my @data = split /\n{2,}/, shift;
301 shift @data while @data and $data[0] !~ /\S/; # Go to header
302 shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
303 pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
304 # 28/Jan/99 perl 5.005, patch 53 1
309 my ($file, $tmp, $filter) = @_;
314 or warn("Can't open $tmp: $!"), return;
315 Pod::Text::pod2text($file,*TMP);
319 my $cmd = "pod2man --lax $file | nroff -man";
320 $cmd .= " | col -x" if $^O =~ /hpux/;
322 $rslt = filter_nroff($rslt) if $filter;
323 unless (($err = $?)) {
324 open(TMP,">>$tmp") or warn("Can't open $tmp: $!"), return;
329 if ($opt_u or $err or -z $tmp) {
330 open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return;
331 open(IN,"<$file") or warn("Can't open $file: $!"), return;
334 $cut = $1 eq 'cut' if /^=(\w+)/;
344 my ($tmp, $no_tty, @pagers) = @_;
346 open(TMP,"<$tmp") or warn("Can't open $tmp: $!"), return;
351 foreach my $pager (@pagers) {
352 system("$pager $tmp") or last;
360 1 while unlink($_); #Possibly pointless VMSism
365 my ($val, @files) = @_;
371 my ($msg, @files) = @_;
378 if ($podidx && open(PODIDX, $podidx)) {
381 $searchfor =~ s,::,/,g;
382 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
385 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
390 print STDERR "Searching for $_\n" if $opt_v;
391 # We must look both in @INC for library modules and in PATH
392 # for executables, like h2xs or perldoc itself.
393 my @searchdirs = @INC;
396 push @found, $_ if $opt_m or containspod($_);
402 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
403 push(@searchdirs,$trn);
405 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
408 push(@searchdirs, grep(-d, split($Config{path_sep},
412 my @files = searchfor(0,$_,@searchdirs);
414 print STDERR "Found as @files\n" if $opt_v;
417 # no match, try recursive search
418 @searchdirs = grep(!/^\.$/,@INC);
419 @files= searchfor(1,$_,@searchdirs) if $opt_r;
421 print STDERR "Loosely found as @files\n" if $opt_v;
424 print STDERR "No documentation found for \"$_\".\n";
426 print STDERR "However, try\n";
427 for my $dir (@global_found) {
428 opendir(DIR, $dir) or die "$!";
429 while (my $file = readdir(DIR)) {
430 next if ($file =~ /^\./);
431 $file =~ s/\.(pm|pod)$//;
432 print STDERR "\tperldoc $_\::$file\n";
443 exit ($Is_VMS ? 98962 : 1);
447 print join("\n", @found), "\n";
451 my $lines = $ENV{LINES} || 24;
454 if (! -t STDOUT) { $no_tty = 1 }
456 # until here we could simply exit or die
457 # now we create temporary files that we have to clean up
458 # namely $tmp, $buffer
463 $tmp = "$ENV{TEMP}\\perldoc1.$$";
464 $buffer = "$ENV{TEMP}\\perldoc1.b$$";
465 push @pagers, qw( more< less notepad );
466 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
467 for (@found) { s,/,\\,g }
470 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
471 $buffer = 'Sys$Scratch:perldoc.tmp1_b'.$$;
472 push @pagers, qw( most more less type/page );
475 $tmp = "$ENV{TEMP}/perldoc1.$$";
476 $buffer = "$ENV{TEMP}/perldoc1.b$$";
478 $buffer =~ tr!\\/!//!s;
479 push @pagers, qw( less.exe more.com< );
480 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
485 $tmp = POSIX::tmpnam();
486 $buffer = POSIX::tmpnam();
487 unshift @pagers, 'less', 'cmd /c more <';
490 $tmp = "/tmp/perldoc1.$$";
491 $buffer = "/tmp/perldoc1.b$$";
493 push @pagers, qw( more less pg view cat );
494 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
496 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
498 # all exit calls from here on have to be safe_exit calls (see above)
499 # and all die calls safe_die calls to guarantee removal of files and
503 foreach my $pager (@pagers) {
504 system("$pager @found") or safe_exit(0, $tmp, $buffer);
506 if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
507 # I don't get the line above. Please patch yourself as needed.
508 safe_exit(1, $tmp, $buffer);
513 my $perlfunc = shift @found;
514 open(PFUNC, $perlfunc)
515 or safe_die("Can't open $perlfunc: $!", $tmp, $buffer);
517 # Functions like -r, -e, etc. are listed under `-X'.
518 my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
523 last if /^=head2 Alphabetical Listing of Perl Functions/;
526 # Look for our function
530 if (/^=item\s+\Q$search_string\E\b/o) {
534 last if $found > 1 and not $inlist;
544 ++$found if /^\w/; # found descriptive text
547 die "No documentation for perl function `$opt_f' found\n";
552 local @ARGV = @found; # I'm lazy, sue me.
557 if (/^=head2\s+.*(?:$opt_q)/oi) {
559 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
568 safe_die("No documentation for perl FAQ keyword `$opt_q' found\n",
576 open(TMP,">$buffer") or safe_die("Can't open '$buffer': $!", $tmp, $buffer);
577 print TMP "=over 8\n\n";
586 printout($_, $tmp, $filter);
588 page($tmp, $no_tty, @pagers);
590 safe_exit(0, $tmp, $buffer);
596 perldoc - Look up Perl documentation in pod format.
600 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
602 B<perldoc> B<-f> BuiltinFunction
604 B<perldoc> B<-q> FAQ Keyword
608 I<perldoc> looks up a piece of documentation in .pod format that is embedded
609 in the perl installation tree or in a perl script, and displays it via
610 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
611 C<col -x> will be used.) This is primarily used for the documentation for
612 the perl library modules.
614 Your system may also have man pages installed for those modules, in
615 which case you can probably just use the man(1) command.
623 Prints out a brief help message.
627 Describes search for the item in detail.
629 =item B<-t> text output
631 Display docs using plain text converter, instead of nroff. This may be faster,
632 but it won't look as nice.
634 =item B<-u> unformatted
636 Find docs only; skip reformatting by pod2*
640 Display the entire module: both code and unformatted pod documentation.
641 This may be useful if the docs don't explain a function in the detail
642 you need, and you'd like to inspect the code directly; perldoc will find
643 the file for you and simply hand it off for display.
645 =item B<-l> file name only
647 Display the file name of the module found.
649 =item B<-F> file names
651 Consider arguments as file names, no search in directories will be performed.
655 The B<-f> option followed by the name of a perl built in function will
656 extract the documentation of this function from L<perlfunc>.
660 The B<-q> option takes a regular expression as an argument. It will search
661 the question headings in perlfaq[1-9] and print the entries matching
662 the regular expression.
664 =item B<-X> use an index if present
666 The B<-X> option looks for a entry whose basename matches the name given on the
667 command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
668 contain fully qualified filenames, one per line.
670 =item B<PageName|ModuleName|ProgramName>
672 The item you want to look up. Nested modules (such as C<File::Basename>)
673 are specified either as C<File::Basename> or C<File/Basename>. You may also
674 give a descriptive name of a page, such as C<perlfunc>. You may also give a
675 partial or wrong-case name, such as "basename" for "File::Basename", but
676 this will be slower, if there is more then one page with the same partial
677 name, you will only get the first one.
683 Any switches in the C<PERLDOC> environment variable will be used before the
684 command line arguments. C<perldoc> also searches directories
685 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
686 defined) and C<PATH> environment variables.
687 (The latter is so that embedded pods for executables, such as
688 C<perldoc> itself, are available.) C<perldoc> will use, in order of
689 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
690 C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
691 used if C<perldoc> was told to display plain text or unformatted pod.)
693 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
697 This is perldoc v2.0.
701 Kenneth Albanowski <kjahds@kjahds.com>
703 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
709 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
710 # Robin Barker <rmb1@cise.npl.co.uk>
711 # -strict, -w cleanups
712 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
713 # Gurusamy Sarathy <gsar@umich.edu>
714 # -doc tweaks for -F and -X options
715 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
716 # Gurusamy Sarathy <gsar@umich.edu>
717 # -various fixes for win32
718 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
719 # Kenneth Albanowski <kjahds@kjahds.com>
720 # -added Charles Bailey's further VMS patches, and -u switch
721 # -added -t switch, with pod2text support
723 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
724 # Kenneth Albanowski <kjahds@kjahds.com>
726 # -added better error recognition (on no found pages, just exit. On
727 # missing nroff/pod2man, just display raw pod.)
728 # -added recursive/case-insensitive matching (thanks, Andreas). This
729 # slows things down a bit, unfortunately. Give a precise name, and
732 # Version 1.01: Tue May 30 14:47:34 EDT 1995
733 # Andy Dougherty <doughera@lafcol.lafayette.edu>
734 # -added pod documentation.
735 # -added PATH searching.
736 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
742 # Cache directories read during sloppy match
745 close OUT or die "Can't close $file: $!";
746 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
747 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';