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.
50 Usage: $0 [-h] [-v] [-t] [-u] [-m] [-l] PageName|ModuleName|ProgramName
53 We suggest you use "perldoc perldoc" to get aquainted
59 $Is_VMS = $^O eq 'VMS';
60 $Is_MSWin32 = $^O eq 'MSWin32';
64 # Erase evidence of previous errors (if any), so exit status is simple.
67 perldoc [options] PageName|ModuleName|ProgramName...
68 perldoc [options] -f BuiltinFunction
71 -h Display this help message
72 -t Display pod using pod2text instead of pod2man and nroff
73 (-t is the default on win32)
74 -u Display unformatted pod text
75 -m Display modules file in its entirety
76 -l Display the modules file name
77 -v Verbosely describe what's going on
79 PageName|ModuleName...
80 is the name of a piece of documentation that you want to look at. You
81 may either give a descriptive name of the page (as in the case of
82 `perlfunc') the name of a module, either like `Term::Info',
83 `Term/Info', the partial name of a module, like `info', or
84 `makemaker', or the name of a program, like `perldoc'.
87 is the name of a perl function. Will extract documentation from
90 Any switches in the PERLDOC environment variable will be used before the
91 command line arguments.
99 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
101 getopts("mhtluvf:") || usage;
103 usage if $opt_h || $opt_h; # avoid -w warning
105 if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
106 usage("only one of -t, -u, -m or -l")
107 } elsif ($Is_MSWin32) {
108 $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
111 if ($opt_t) { require Pod::Text; import Pod::Text; }
114 @pages = ("perlfunc");
140 foreach $p (split(/\//, $file)){
141 if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) {
142 # VMSish filesystems don't begin at '/'
148 } elsif (-f ("@p/$p")) {
154 while ($cip=readdir(DIR)) {
155 $cip =~ s/\.dir$// if $Is_VMS;
156 if (lc $cip eq $lcp){
162 return "" unless $found;
164 return "@p" if -f "@p";
167 return; # is not a file
171 my($recurse,$s,@dirs) = @_;
173 $s = VMS::Filespec::unixify($s) if $Is_VMS;
174 return $s if -f $s && containspod($s);
175 printf STDERR "looking for $s in @dirs\n" if $opt_v;
179 for ($i=0;$i<@dirs;$i++) {
181 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
182 if (( $ret = minus_f_nocase "$dir/$s.pod")
183 or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
184 or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
186 $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
188 $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret))
189 or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
190 or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
195 my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
197 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
198 next unless @newdirs;
199 print STDERR "Also looking in @newdirs\n" if $opt_v;
200 push(@dirs,@newdirs);
208 print STDERR "Searching for $_\n" if $opt_v;
209 # We must look both in @INC for library modules and in PATH
210 # for executables, like h2xs or perldoc itself.
215 for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
216 push(@searchdirs,$trn);
218 } elsif ($Is_MSWin32) {
219 push(@searchdirs, grep(-d, split(';', $ENV{'PATH'})));
221 push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
223 @files= searchfor(0,$_,@searchdirs);
226 print STDERR "Found as @files\n" if $opt_v;
228 # no match, try recursive search
230 @searchdirs = grep(!/^\.$/,@INC);
233 @files= searchfor(1,$_,@searchdirs);
235 print STDERR "Loosely found as @files\n" if $opt_v;
237 print STDERR "No documentation found for '$_'\n";
244 exit ($Is_VMS ? 98962 : 1);
248 print join("\n", @found), "\n";
252 if( ! -t STDOUT ) { $no_tty = 1 }
255 $tmp = "$ENV{TEMP}\\perldoc1.$$";
256 push @pagers, qw( more< less notepad );
257 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
259 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
260 push @pagers, qw( most more less type/page );
262 $tmp = "/tmp/perldoc1.$$";
263 push @pagers, qw( more less pg view cat );
264 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
266 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
269 foreach $pager (@pagers) {
270 system("$pager @found") or exit;
272 if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
277 my $perlfunc = shift @found;
278 open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
282 last if /^=head2 Alphabetical Listing of Perl Functions/;
285 # Look for our function
288 if (/^=item\s+\Q$opt_f\E\b/o) {
293 push(@pod, $_) if $found;
297 open(FORMATTER, "| pod2text") || die "Can't start filter";
298 print FORMATTER "=over 8\n\n";
299 print FORMATTER @pod;
300 print FORMATTER "=back\n";
306 die "No documentation for perl function `$opt_f' found\n";
315 Pod::Text::pod2text($_,*TMP);
317 } elsif(not $opt_u) {
318 my $cmd = "pod2man --lax $_ | nroff -man";
319 $cmd .= " | col -x" if $^O =~ /hpux/;
321 unless(($err = $?)) {
328 if( $opt_u or $err or -z $tmp) {
333 $cut = $1 eq 'cut' if /^=(\w+)/;
347 foreach $pager (@pagers) {
348 system("$pager $tmp") or last;
352 1 while unlink($tmp); #Possibly pointless VMSism
360 perldoc - Look up Perl documentation in pod format.
364 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName|ModuleName|ProgramName
366 B<perldoc> B<-f> BuiltinFunction
370 I<perldoc> looks up a piece of documentation in .pod format that is embedded
371 in the perl installation tree or in a perl script, and displays it via
372 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
373 C<col -x> will be used.) This is primarily used for the documentation for
374 the perl library modules.
376 Your system may also have man pages installed for those modules, in
377 which case you can probably just use the man(1) command.
385 Prints out a brief help message.
389 Describes search for the item in detail.
391 =item B<-t> text output
393 Display docs using plain text converter, instead of nroff. This may be faster,
394 but it won't look as nice.
396 =item B<-u> unformatted
398 Find docs only; skip reformatting by pod2*
402 Display the entire module: both code and unformatted pod documentation.
403 This may be useful if the docs don't explain a function in the detail
404 you need, and you'd like to inspect the code directly; perldoc will find
405 the file for you and simply hand it off for display.
407 =item B<-l> file name only
409 Display the file name of the module found.
413 The B<-f> option followed by the name of a perl built in function will
414 extract the documentation of this function from L<perlfunc>.
416 =item B<PageName|ModuleName|ProgramName>
418 The item you want to look up. Nested modules (such as C<File::Basename>)
419 are specified either as C<File::Basename> or C<File/Basename>. You may also
420 give a descriptive name of a page, such as C<perlfunc>. You make also give a
421 partial or wrong-case name, such as "basename" for "File::Basename", but
422 this will be slower, if there is more then one page with the same partial
423 name, you will only get the first one.
429 Any switches in the C<PERLDOC> environment variable will be used before the
430 command line arguments. C<perldoc> also searches directories
431 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
432 defined) and C<PATH> environment variables.
433 (The latter is so that embedded pods for executables, such as
434 C<perldoc> itself, are available.)
438 Kenneth Albanowski <kjahds@kjahds.com>
440 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
445 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
446 # Gurusamy Sarathy <gsar@umich.edu>
447 # -various fixes for win32
448 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
449 # Kenneth Albanowski <kjahds@kjahds.com>
450 # -added Charles Bailey's further VMS patches, and -u switch
451 # -added -t switch, with pod2text support
453 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
454 # Kenneth Albanowski <kjahds@kjahds.com>
456 # -added better error recognition (on no found pages, just exit. On
457 # missing nroff/pod2man, just display raw pod.)
458 # -added recursive/case-insensitive matching (thanks, Andreas). This
459 # slows things down a bit, unfortunately. Give a precise name, and
462 # Version 1.01: Tue May 30 14:47:34 EDT 1995
463 # Andy Dougherty <doughera@lafcol.lafayette.edu>
464 # -added pod documentation.
465 # -added PATH searching.
466 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
472 # Cache directories read during sloppy match
475 close OUT or die "Can't close $file: $!";
476 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
477 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';