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)) =~ s/\.PL$//;
18 if ($Config{'osname'} eq 'VMS' or
19 $Config{'osname'} eq 'OS2'); # "case-forgiving"
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 perl -S \$0 "\$@"'
34 # In the following, perl variables are not expanded during extraction.
36 print OUT <<'!NO!SUBS!';
37 eval 'exec perl -S $0 "$@"'
41 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
42 # is embedded in the perl installation tree.
44 # This is not to be confused with Tom Christianson's perlman, which is a
45 # man replacement, written in perl. This perldoc is strictly for reading
46 # the perl manuals, though it too is written in perl.
48 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
49 # Kenneth Albanowski <kjahds@kjahds.com>
50 # -added Charles Bailey's further VMS patches, and -u switch
51 # -added -t switch, with pod2text support
53 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
54 # Kenneth Albanowski <kjahds@kjahds.com>
56 # -added better error recognition (on no found pages, just exit. On
57 # missing nroff/pod2man, just display raw pod.)
58 # -added recursive/case-insensitive matching (thanks, Andreas). This
59 # slows things down a bit, unfortunately. Give a precise name, and
62 # Version 1.01: Tue May 30 14:47:34 EDT 1995
63 # Andy Dougherty <doughera@lafcol.lafayette.edu>
64 # -added pod documentation.
65 # -added PATH searching.
66 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
72 # Cache directories read during sloppy match
77 perldoc - Look up Perl documentation in pod format.
81 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] PageName|ModuleName|ProgramName
85 I<perldoc> looks up a piece of documentation in .pod format that is
86 embedded in the perl installation tree or in a perl script, and displays
87 it via pod2man | nroff -man | $PAGER. This is primarily used for the
88 documentation for the perl library modules.
90 Your system may also have man pages installed for those modules, in
91 which case you can probably just use the man(1) command.
99 Prints out a brief help message.
103 Describes search for the item in detail.
105 =item B<-t> text output
107 Display docs using plain text converter, instead of nroff. This may be faster,
108 but it won't look as nice.
110 =item B<-u> unformatted
112 Find docs only; skip reformatting by pod2*
114 =item B<PageName|ModuleName|ProgramName>
116 The item you want to look up. Nested modules (such as C<File::Basename>)
117 are specified either as C<File::Basename> or C<File/Basename>. You may also
118 give a descriptive name of a page, such as C<perlfunc>. You make also give a
119 partial or wrong-case name, such as "basename" for "File::Basename", but
120 this will be slower, if there is more then one page with the same partial
121 name, you will only get the first one.
127 Any switches in the C<PERLDOC> environment variable will be used before the
128 command line arguments. C<perldoc> also searches directories
129 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
130 defined) and C<PATH> environment variables.
131 (The latter is so that embedded pods for executables, such as
132 C<perldoc> itself, are available.)
136 Kenneth Albanowski <kjahds@kjahds.com>
138 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
148 Usage: $0 [-h] [-v] [-t] [-u] PageName|ModuleName|ProgramName
150 We suggest you use "perldoc perldoc" to get aquainted
157 $Is_VMS = $Config{'osname'} eq 'VMS';
162 perldoc [-h] [-v] [-u] PageName|ModuleName|ProgramName...
163 -h Display this help message.
164 -t Display pod using pod2text instead of pod2man and nroff.
165 -u Display unformatted pod text
166 -v Verbosely describe what's going on.
167 PageName|ModuleName...
168 is the name of a piece of documentation that you want to look at. You
169 may either give a descriptive name of the page (as in the case of
170 `perlfunc') the name of a module, either like `Term::Info',
171 `Term/Info', the partial name of a module, like `info', or
172 `makemaker', or the name of a program, like `perldoc'.
174 Any switches in the PERLDOC environment variable will be used before the
175 command line arguments.
180 use Text::ParseWords;
183 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
185 getopts("htuv") || usage;
187 usage if $opt_h || $opt_h; # avoid -w warning
189 eval "use Pod::Text" if $opt_t;
193 # VMS only -- use this hack until support for searchlist
194 # logical names is better integrated into the Perl core
195 sub translate_searchlist_logical {
198 return unless $ENV{$lnm};
199 $trans = `show logical $lnm`;
200 $trans =~ s/\n1(.|\n)*//; # clip off iterative translations
201 @trans = split(/[\"=\s\n]+/,$trans); # break into words
202 splice(@trans,0,2); # pop off initial blank and orig name
203 @trans = grep(!/^\(/,@trans); # filter out table names
204 wantarray ? @trans : $trans[0];
226 foreach $p (split(/\//, $file)){
227 if ($Is_VMS and not scalar @p) {
228 # VMS filesystems don't begin at '/'
234 } elsif (-f ("@p/$p")) {
240 while ($cip=readdir(DIR)) {
241 $cip =~ s/\.dir$// if $Is_VMS;
242 if (lc $cip eq $lcp){
248 return "" unless $found;
250 return "@p" if -f "@p";
253 return; # is not a file
257 my($recurse,$s,@dirs) = @_;
259 $s = VMS::Filespec::unixify($s) if $Is_VMS;
260 printf STDERR "looking for $s in @dirs\n" if $opt_v;
264 for ($i=0;$i<@dirs;$i++) {
266 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
267 if (( $ret = minus_f_nocase "$dir/$s.pod")
268 or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
269 or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
271 $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
272 or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
273 or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
278 my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
280 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
281 last unless @newdirs;
282 print STDERR "Also looking in @newdirs\n" if $opt_v;
283 push(@dirs,@newdirs);
291 print STDERR "Searching for $_\n" if $opt_v;
292 # We must look both in @INC for library modules and in PATH
293 # for executables, like h2xs or perldoc itself.
296 push(@searchdirs, translate_searchlist_logical('DCL$PATH'));
298 push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
300 @files= searchfor(0,$_,@searchdirs);
302 print STDERR "Found as @files\n" if $opt_v;
304 # no match, try recursive search
306 @searchdirs = grep(!/^\.$/,@INC);
309 @files= searchfor(1,$_,@searchdirs);
311 print STDERR "Loosely found as @files\n" if $opt_v;
313 print STDERR "No documentation found for '$_'\n";
320 exit ($Is_VMS ? 98962 : 1);
323 if( ! -t STDOUT ) { $opt_f = 1 }
326 $tmp = "/tmp/perldoc1.$$";
328 @pagers = qw( more less pg view cat );
329 unshift(@pagers,$ENV{PAGER}) if $ENV{PAGER};
331 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
332 @pagers = qw( most more less type/page );
333 unshift(@pagers,$ENV{PERLDOC_PAGER}) if $ENV{PERLDOC_PAGER};
341 Pod::Text::pod2text($_,*TMP);
343 } elsif(not $opt_u) {
345 $rslt = `pod2man $_ | nroff -man`;
346 if ($Is_VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
348 print TMP $rslt unless $err;
352 if( $opt_u or $err or -z $tmp) {
357 $cut = $1 eq 'cut' if /^=(\w+)/;
371 foreach $pager (@pagers) {
372 $sts = system("$pager $tmp");
373 last if $Is_VMS && ($sts & 1);
378 1 while unlink($tmp); #Possibly pointless VMSism
383 close OUT or die "Can't close $file: $!";
384 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
385 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';