[inseparable changes from patch from perl5.003_12 to perl5.003_13]
[p5sagit/p5-mst-13.2.git] / utils / perldoc.PL
CommitLineData
4633a7c4 1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
5
85880f03 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
4633a7c4 10# $startperl
85880f03 11# to ensure Configure will look for $Config{startperl}.
4633a7c4 12
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.
15chdir(dirname($0));
16($file = basename($0)) =~ s/\.PL$//;
17$file =~ s/\.pl$//
7eda7aea 18 if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
4633a7c4 19
20open OUT,">$file" or die "Can't create $file: $!";
21
22print "Extracting $file (with variable substitutions)\n";
23
24# In this section, perl variables will be expanded during extraction.
25# You can use $Config{...} to use Configure variables.
26
85880f03 27print OUT <<"!GROK!THIS!";
5f05dabc 28$Config{startperl}
29 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
30 if \$running_under_some_shell;
55497cff 31
32\@pagers = ();
33push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
4633a7c4 34!GROK!THIS!
35
36# In the following, perl variables are not expanded during extraction.
37
38print OUT <<'!NO!SUBS!';
39
40#
41# Perldoc revision #1 -- look up a piece of documentation in .pod format that
42# is embedded in the perl installation tree.
43#
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.
4633a7c4 47
48if(@ARGV<1) {
49 die <<EOF;
7eda7aea 50Usage: $0 [-h] [-v] [-t] [-u] [-m] PageName|ModuleName|ProgramName
4633a7c4 51
52We suggest you use "perldoc perldoc" to get aquainted
53with the system.
54EOF
55}
56
57use Getopt::Std;
7eda7aea 58$Is_VMS = $^O eq 'VMS';
4633a7c4 59
60sub usage{
61 warn "@_\n" if @_;
36477c24 62 # Make sure exit status is success under VMS, so shell doesn't
63 # display error messages left over from startup.
64 ($! = 0, $^E = 1) if $^O eq 'VMS';
4633a7c4 65 die <<EOF;
85880f03 66perldoc [-h] [-v] [-u] PageName|ModuleName|ProgramName...
4633a7c4 67 -h Display this help message.
85880f03 68 -t Display pod using pod2text instead of pod2man and nroff.
69 -u Display unformatted pod text
7eda7aea 70 -m Display modules file in its entirety
4633a7c4 71 -v Verbosely describe what's going on.
72PageName|ModuleName...
73 is the name of a piece of documentation that you want to look at. You
74 may either give a descriptive name of the page (as in the case of
75 `perlfunc') the name of a module, either like `Term::Info',
76 `Term/Info', the partial name of a module, like `info', or
77 `makemaker', or the name of a program, like `perldoc'.
78
79Any switches in the PERLDOC environment variable will be used before the
80command line arguments.
81
82EOF
83}
84
85use Text::ParseWords;
86
87
88unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
89
7eda7aea 90getopts("mhtuv") || usage;
85880f03 91
92usage if $opt_h || $opt_h; # avoid -w warning
4633a7c4 93
7eda7aea 94usage("only one of -t, -u, or -m") if $opt_t + $opt_u + $opt_m > 1;
4633a7c4 95
7eda7aea 96if ($opt_t) { require Pod::Text; import Pod::Text; }
4633a7c4 97
7eda7aea 98@pages = @ARGV;
85880f03 99
4633a7c4 100sub containspod {
101 my($file) = @_;
102 local($_);
103 open(TEST,"<$file");
104 while(<TEST>) {
105 if(/^=head/) {
106 close(TEST);
107 return 1;
108 }
109 }
110 close(TEST);
111 return 0;
112}
113
114 sub minus_f_nocase {
115 my($file) = @_;
116 local *DIR;
117 local($")="/";
118 my(@p,$p,$cip);
119 foreach $p (split(/\//, $file)){
9c9e9fb7 120 if (($Is_VMS or $^O eq 'os2') and not scalar @p) {
121 # VMSish filesystems don't begin at '/'
85880f03 122 push(@p,$p);
123 next;
124 }
4633a7c4 125 if (-d ("@p/$p")){
126 push @p, $p;
127 } elsif (-f ("@p/$p")) {
128 return "@p/$p";
129 } else {
130 my $found=0;
131 my $lcp = lc $p;
132 opendir DIR, "@p";
133 while ($cip=readdir(DIR)) {
85880f03 134 $cip =~ s/\.dir$// if $Is_VMS;
4633a7c4 135 if (lc $cip eq $lcp){
136 $found++;
137 last;
138 }
139 }
140 closedir DIR;
141 return "" unless $found;
142 push @p, $cip;
143 return "@p" if -f "@p";
144 }
145 }
146 return; # is not a file
147 }
148
149 sub searchfor {
150 my($recurse,$s,@dirs) = @_;
151 $s =~ s!::!/!g;
85880f03 152 $s = VMS::Filespec::unixify($s) if $Is_VMS;
4633a7c4 153 printf STDERR "looking for $s in @dirs\n" if $opt_v;
154 my $ret;
155 my $i;
156 my $dir;
157 for ($i=0;$i<@dirs;$i++) {
158 $dir = $dirs[$i];
85880f03 159 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
4633a7c4 160 if (( $ret = minus_f_nocase "$dir/$s.pod")
161 or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
162 or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
85880f03 163 or ( $Is_VMS and
164 $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
4633a7c4 165 or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
166 or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
167 { return $ret; }
168
169 if($recurse) {
170 opendir(D,$dir);
171 my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
172 closedir(D);
85880f03 173 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
7eda7aea 174 next unless @newdirs;
4633a7c4 175 print STDERR "Also looking in @newdirs\n" if $opt_v;
176 push(@dirs,@newdirs);
177 }
178 }
179 return ();
180 }
181
182
183foreach (@pages) {
184 print STDERR "Searching for $_\n" if $opt_v;
185 # We must look both in @INC for library modules and in PATH
186 # for executables, like h2xs or perldoc itself.
187 @searchdirs = @INC;
7eda7aea 188 unless ($opt_m) {
189 if ($Is_VMS) {
190 my($i,$trn);
191 for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
192 push(@searchdirs,$trn);
193 }
194 } else {
195 push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
196 }
197 @files= searchfor(0,$_,@searchdirs);
85880f03 198 }
4633a7c4 199 if( @files ) {
200 print STDERR "Found as @files\n" if $opt_v;
201 } else {
202 # no match, try recursive search
203
204 @searchdirs = grep(!/^\.$/,@INC);
205
206
207 @files= searchfor(1,$_,@searchdirs);
208 if( @files ) {
85880f03 209 print STDERR "Loosely found as @files\n" if $opt_v;
4633a7c4 210 } else {
211 print STDERR "No documentation found for '$_'\n";
212 }
213 }
214 push(@found,@files);
215}
216
217if(!@found) {
85880f03 218 exit ($Is_VMS ? 98962 : 1);
4633a7c4 219}
220
4633a7c4 221if( ! -t STDOUT ) { $opt_f = 1 }
222
85880f03 223unless($Is_VMS) {
4633a7c4 224 $tmp = "/tmp/perldoc1.$$";
55497cff 225 push @pagers, qw( more less pg view cat );
226 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
4633a7c4 227 $goodresult = 0;
228} else {
229 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
55497cff 230 push @pagers, qw( most more less type/page );
231 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
4633a7c4 232 $goodresult = 1;
233}
234
7eda7aea 235if ($opt_m) {
236 foreach $pager (@pagers) {
237 my($sts) = system("$pager @found");
238 exit 0 if ($Is_VMS ? ($sts & 1) : !$sts);
239 }
240 exit $Is_VMS ? $sts : 1;
241}
242
4633a7c4 243foreach (@found) {
7eda7aea 244
85880f03 245 if($opt_t) {
246 open(TMP,">>$tmp");
247 Pod::Text::pod2text($_,*TMP);
248 close(TMP);
249 } elsif(not $opt_u) {
250 open(TMP,">>$tmp");
40fc7247 251 if($^O =~ /hpux/) {
252 $rslt = `pod2man $_ | nroff -man | col -x`;
253 } else {
254 $rslt = `pod2man $_ | nroff -man`;
255 }
85880f03 256 if ($Is_VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
257 else { $err = $?; }
258 print TMP $rslt unless $err;
259 close TMP;
260 }
4633a7c4 261
85880f03 262 if( $opt_u or $err or -z $tmp) {
4633a7c4 263 open(OUT,">>$tmp");
264 open(IN,"<$_");
85880f03 265 $cut = 1;
266 while (<IN>) {
267 $cut = $1 eq 'cut' if /^=(\w+)/;
268 next if $cut;
269 print OUT;
270 }
4633a7c4 271 close(IN);
272 close(OUT);
273 }
274}
275
276if( $opt_f ) {
277 open(TMP,"<$tmp");
278 print while <TMP>;
279 close(TMP);
280} else {
85880f03 281 foreach $pager (@pagers) {
282 $sts = system("$pager $tmp");
283 last if $Is_VMS && ($sts & 1);
284 last unless $sts;
4633a7c4 285 }
286}
287
2881 while unlink($tmp); #Possibly pointless VMSism
289
290exit 0;
7eda7aea 291
292__END__
293
294=head1 NAME
295
296perldoc - Look up Perl documentation in pod format.
297
298=head1 SYNOPSIS
299
300B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] PageName|ModuleName|ProgramName
301
302=head1 DESCRIPTION
303
40fc7247 304I<perldoc> looks up a piece of documentation in .pod format that is embedded
305in the perl installation tree or in a perl script, and displays it via
306C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
307C<col -x> will be used.) This is primarily used for the documentation for
308the perl library modules.
7eda7aea 309
310Your system may also have man pages installed for those modules, in
311which case you can probably just use the man(1) command.
312
313=head1 OPTIONS
314
315=over 5
316
317=item B<-h> help
318
319Prints out a brief help message.
320
321=item B<-v> verbose
322
323Describes search for the item in detail.
324
325=item B<-t> text output
326
327Display docs using plain text converter, instead of nroff. This may be faster,
328but it won't look as nice.
329
330=item B<-u> unformatted
331
332Find docs only; skip reformatting by pod2*
333
334=item B<-m> module
335
336Display the entire module: both code and unformatted pod documentation.
337This may be useful if the docs don't explain a function in the detail
338you need, and you'd like to inspect the code directly; perldoc will find
339the file for you and simply hand it off for display.
340
341=item B<PageName|ModuleName|ProgramName>
342
343The item you want to look up. Nested modules (such as C<File::Basename>)
344are specified either as C<File::Basename> or C<File/Basename>. You may also
345give a descriptive name of a page, such as C<perlfunc>. You make also give a
346partial or wrong-case name, such as "basename" for "File::Basename", but
347this will be slower, if there is more then one page with the same partial
348name, you will only get the first one.
349
350=back
351
352=head1 ENVIRONMENT
353
354Any switches in the C<PERLDOC> environment variable will be used before the
355command line arguments. C<perldoc> also searches directories
356specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
357defined) and C<PATH> environment variables.
358(The latter is so that embedded pods for executables, such as
359C<perldoc> itself, are available.)
360
361=head1 AUTHOR
362
363Kenneth Albanowski <kjahds@kjahds.com>
364
365Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
366
367=head1 SEE ALSO
368
369=head1 DIAGNOSTICS
370
371=cut
372
373#
374# Version 1.11: Tue Dec 26 09:54:33 EST 1995
375# Kenneth Albanowski <kjahds@kjahds.com>
376# -added Charles Bailey's further VMS patches, and -u switch
377# -added -t switch, with pod2text support
378#
379# Version 1.10: Thu Nov 9 07:23:47 EST 1995
380# Kenneth Albanowski <kjahds@kjahds.com>
381# -added VMS support
382# -added better error recognition (on no found pages, just exit. On
383# missing nroff/pod2man, just display raw pod.)
384# -added recursive/case-insensitive matching (thanks, Andreas). This
385# slows things down a bit, unfortunately. Give a precise name, and
386# it'll run faster.
387#
388# Version 1.01: Tue May 30 14:47:34 EDT 1995
389# Andy Dougherty <doughera@lafcol.lafayette.edu>
390# -added pod documentation.
391# -added PATH searching.
392# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
393# and friends.
394#
395#
396# TODO:
397#
398# Cache directories read during sloppy match
4633a7c4 399!NO!SUBS!
400
401close OUT or die "Can't close $file: $!";
402chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
403exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';