This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[win32] merge changes#872,873 from maintbranch
[perl5.git] / utils / perldoc.PL
CommitLineData
4633a7c4
LW
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
5
85880f03
PP
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
LW
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.
44a8e56a
PP
15chdir dirname($0);
16$file = basename($0, '.PL');
774d564b 17$file .= '.com' if $^O eq 'VMS';
4633a7c4
LW
18
19open OUT,">$file" or die "Can't create $file: $!";
20
21print "Extracting $file (with variable substitutions)\n";
22
23# In this section, perl variables will be expanded during extraction.
24# You can use $Config{...} to use Configure variables.
25
85880f03 26print OUT <<"!GROK!THIS!";
5f05dabc
PP
27$Config{startperl}
28 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
29 if \$running_under_some_shell;
55497cff
PP
30
31\@pagers = ();
32push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
4633a7c4
LW
33!GROK!THIS!
34
35# In the following, perl variables are not expanded during extraction.
36
37print OUT <<'!NO!SUBS!';
38
39#
40# Perldoc revision #1 -- look up a piece of documentation in .pod format that
41# is embedded in the perl installation tree.
42#
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.
4633a7c4
LW
46
47if(@ARGV<1) {
0b166b66 48 $me = $0; # Editing $0 is unportable
fb73857a 49 $me =~ s,.*/,,;
4633a7c4 50 die <<EOF;
89b8affa 51Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
0b166b66 52 $me -f PerlFunc
a3cb178b 53 $me -q FAQKeywords
4633a7c4 54
89b8affa
GS
55The -h option prints more help. Also try "perldoc perldoc" to get
56aquainted with the system.
4633a7c4
LW
57EOF
58}
59
60use Getopt::Std;
59586d77
IZ
61use Config '%Config';
62
fb73857a
PP
63@global_found = ();
64$global_target = "";
65
7eda7aea 66$Is_VMS = $^O eq 'VMS';
137443ea 67$Is_MSWin32 = $^O eq 'MSWin32';
0151c6ef 68$Is_Dos = $^O eq 'dos';
4633a7c4
LW
69
70sub usage{
ff0cee69
PP
71 warn "@_\n" if @_;
72 # Erase evidence of previous errors (if any), so exit status is simple.
73 $! = 0;
4633a7c4 74 die <<EOF;
31bdbec1
GA
75perldoc [options] PageName|ModuleName|ProgramName...
76perldoc [options] -f BuiltinFunction
a3cb178b 77perldoc [options] -q FAQRegex
31bdbec1
GA
78
79Options:
137443ea
PP
80 -h Display this help message
81 -t Display pod using pod2text instead of pod2man and nroff
82 (-t is the default on win32)
85880f03 83 -u Display unformatted pod text
a3cb178b
GS
84 -m Display module's file in its entirety
85 -l Display the module's file name
cce34969 86 -F Arguments are file names, not modules
137443ea 87 -v Verbosely describe what's going on
89b8affa 88 -X use index if present (looks for pod.idx at $Config{archlib})
31bdbec1 89
a3cb178b 90
4633a7c4
LW
91PageName|ModuleName...
92 is the name of a piece of documentation that you want to look at. You
93 may either give a descriptive name of the page (as in the case of
94 `perlfunc') the name of a module, either like `Term::Info',
95 `Term/Info', the partial name of a module, like `info', or
96 `makemaker', or the name of a program, like `perldoc'.
31bdbec1
GA
97
98BuiltinFunction
99 is the name of a perl function. Will extract documentation from
100 `perlfunc'.
a3cb178b
GS
101
102FAQRegex
103 is a regex. Will search perlfaq[1-9] for and extract any
104 questions that match.
105
4633a7c4 106Any switches in the PERLDOC environment variable will be used before the
89b8affa
GS
107command line arguments. The optional pod index file contains a list of
108filenames, one per line.
4633a7c4
LW
109
110EOF
111}
112
113use Text::ParseWords;
114
115
116unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
117
a3cb178b 118getopts("mhtluvFf:Xq:") || usage;
85880f03
PP
119
120usage if $opt_h || $opt_h; # avoid -w warning
4633a7c4 121
89b8affa
GS
122$podidx = "$Config{'archlib'}/pod.idx";
123$podidx = "" if $opt_X || !-f "pod.idx" && !-r _ && -M _ > 7;
124
137443ea
PP
125if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
126 usage("only one of -t, -u, -m or -l")
0151c6ef 127} elsif ($Is_MSWin32 || $Is_Dos) {
137443ea
PP
128 $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
129}
4633a7c4 130
7eda7aea 131if ($opt_t) { require Pod::Text; import Pod::Text; }
4633a7c4 132
31bdbec1
GA
133if ($opt_f) {
134 @pages = ("perlfunc");
a3cb178b
GS
135} elsif ($opt_q) {
136 @pages = ("perlfaq1" .. "perlfaq9");
31bdbec1
GA
137} else {
138 @pages = @ARGV;
139}
140
fb73857a
PP
141# Does this look like a module or extension directory?
142if (-f "Makefile.PL") {
143 # Add ., lib and blib/* libs to @INC (if they exist)
144 unshift(@INC, '.');
145 unshift(@INC, 'lib') if -d 'lib';
146 require ExtUtils::testlib;
147}
148
31bdbec1 149
85880f03 150
4633a7c4 151sub containspod {
fb73857a
PP
152 my($file, $readit) = @_;
153 return 1 if !$readit && $file =~ /\.pod$/i;
154 local($_);
155 open(TEST,"<$file");
156 while(<TEST>) {
157 if(/^=head/) {
158 close(TEST);
159 return 1;
4633a7c4 160 }
fb73857a
PP
161 }
162 close(TEST);
163 return 0;
4633a7c4
LW
164}
165
84902520 166sub minus_f_nocase {
4633a7c4 167 my($file) = @_;
84902520 168 # on a case-forgiving file system we can simply use -f $file
0151c6ef 169 if ($Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
fb73857a 170 return $file if -f $file and -r _;
2d7a9237 171 warn "Ignored $file: unreadable\n" if -f _;
fb73857a 172 return '';
84902520 173 }
4633a7c4
LW
174 local *DIR;
175 local($")="/";
176 my(@p,$p,$cip);
177 foreach $p (split(/\//, $file)){
fb73857a
PP
178 my $try = "@p/$p";
179 stat $try;
180 if (-d _){
4633a7c4 181 push @p, $p;
fb73857a
PP
182 if ( $p eq $global_target) {
183 $tmp_path = join ('/', @p);
184 my $path_f = 0;
185 for (@global_found) {
186 $path_f = 1 if $_ eq $tmp_path;
187 }
188 push (@global_found, $tmp_path) unless $path_f;
189 print STDERR "Found as @p but directory\n" if $opt_v;
190 }
191 } elsif (-f _ && -r _) {
192 return $try;
193 } elsif (-f _) {
194 warn "Ignored $try: unreadable\n";
4633a7c4
LW
195 } else {
196 my $found=0;
197 my $lcp = lc $p;
198 opendir DIR, "@p";
199 while ($cip=readdir(DIR)) {
200 if (lc $cip eq $lcp){
201 $found++;
202 last;
203 }
204 }
205 closedir DIR;
206 return "" unless $found;
207 push @p, $cip;
fb73857a
PP
208 return "@p" if -f "@p" and -r _;
209 warn "Ignored $file: unreadable\n" if -f _;
4633a7c4
LW
210 }
211 }
212 return; # is not a file
fb73857a 213}
4633a7c4 214
fb73857a
PP
215
216sub check_file {
217 my($file) = @_;
a3cb178b
GS
218 $file = minus_f_nocase($file);
219 return "" unless $file;
220 return $file if $::opt_m;
221 return $file if containspod($file);
222 return "";
fb73857a
PP
223}
224
225
226sub searchfor {
227 my($recurse,$s,@dirs) = @_;
228 $s =~ s!::!/!g;
229 $s = VMS::Filespec::unixify($s) if $Is_VMS;
230 return $s if -f $s && containspod($s);
231 printf STDERR "Looking for $s in @dirs\n" if $opt_v;
232 my $ret;
233 my $i;
234 my $dir;
235 $global_target = (split('/', $s))[-1];
236 for ($i=0; $i<@dirs; $i++) {
237 $dir = $dirs[$i];
238 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
239 if ( ( $ret = check_file "$dir/$s.pod")
240 or ( $ret = check_file "$dir/$s.pm")
241 or ( $ret = check_file "$dir/$s")
242 or ( $Is_VMS and
243 $ret = check_file "$dir/$s.com")
59586d77 244 or ( $^O eq 'os2' and
fb73857a 245 $ret = check_file "$dir/$s.cmd")
0151c6ef 246 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
fb73857a
PP
247 $ret = check_file "$dir/$s.bat")
248 or ( $ret = check_file "$dir/pod/$s.pod")
249 or ( $ret = check_file "$dir/pod/$s")
250 ) {
251 return $ret;
252 }
253
254 if ($recurse) {
255 opendir(D,$dir);
256 my @newdirs = map "$dir/$_", grep {
257 not /^\.\.?$/ and
258 not /^auto$/ and # save time! don't search auto dirs
259 -d "$dir/$_"
260 } readdir D;
261 closedir(D);
262 next unless @newdirs;
263 @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
264 print STDERR "Also looking in @newdirs\n" if $opt_v;
265 push(@dirs,@newdirs);
266 }
267 }
268 return ();
269}
4633a7c4
LW
270
271
272foreach (@pages) {
89b8affa
GS
273 if ($podidx && open(PODIDX, $podidx)) {
274 my $searchfor = $_;
275 local($_);
276 $searchfor =~ s,::,/,g;
277 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
278 while (<PODIDX>) {
279 chomp;
280 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
281 }
282 close(PODIDX);
283 next;
284 }
4633a7c4
LW
285 print STDERR "Searching for $_\n" if $opt_v;
286 # We must look both in @INC for library modules and in PATH
287 # for executables, like h2xs or perldoc itself.
288 @searchdirs = @INC;
cce34969
IZ
289 if ($opt_F) {
290 next unless -r;
291 push @found, $_ if $opt_m or containspod($_);
292 next;
293 }
7eda7aea
PP
294 unless ($opt_m) {
295 if ($Is_VMS) {
296 my($i,$trn);
297 for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
298 push(@searchdirs,$trn);
299 }
09b7f37c 300 push(@dirs,'perl_root:[lib.pod]') # installed pods
7eda7aea 301 } else {
59586d77
IZ
302 push(@searchdirs, grep(-d, split($Config{path_sep},
303 $ENV{'PATH'})));
7eda7aea
PP
304 }
305 @files= searchfor(0,$_,@searchdirs);
85880f03 306 }
4633a7c4
LW
307 if( @files ) {
308 print STDERR "Found as @files\n" if $opt_v;
309 } else {
310 # no match, try recursive search
311
312 @searchdirs = grep(!/^\.$/,@INC);
313
4633a7c4
LW
314 @files= searchfor(1,$_,@searchdirs);
315 if( @files ) {
85880f03 316 print STDERR "Loosely found as @files\n" if $opt_v;
4633a7c4 317 } else {
fb73857a
PP
318 print STDERR "No documentation found for \"$_\".\n";
319 if (@global_found) {
320 print STDERR "However, try\n";
321 my $dir = $file = "";
322 for $dir (@global_found) {
323 opendir(DIR, $dir) or die "$!";
324 while ($file = readdir(DIR)) {
325 next if ($file =~ /^\./);
326 $file =~ s/\.(pm|pod)$//;
327 print STDERR "\tperldoc $_\::$file\n";
328 }
329 closedir DIR;
330 }
331 }
4633a7c4
LW
332 }
333 }
334 push(@found,@files);
335}
336
337if(!@found) {
85880f03 338 exit ($Is_VMS ? 98962 : 1);
4633a7c4
LW
339}
340
44a8e56a
PP
341if ($opt_l) {
342 print join("\n", @found), "\n";
343 exit;
344}
345
31bdbec1 346if( ! -t STDOUT ) { $no_tty = 1 }
4633a7c4 347
137443ea
PP
348if ($Is_MSWin32) {
349 $tmp = "$ENV{TEMP}\\perldoc1.$$";
350 push @pagers, qw( more< less notepad );
55497cff 351 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea 352} elsif ($Is_VMS) {
4633a7c4 353 $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
55497cff 354 push @pagers, qw( most more less type/page );
0151c6ef
ML
355} elsif ($Is_Dos) {
356 $tmp = "$ENV{TEMP}/perldoc1.$$";
357 $tmp =~ tr!\\/!//!s;
358 push @pagers, qw( less.exe more.com< );
359 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea 360} else {
59586d77
IZ
361 if ($^O eq 'os2') {
362 require POSIX;
363 $tmp = POSIX::tmpnam();
364 } else {
365 $tmp = "/tmp/perldoc1.$$";
366 }
137443ea
PP
367 push @pagers, qw( more less pg view cat );
368 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
4633a7c4 369}
44a8e56a 370unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
4633a7c4 371
7eda7aea 372if ($opt_m) {
1e422769
PP
373 foreach $pager (@pagers) {
374 system("$pager @found") or exit;
375 }
376 if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
377 exit 1;
7eda7aea
PP
378}
379
31bdbec1
GA
380if ($opt_f) {
381 my $perlfunc = shift @found;
382 open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
383
384 # Skip introduction
385 while (<PFUNC>) {
386 last if /^=head2 Alphabetical Listing of Perl Functions/;
387 }
388
389 # Look for our function
390 my $found = 0;
fb73857a 391 my @pod;
31bdbec1
GA
392 while (<PFUNC>) {
393 if (/^=item\s+\Q$opt_f\E\b/o) {
fb73857a 394 $found = 1;
31bdbec1 395 } elsif (/^=item/) {
fb73857a 396 last if $found > 1;
31bdbec1 397 }
fb73857a
PP
398 next unless $found;
399 push @pod, $_;
400 ++$found if /^\w/; # found descriptive text
31bdbec1
GA
401 }
402 if (@pod) {
43051805
GS
403 my $lines = $ENV{LINES} || 24;
404
31bdbec1
GA
405 if ($opt_t) {
406 open(FORMATTER, "| pod2text") || die "Can't start filter";
407 print FORMATTER "=over 8\n\n";
408 print FORMATTER @pod;
409 print FORMATTER "=back\n";
410 close(FORMATTER);
43051805 411 } elsif (@pod < $lines-2) {
31bdbec1 412 print @pod;
43051805
GS
413 } else {
414 foreach $pager (@pagers) {
415 open (PAGER, "| $pager") or next;
416 print PAGER @pod ;
417 close(PAGER) or next;
418 last;
419 }
31bdbec1
GA
420 }
421 } else {
ed5c9e50 422 die "No documentation for perl function `$opt_f' found\n";
31bdbec1
GA
423 }
424 exit;
425}
426
a3cb178b
GS
427if ($opt_q) {
428 local @ARGV = @found; # I'm lazy, sue me.
429 my $found = 0;
430 my %found_in;
431 my @pod;
432
433 while (<>) {
434 if (/^=head2\s+.*$opt_q/oi) {
435 $found = 1;
436 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
437 } elsif (/^=head2/) {
438 $found = 0;
439 }
440 next unless $found;
441 push @pod, $_;
442 }
443
444 if (@pod) {
445 if ($opt_t) {
446 open(FORMATTER, "| pod2text") || die "Can't start filter";
447 print FORMATTER "=over 8\n\n";
448 print FORMATTER @pod;
449 print FORMATTER "=back\n";
450 close(FORMATTER);
451 } else {
452 print @pod;
453 }
454 } else {
455 die "No documentation for perl function `$opt_f' found\n";
456 }
457 exit;
458}
459
4633a7c4 460foreach (@found) {
7eda7aea 461
85880f03
PP
462 if($opt_t) {
463 open(TMP,">>$tmp");
464 Pod::Text::pod2text($_,*TMP);
465 close(TMP);
466 } elsif(not $opt_u) {
1e422769
PP
467 my $cmd = "pod2man --lax $_ | nroff -man";
468 $cmd .= " | col -x" if $^O =~ /hpux/;
469 $rslt = `$cmd`;
470 unless(($err = $?)) {
471 open(TMP,">>$tmp");
472 print TMP $rslt;
473 close TMP;
40fc7247 474 }
85880f03 475 }
4633a7c4 476
85880f03 477 if( $opt_u or $err or -z $tmp) {
4633a7c4
LW
478 open(OUT,">>$tmp");
479 open(IN,"<$_");
85880f03
PP
480 $cut = 1;
481 while (<IN>) {
482 $cut = $1 eq 'cut' if /^=(\w+)/;
483 next if $cut;
484 print OUT;
485 }
4633a7c4
LW
486 close(IN);
487 close(OUT);
488 }
489}
490
31bdbec1 491if( $no_tty ) {
4633a7c4
LW
492 open(TMP,"<$tmp");
493 print while <TMP>;
494 close(TMP);
495} else {
85880f03 496 foreach $pager (@pagers) {
1e422769 497 system("$pager $tmp") or last;
4633a7c4
LW
498 }
499}
500
5011 while unlink($tmp); #Possibly pointless VMSism
502
503exit 0;
7eda7aea
PP
504
505__END__
506
507=head1 NAME
508
509perldoc - Look up Perl documentation in pod format.
510
511=head1 SYNOPSIS
512
89b8affa 513B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
7eda7aea 514
31bdbec1
GA
515B<perldoc> B<-f> BuiltinFunction
516
7eda7aea
PP
517=head1 DESCRIPTION
518
40fc7247
PP
519I<perldoc> looks up a piece of documentation in .pod format that is embedded
520in the perl installation tree or in a perl script, and displays it via
521C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
522C<col -x> will be used.) This is primarily used for the documentation for
523the perl library modules.
7eda7aea
PP
524
525Your system may also have man pages installed for those modules, in
526which case you can probably just use the man(1) command.
527
528=head1 OPTIONS
529
530=over 5
531
532=item B<-h> help
533
534Prints out a brief help message.
535
536=item B<-v> verbose
537
538Describes search for the item in detail.
539
540=item B<-t> text output
541
542Display docs using plain text converter, instead of nroff. This may be faster,
543but it won't look as nice.
544
545=item B<-u> unformatted
546
547Find docs only; skip reformatting by pod2*
548
549=item B<-m> module
550
551Display the entire module: both code and unformatted pod documentation.
552This may be useful if the docs don't explain a function in the detail
553you need, and you'd like to inspect the code directly; perldoc will find
554the file for you and simply hand it off for display.
555
44a8e56a
PP
556=item B<-l> file name only
557
558Display the file name of the module found.
559
cce34969
IZ
560=item B<-F> file names
561
89b8affa 562Consider arguments as file names, no search in directories will be performed.
cce34969 563
31bdbec1
GA
564=item B<-f> perlfunc
565
566The B<-f> option followed by the name of a perl built in function will
567extract the documentation of this function from L<perlfunc>.
568
89b8affa
GS
569=item B<-X> use an index if present
570
571The B<-X> option looks for a entry whose basename matches the name given on the
572command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
573contain fully qualified filenames, one per line.
574
7eda7aea
PP
575=item B<PageName|ModuleName|ProgramName>
576
577The item you want to look up. Nested modules (such as C<File::Basename>)
578are specified either as C<File::Basename> or C<File/Basename>. You may also
579give a descriptive name of a page, such as C<perlfunc>. You make also give a
580partial or wrong-case name, such as "basename" for "File::Basename", but
581this will be slower, if there is more then one page with the same partial
582name, you will only get the first one.
583
584=back
585
586=head1 ENVIRONMENT
587
588Any switches in the C<PERLDOC> environment variable will be used before the
589command line arguments. C<perldoc> also searches directories
590specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
591defined) and C<PATH> environment variables.
592(The latter is so that embedded pods for executables, such as
a3cb178b
GS
593C<perldoc> itself, are available.) C<perldoc> will use, in order of
594preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
595C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
596used if C<perldoc> was told to display plain text or unformatted pod.)
7eda7aea
PP
597
598=head1 AUTHOR
599
600Kenneth Albanowski <kjahds@kjahds.com>
601
602Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
603
7eda7aea
PP
604=cut
605
606#
89b8affa
GS
607# Version 1.13: Fri Feb 27 16:20:50 EST 1997
608# Gurusamy Sarathy <gsar@umich.edu>
609# -doc tweaks for -F and -X options
137443ea
PP
610# Version 1.12: Sat Apr 12 22:41:09 EST 1997
611# Gurusamy Sarathy <gsar@umich.edu>
612# -various fixes for win32
7eda7aea
PP
613# Version 1.11: Tue Dec 26 09:54:33 EST 1995
614# Kenneth Albanowski <kjahds@kjahds.com>
615# -added Charles Bailey's further VMS patches, and -u switch
616# -added -t switch, with pod2text support
617#
618# Version 1.10: Thu Nov 9 07:23:47 EST 1995
619# Kenneth Albanowski <kjahds@kjahds.com>
620# -added VMS support
621# -added better error recognition (on no found pages, just exit. On
622# missing nroff/pod2man, just display raw pod.)
623# -added recursive/case-insensitive matching (thanks, Andreas). This
624# slows things down a bit, unfortunately. Give a precise name, and
625# it'll run faster.
626#
627# Version 1.01: Tue May 30 14:47:34 EDT 1995
628# Andy Dougherty <doughera@lafcol.lafayette.edu>
629# -added pod documentation.
630# -added PATH searching.
631# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
632# and friends.
633#
634#
635# TODO:
636#
637# Cache directories read during sloppy match
4633a7c4
LW
638!NO!SUBS!
639
640close OUT or die "Can't close $file: $!";
641chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
642exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';