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
61 $Is_VMS = $^O eq 'VMS';
62 $Is_MSWin32 = $^O eq 'MSWin32';
66 # Erase evidence of previous errors (if any), so exit status is simple.
69 perldoc [options] PageName|ModuleName|ProgramName...
70 perldoc [options] -f BuiltinFunction
73 -h Display this help message
74 -t Display pod using pod2text instead of pod2man and nroff
75 (-t is the default on win32)
76 -u Display unformatted pod text
77 -m Display modules file in its entirety
78 -l Display the modules file name
79 -v Verbosely describe what's going on
81 PageName|ModuleName...
82 is the name of a piece of documentation that you want to look at. You
83 may either give a descriptive name of the page (as in the case of
84 `perlfunc') the name of a module, either like `Term::Info',
85 `Term/Info', the partial name of a module, like `info', or
86 `makemaker', or the name of a program, like `perldoc'.
89 is the name of a perl function. Will extract documentation from
92 Any switches in the PERLDOC environment variable will be used before the
93 command line arguments.
101 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
103 getopts("mhtluvf:") || usage;
105 usage if $opt_h || $opt_h; # avoid -w warning
107 if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
108 usage("only one of -t, -u, -m or -l")
109 } elsif ($Is_MSWin32) {
110 $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
113 if ($opt_t) { require Pod::Text; import Pod::Text; }
116 @pages = ("perlfunc");
142 $file =~ tr|\\|/| if $Is_MSWin32 or $^O eq 'os2';
143 if ( $Is_MSWin32 and $file =~ s|^(//[^/]+)/|| ) { # UNC path?
146 foreach $p (split(/\//, $file)){
147 if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) {
148 # VMSish filesystems don't begin at '/'
154 } elsif (-f ("@p/$p")) {
160 while ($cip=readdir(DIR)) {
161 $cip =~ s/\.dir$// if $Is_VMS;
162 if (lc $cip eq $lcp){
168 return "" unless $found;
170 return "@p" if -f "@p";
173 return; # is not a file
177 my($recurse,$s,@dirs) = @_;
179 $s = VMS::Filespec::unixify($s) if $Is_VMS;
180 return $s if -f $s && containspod($s);
181 printf STDERR "looking for $s in @dirs\n" if $opt_v;
185 for ($i=0;$i<@dirs;$i++) {
187 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
188 if (( $ret = minus_f_nocase "$dir/$s.pod")
189 or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
190 or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
192 $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
193 or ( $^O eq 'os2' and
194 $ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret))
195 or ( ($Is_MSWin32 or $^O eq 'os2') and
196 $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret))
197 or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
198 or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
203 my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
205 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
206 next unless @newdirs;
207 print STDERR "Also looking in @newdirs\n" if $opt_v;
208 push(@dirs,@newdirs);
216 print STDERR "Searching for $_\n" if $opt_v;
217 # We must look both in @INC for library modules and in PATH
218 # for executables, like h2xs or perldoc itself.
223 for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
224 push(@searchdirs,$trn);
227 push(@searchdirs, grep(-d, split($Config{path_sep},
230 @files= searchfor(0,$_,@searchdirs);
233 print STDERR "Found as @files\n" if $opt_v;
235 # no match, try recursive search
237 @searchdirs = grep(!/^\.$/,@INC);
240 @files= searchfor(1,$_,@searchdirs);
242 print STDERR "Loosely found as @files\n" if $opt_v;
244 print STDERR "No documentation found for '$_'\n";
251 exit ($Is_VMS ? 98962 : 1);
255 print join("\n", @found), "\n";
259 if( ! -t STDOUT ) { $no_tty = 1 }
262 $tmp = "$ENV{TEMP}\\perldoc1.$$";
263 push @pagers, qw( more< less notepad );
264 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
266 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
267 push @pagers, qw( most more less type/page );
271 $tmp = POSIX::tmpnam();
273 $tmp = "/tmp/perldoc1.$$";
275 push @pagers, qw( more less pg view cat );
276 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
278 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
281 foreach $pager (@pagers) {
282 system("$pager @found") or exit;
284 if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
289 my $perlfunc = shift @found;
290 open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
294 last if /^=head2 Alphabetical Listing of Perl Functions/;
297 # Look for our function
300 if (/^=item\s+\Q$opt_f\E\b/o) {
305 push(@pod, $_) if $found;
309 open(FORMATTER, "| pod2text") || die "Can't start filter";
310 print FORMATTER "=over 8\n\n";
311 print FORMATTER @pod;
312 print FORMATTER "=back\n";
318 die "No documentation for perl function `$opt_f' found\n";
327 Pod::Text::pod2text($_,*TMP);
329 } elsif(not $opt_u) {
330 my $cmd = "pod2man --lax $_ | nroff -man";
331 $cmd .= " | col -x" if $^O =~ /hpux/;
333 unless(($err = $?)) {
340 if( $opt_u or $err or -z $tmp) {
345 $cut = $1 eq 'cut' if /^=(\w+)/;
359 foreach $pager (@pagers) {
360 system("$pager $tmp") or last;
364 1 while unlink($tmp); #Possibly pointless VMSism
372 perldoc - Look up Perl documentation in pod format.
376 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName|ModuleName|ProgramName
378 B<perldoc> B<-f> BuiltinFunction
382 I<perldoc> looks up a piece of documentation in .pod format that is embedded
383 in the perl installation tree or in a perl script, and displays it via
384 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
385 C<col -x> will be used.) This is primarily used for the documentation for
386 the perl library modules.
388 Your system may also have man pages installed for those modules, in
389 which case you can probably just use the man(1) command.
397 Prints out a brief help message.
401 Describes search for the item in detail.
403 =item B<-t> text output
405 Display docs using plain text converter, instead of nroff. This may be faster,
406 but it won't look as nice.
408 =item B<-u> unformatted
410 Find docs only; skip reformatting by pod2*
414 Display the entire module: both code and unformatted pod documentation.
415 This may be useful if the docs don't explain a function in the detail
416 you need, and you'd like to inspect the code directly; perldoc will find
417 the file for you and simply hand it off for display.
419 =item B<-l> file name only
421 Display the file name of the module found.
425 The B<-f> option followed by the name of a perl built in function will
426 extract the documentation of this function from L<perlfunc>.
428 =item B<PageName|ModuleName|ProgramName>
430 The item you want to look up. Nested modules (such as C<File::Basename>)
431 are specified either as C<File::Basename> or C<File/Basename>. You may also
432 give a descriptive name of a page, such as C<perlfunc>. You make also give a
433 partial or wrong-case name, such as "basename" for "File::Basename", but
434 this will be slower, if there is more then one page with the same partial
435 name, you will only get the first one.
441 Any switches in the C<PERLDOC> environment variable will be used before the
442 command line arguments. C<perldoc> also searches directories
443 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
444 defined) and C<PATH> environment variables.
445 (The latter is so that embedded pods for executables, such as
446 C<perldoc> itself, are available.)
450 Kenneth Albanowski <kjahds@kjahds.com>
452 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
457 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
458 # Gurusamy Sarathy <gsar@umich.edu>
459 # -various fixes for win32
460 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
461 # Kenneth Albanowski <kjahds@kjahds.com>
462 # -added Charles Bailey's further VMS patches, and -u switch
463 # -added -t switch, with pod2text support
465 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
466 # Kenneth Albanowski <kjahds@kjahds.com>
468 # -added better error recognition (on no found pages, just exit. On
469 # missing nroff/pod2man, just display raw pod.)
470 # -added recursive/case-insensitive matching (thanks, Andreas). This
471 # slows things down a bit, unfortunately. Give a precise name, and
474 # Version 1.01: Tue May 30 14:47:34 EDT 1995
475 # Andy Dougherty <doughera@lafcol.lafayette.edu>
476 # -added pod documentation.
477 # -added PATH searching.
478 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
484 # Cache directories read during sloppy match
487 close OUT or die "Can't close $file: $!";
488 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
489 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';