4 use File::Basename qw(&basename &dirname);
6 # List explicitly here the shell variables you want Configure
10 # This forces PL files to create target in same directory as PL file.
11 # This is so that make depend always knows where to find PL derivatives.
13 ($file = basename($0)) =~ s/\.PL$//;
15 if ($Config{'osname'} eq 'VMS' or
16 $Config{'osname'} eq 'OS2'); # "case-forgiving"
18 open OUT,">$file" or die "Can't create $file: $!";
20 print "Extracting $file (with variable substitutions)\n";
22 # In this section, perl variables will be expanded during extraction.
23 # You can use $Config{...} to use Configure variables.
25 print OUT <<"!GROK!THIS!";
27 eval 'exec perl -S \$0 "\$@"'
31 # In the following, perl variables are not expanded during extraction.
33 print OUT <<'!NO!SUBS!';
36 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
37 # is embedded in the perl installation tree.
39 # This is not to be confused with Tom Christianson's perlman, which is a
40 # man replacement, written in perl. This perldoc is strictly for reading
41 # the perl manuals, though it too is written in perl.
43 # Version 1.1: Thu Nov 9 07:23:47 EST 1995
44 # Kenneth Albanowski <kjahds@kjahds.com>
46 # -added better error recognition (on no found pages, just exit. On
47 # missing nroff/pod2man, just display raw pod.)
48 # -added recursive/case-insensitive matching (thanks, Andreas). This
49 # slows things down a bit, unfortunately. Give a precise name, and
52 # Version 1.01: Tue May 30 14:47:34 EDT 1995
53 # Andy Dougherty <doughera@lafcol.lafayette.edu>
54 # -added pod documentation.
55 # -added PATH searching.
56 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
62 # Cache directories read during sloppy match
67 perldoc - Look up Perl documentation in pod format.
71 B<perldoc> [B<-h>] [B<-v>] PageName|ModuleName|ProgramName
75 I<perldoc> looks up a piece of documentation in .pod format that is
76 embedded in the perl installation tree or in a perl script, and displays
77 it via pod2man | nroff -man | $PAGER. This is primarily used for the
78 documentation for the perl library modules.
80 Your system may also have man pages installed for those modules, in
81 which case you can probably just use the man(1) command.
89 Prints out a brief help message.
93 Describes search for the item in detail.
95 =item B<PageName|ModuleName|ProgramName>
97 The item you want to look up. Nested modules (such as C<File::Basename>)
98 are specified either as C<File::Basename> or C<File/Basename>. You may also
99 give a descriptive name of a page, such as C<perlfunc>. You make also give a
100 partial or wrong-case name, such as "basename" for "File::Basename", but
101 this will be slower, if there is more then one page with the same partial
102 name, you will only get the first one.
108 Any switches in the C<PERLDOC> environment variable will be used before the
109 command line arguments. C<perldoc> also searches directories
110 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
111 defined) and C<PATH> environment variables.
112 (The latter is so that embedded pods for executables, such as
113 C<perldoc> itself, are available.)
117 Kenneth Albanowski <kjahds@kjahds.com>
119 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
129 Usage: $0 [-h] [-v] PageName|ModuleName|ProgramName
131 We suggest you use "perldoc perldoc" to get aquainted
141 perldoc [-h] [-v] PageName|ModuleName|ProgramName...
142 -h Display this help message.
143 -v Verbosely describe what's going on.
144 PageName|ModuleName...
145 is the name of a piece of documentation that you want to look at. You
146 may either give a descriptive name of the page (as in the case of
147 `perlfunc') the name of a module, either like `Term::Info',
148 `Term/Info', the partial name of a module, like `info', or
149 `makemaker', or the name of a program, like `perldoc'.
151 Any switches in the PERLDOC environment variable will be used before the
152 command line arguments.
157 use Text::ParseWords;
160 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
162 getopts("hv") || usage;
188 foreach $p (split(/\//, $file)){
191 } elsif (-f ("@p/$p")) {
197 while ($cip=readdir(DIR)) {
198 if (lc $cip eq $lcp){
204 return "" unless $found;
206 return "@p" if -f "@p";
209 return; # is not a file
213 my($recurse,$s,@dirs) = @_;
215 printf STDERR "looking for $s in @dirs\n" if $opt_v;
219 for ($i=0;$i<@dirs;$i++) {
221 if (( $ret = minus_f_nocase "$dir/$s.pod")
222 or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
223 or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
224 or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
225 or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
230 my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
232 print STDERR "Also looking in @newdirs\n" if $opt_v;
233 push(@dirs,@newdirs);
241 print STDERR "Searching for $_\n" if $opt_v;
242 # We must look both in @INC for library modules and in PATH
243 # for executables, like h2xs or perldoc itself.
245 push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
246 @files= searchfor(0,$_,@searchdirs);
248 print STDERR "Found as @files\n" if $opt_v;
250 # no match, try recursive search
252 @searchdirs = grep(!/^\.$/,@INC);
255 @files= searchfor(1,$_,@searchdirs);
257 print STDERR "Loosly found as @files\n" if $opt_v;
259 print STDERR "No documentation found for '$_'\n";
271 if( ! -t STDOUT ) { $opt_f = 1 }
275 $VMS = $Config::Config{'osname'} eq "VMS";
278 $tmp = "/tmp/perldoc1.$$";
279 $tmp2 = "/tmp/perldoc2.$$";
282 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
283 $tmp2 = 'Sys$Scratch:perldoc.tmp2_'.$$;
290 $rslt = `pod2man $_ | nroff -man`;
291 if ($VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
293 print TMP $rslt unless $err;
296 1 while unlink($tmp2); # Possibly pointless VMSism
298 if( $err or -z $tmp) {
301 print OUT while <IN>;
314 if( $ENV{PAGER} and system("$ENV{PAGER} $tmp")==$goodresult)
316 if( $Config{pager} and system("$Config{pager} $tmp")==$goodresult)
318 if( system("more $tmp")==$goodresult)
320 if( system("less $tmp")==$goodresult)
322 if( system("pg $tmp")==$goodresult)
324 if( system("view $tmp")==$goodresult)
329 1 while unlink($tmp); #Possibly pointless VMSism
334 close OUT or die "Can't close $file: $!";
335 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
336 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';