4 use File::Basename qw(&basename &dirname);
6 # List explicitly here the variables you want Configure to
7 # generate. Metaconfig only looks for shell variables, so you
8 # have to mention them as if they were shell variables, not
9 # %Config entries. Thus you write
11 # to ensure Configure will look for $Config{startperl}.
13 # This forces PL files to create target in same directory as PL file.
14 # This is so that make depend always knows where to find PL derivatives.
16 $file = basename($0, '.PL');
17 $file .= '.com' if $^O eq 'VMS';
19 open OUT,">$file" or die "Can't create $file: $!";
21 print "Extracting $file (with variable substitutions)\n";
23 # In this section, perl variables will be expanded during extraction.
24 # You can use $Config{...} to use Configure variables.
26 print OUT <<"!GROK!THIS!";
28 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
29 if \$running_under_some_shell;
32 push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
35 # In the following, perl variables are not expanded during extraction.
37 print OUT <<'!NO!SUBS!';
40 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
41 # is embedded in the perl installation tree.
43 # This is not to be confused with Tom Christianson's perlman, which is a
44 # man replacement, written in perl. This perldoc is strictly for reading
45 # the perl manuals, though it too is written in perl.
48 $me = $0; # Editing $0 is unportable
51 Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
55 The -h option prints more help. Also try "perldoc perldoc" to get
56 aquainted with the system.
66 $Is_VMS = $^O eq 'VMS';
67 $Is_MSWin32 = $^O eq 'MSWin32';
68 $Is_Dos = $^O eq 'dos';
72 # Erase evidence of previous errors (if any), so exit status is simple.
75 perldoc [options] PageName|ModuleName|ProgramName...
76 perldoc [options] -f BuiltinFunction
77 perldoc [options] -q FAQRegex
80 -h Display this help message
81 -r Recursive search (slow)
83 -t Display pod using pod2text instead of pod2man and nroff
84 (-t is the default on win32)
85 -u Display unformatted pod text
86 -m Display module's file in its entirety
87 -l Display the module's file name
88 -F Arguments are file names, not modules
89 -v Verbosely describe what's going on
90 -X use index if present (looks for pod.idx at $Config{archlib})
93 PageName|ModuleName...
94 is the name of a piece of documentation that you want to look at. You
95 may either give a descriptive name of the page (as in the case of
96 `perlfunc') the name of a module, either like `Term::Info',
97 `Term/Info', the partial name of a module, like `info', or
98 `makemaker', or the name of a program, like `perldoc'.
101 is the name of a perl function. Will extract documentation from
105 is a regex. Will search perlfaq[1-9] for and extract any
106 questions that match.
108 Any switches in the PERLDOC environment variable will be used before the
109 command line arguments. The optional pod index file contains a list of
110 filenames, one per line.
115 use Text::ParseWords;
118 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
120 getopts("mhtluvriFf:Xq") || usage;
122 usage if $opt_h || $opt_h; # avoid -w warning
124 $podidx = "$Config{'archlib'}/pod.idx";
125 $podidx = "" if $opt_X || !-f "pod.idx" && !-r _ && -M _ > 7;
127 if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
128 usage("only one of -t, -u, -m or -l")
129 } elsif ($Is_MSWin32 || $Is_Dos) {
130 $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
133 if ($opt_t) { require Pod::Text; import Pod::Text; }
136 @pages = ("perlfunc");
138 @pages = ("perlfaq1" .. "perlfaq9");
143 # Does this look like a module or extension directory?
144 if (-f "Makefile.PL") {
145 # Add ., lib and blib/* libs to @INC (if they exist)
147 unshift(@INC, 'lib') if -d 'lib';
148 require ExtUtils::testlib;
154 my($file, $readit) = @_;
155 return 1 if !$readit && $file =~ /\.pod$/i;
170 my $path = join('/',$dir,$file);
171 return $path if -f $path and -r _;
172 if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
173 # on a case-forgiving file system or if case is important
174 # that is it all we can do
175 warn "Ignored $file: unreadable\n" if -f _;
182 foreach $p (split(/\//, $file)){
187 if ( $p eq $global_target) {
188 $tmp_path = join ('/', @p);
190 for (@global_found) {
191 $path_f = 1 if $_ eq $tmp_path;
193 push (@global_found, $tmp_path) unless $path_f;
194 print STDERR "Found as @p but directory\n" if $opt_v;
196 } elsif (-f _ && -r _) {
199 warn "Ignored $try: unreadable\n";
204 while ($cip=readdir(DIR)) {
205 if (lc $cip eq $lcp){
211 return "" unless $found;
213 return "@p" if -f "@p" and -r _;
214 warn "Ignored $file: unreadable\n" if -f _;
224 return minus_f_nocase($dir,$file);
226 my $path = minus_f_nocase($dir,$file);
227 return $path if containspod($path);
234 my($recurse,$s,@dirs) = @_;
236 $s = VMS::Filespec::unixify($s) if $Is_VMS;
237 return $s if -f $s && containspod($s);
238 printf STDERR "Looking for $s in @dirs\n" if $opt_v;
242 $global_target = (split('/', $s))[-1];
243 for ($i=0; $i<@dirs; $i++) {
245 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
246 if ( ( $ret = check_file $dir,"$s.pod")
247 or ( $ret = check_file $dir,"$s.pm")
248 or ( $ret = check_file $dir,$s)
250 $ret = check_file $dir,"$s.com")
251 or ( $^O eq 'os2' and
252 $ret = check_file $dir,"$s.cmd")
253 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
254 $ret = check_file $dir,"$s.bat")
255 or ( $ret = check_file "$dir/pod","$s.pod")
256 or ( $ret = check_file "$dir/pod",$s)
263 my @newdirs = map "$dir/$_", grep {
265 not /^auto$/ and # save time! don't search auto dirs
269 next unless @newdirs;
270 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
271 print STDERR "Also looking in @newdirs\n" if $opt_v;
272 push(@dirs,@newdirs);
280 if ($podidx && open(PODIDX, $podidx)) {
283 $searchfor =~ s,::,/,g;
284 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
287 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
292 print STDERR "Searching for $_\n" if $opt_v;
293 # We must look both in @INC for library modules and in PATH
294 # for executables, like h2xs or perldoc itself.
298 push @found, $_ if $opt_m or containspod($_);
304 for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
305 push(@searchdirs,$trn);
307 push(@dirs,'perl_root:[lib.pod]') # installed pods
309 push(@searchdirs, grep(-d, split($Config{path_sep},
312 @files= searchfor(0,$_,@searchdirs);
315 print STDERR "Found as @files\n" if $opt_v;
317 # no match, try recursive search
319 @searchdirs = grep(!/^\.$/,@INC);
321 @files= searchfor(1,$_,@searchdirs) if $opt_r;
323 print STDERR "Loosely found as @files\n" if $opt_v;
325 print STDERR "No documentation found for \"$_\".\n";
327 print STDERR "However, try\n";
328 my $dir = $file = "";
329 for $dir (@global_found) {
330 opendir(DIR, $dir) or die "$!";
331 while ($file = readdir(DIR)) {
332 next if ($file =~ /^\./);
333 $file =~ s/\.(pm|pod)$//;
334 print STDERR "\tperldoc $_\::$file\n";
345 exit ($Is_VMS ? 98962 : 1);
349 print join("\n", @found), "\n";
353 if( ! -t STDOUT ) { $no_tty = 1 }
356 $tmp = "$ENV{TEMP}\\perldoc1.$$";
357 push @pagers, qw( more< less notepad );
358 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
360 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
361 push @pagers, qw( most more less type/page );
363 $tmp = "$ENV{TEMP}/perldoc1.$$";
365 push @pagers, qw( less.exe more.com< );
366 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
370 $tmp = POSIX::tmpnam();
371 unshift @pagers, 'less', 'cmd /c more <';
373 $tmp = "/tmp/perldoc1.$$";
375 push @pagers, qw( more less pg view cat );
376 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
378 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
381 foreach $pager (@pagers) {
382 system("$pager @found") or exit;
384 if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
389 my $perlfunc = shift @found;
390 open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
394 last if /^=head2 Alphabetical Listing of Perl Functions/;
397 # Look for our function
401 if (/^=item\s+\Q$opt_f\E\b/o) {
408 ++$found if /^\w/; # found descriptive text
411 my $lines = $ENV{LINES} || 24;
414 open(FORMATTER, "| pod2text") || die "Can't start filter";
415 print FORMATTER "=over 8\n\n";
416 print FORMATTER @pod;
417 print FORMATTER "=back\n";
419 } elsif (@pod < $lines-2) {
422 foreach $pager (@pagers) {
423 open (PAGER, "| $pager") or next;
425 close(PAGER) or next;
430 die "No documentation for perl function `$opt_f' found\n";
436 local @ARGV = @found; # I'm lazy, sue me.
442 if (/^=head2\s+.*$opt_q/oi) {
444 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
445 } elsif (/^=head2/) {
454 open(FORMATTER, "| pod2text") || die "Can't start filter";
455 print FORMATTER "=over 8\n\n";
456 print FORMATTER @pod;
457 print FORMATTER "=back\n";
463 die "No documentation for perl function `$opt_f' found\n";
472 Pod::Text::pod2text($_,*TMP);
474 } elsif(not $opt_u) {
475 my $cmd = "pod2man --lax $_ | nroff -man";
476 $cmd .= " | col -x" if $^O =~ /hpux/;
478 unless(($err = $?)) {
485 if( $opt_u or $err or -z $tmp) {
490 $cut = $1 eq 'cut' if /^=(\w+)/;
504 foreach $pager (@pagers) {
505 system("$pager $tmp") or last;
509 1 while unlink($tmp); #Possibly pointless VMSism
517 perldoc - Look up Perl documentation in pod format.
521 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
523 B<perldoc> B<-f> BuiltinFunction
527 I<perldoc> looks up a piece of documentation in .pod format that is embedded
528 in the perl installation tree or in a perl script, and displays it via
529 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
530 C<col -x> will be used.) This is primarily used for the documentation for
531 the perl library modules.
533 Your system may also have man pages installed for those modules, in
534 which case you can probably just use the man(1) command.
542 Prints out a brief help message.
546 Describes search for the item in detail.
548 =item B<-t> text output
550 Display docs using plain text converter, instead of nroff. This may be faster,
551 but it won't look as nice.
553 =item B<-u> unformatted
555 Find docs only; skip reformatting by pod2*
559 Display the entire module: both code and unformatted pod documentation.
560 This may be useful if the docs don't explain a function in the detail
561 you need, and you'd like to inspect the code directly; perldoc will find
562 the file for you and simply hand it off for display.
564 =item B<-l> file name only
566 Display the file name of the module found.
568 =item B<-F> file names
570 Consider arguments as file names, no search in directories will be performed.
574 The B<-f> option followed by the name of a perl built in function will
575 extract the documentation of this function from L<perlfunc>.
577 =item B<-X> use an index if present
579 The B<-X> option looks for a entry whose basename matches the name given on the
580 command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
581 contain fully qualified filenames, one per line.
583 =item B<PageName|ModuleName|ProgramName>
585 The item you want to look up. Nested modules (such as C<File::Basename>)
586 are specified either as C<File::Basename> or C<File/Basename>. You may also
587 give a descriptive name of a page, such as C<perlfunc>. You make also give a
588 partial or wrong-case name, such as "basename" for "File::Basename", but
589 this will be slower, if there is more then one page with the same partial
590 name, you will only get the first one.
596 Any switches in the C<PERLDOC> environment variable will be used before the
597 command line arguments. C<perldoc> also searches directories
598 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
599 defined) and C<PATH> environment variables.
600 (The latter is so that embedded pods for executables, such as
601 C<perldoc> itself, are available.) C<perldoc> will use, in order of
602 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
603 C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
604 used if C<perldoc> was told to display plain text or unformatted pod.)
608 Kenneth Albanowski <kjahds@kjahds.com>
610 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
615 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
616 # Gurusamy Sarathy <gsar@umich.edu>
617 # -doc tweaks for -F and -X options
618 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
619 # Gurusamy Sarathy <gsar@umich.edu>
620 # -various fixes for win32
621 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
622 # Kenneth Albanowski <kjahds@kjahds.com>
623 # -added Charles Bailey's further VMS patches, and -u switch
624 # -added -t switch, with pod2text support
626 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
627 # Kenneth Albanowski <kjahds@kjahds.com>
629 # -added better error recognition (on no found pages, just exit. On
630 # missing nroff/pod2man, just display raw pod.)
631 # -added recursive/case-insensitive matching (thanks, Andreas). This
632 # slows things down a bit, unfortunately. Give a precise name, and
635 # Version 1.01: Tue May 30 14:47:34 EDT 1995
636 # Andy Dougherty <doughera@lafcol.lafayette.edu>
637 # -added pod documentation.
638 # -added PATH searching.
639 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
645 # Cache directories read during sloppy match
648 close OUT or die "Can't close $file: $!";
649 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
650 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';