[REPATCH] Re: [PATCH] Re: socketpair blip on unicos/mk, too
[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);
8a5546a1 5use Cwd;
4633a7c4 6
85880f03 7# List explicitly here the variables you want Configure to
8# generate. Metaconfig only looks for shell variables, so you
9# have to mention them as if they were shell variables, not
10# %Config entries. Thus you write
4633a7c4 11# $startperl
85880f03 12# to ensure Configure will look for $Config{startperl}.
4633a7c4 13
14# This forces PL files to create target in same directory as PL file.
15# This is so that make depend always knows where to find PL derivatives.
8a5546a1 16$origdir = cwd;
44a8e56a 17chdir dirname($0);
18$file = basename($0, '.PL');
774d564b 19$file .= '.com' if $^O eq 'VMS';
4633a7c4 20
21open OUT,">$file" or die "Can't create $file: $!";
22
23print "Extracting $file (with variable substitutions)\n";
24
25# In this section, perl variables will be expanded during extraction.
26# You can use $Config{...} to use Configure variables.
27
c6a5b0b7 28my $versiononly = $Config{versiononly} ? $Config{version} : '';
29
85880f03 30print OUT <<"!GROK!THIS!";
5f05dabc 31$Config{startperl}
32 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
c5ae3962 33 if 0;
55497cff 34
8167b455 35use warnings;
c5ae3962 36use strict;
8167b455 37
38# make sure creat()s are neither too much nor too little
39INIT { eval { umask(0077) } } # doubtless someone has no mask
40
ed6d8ea1 41(my \$pager = <<'/../') =~ s/\\s*\\z//;
42$Config{pager}
43/../
c5ae3962 44my \@pagers = ();
ed6d8ea1 45push \@pagers, \$pager if -x \$pager;
46
47(my \$bindir = <<'/../') =~ s/\\s*\\z//;
fba075ab 48$Config{scriptdirexp}
c6a5b0b7 49/../
50
51(my \$pod2man = <<'/../') =~ s/\\s*\\z//;
52pod2man$versiononly
ed6d8ea1 53/../
8167b455 54
4633a7c4 55!GROK!THIS!
56
57# In the following, perl variables are not expanded during extraction.
58
59print OUT <<'!NO!SUBS!';
60
8167b455 61use Fcntl; # for sysopen
62use Getopt::Std;
63use Config '%Config';
14178d34 64use File::Spec::Functions qw(catfile splitdir);
8167b455 65
4633a7c4 66#
67# Perldoc revision #1 -- look up a piece of documentation in .pod format that
68# is embedded in the perl installation tree.
69#
8167b455 70# This is not to be confused with Tom Christiansen's perlman, which is a
4633a7c4 71# man replacement, written in perl. This perldoc is strictly for reading
72# the perl manuals, though it too is written in perl.
8167b455 73#
74# Massive security and correctness patches applied to this
75# noisome program by Tom Christiansen Sat Mar 11 15:22:33 MST 2000
4633a7c4 76
febd60db 77if (@ARGV<1) {
c5ae3962 78 my $me = $0; # Editing $0 is unportable
fb73857a 79 $me =~ s,.*/,,;
4633a7c4 80 die <<EOF;
a85d71bc 81Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-n program] [-l] [-F] [-X] PageName|ModuleName|ProgramName
0b166b66 82 $me -f PerlFunc
a3cb178b 83 $me -q FAQKeywords
4633a7c4 84
89b8affa 85The -h option prints more help. Also try "perldoc perldoc" to get
54884818 86acquainted with the system.
4633a7c4 87EOF
88}
89
c5ae3962 90my @global_found = ();
91my $global_target = "";
fb73857a 92
c5ae3962 93my $Is_VMS = $^O eq 'VMS';
94my $Is_MSWin32 = $^O eq 'MSWin32';
95my $Is_Dos = $^O eq 'dos';
6dbadf30 96my $Is_OS2 = $^O eq 'os2';
4633a7c4 97
98sub usage{
ff0cee69 99 warn "@_\n" if @_;
100 # Erase evidence of previous errors (if any), so exit status is simple.
101 $! = 0;
4633a7c4 102 die <<EOF;
31bdbec1 103perldoc [options] PageName|ModuleName|ProgramName...
104perldoc [options] -f BuiltinFunction
a3cb178b 105perldoc [options] -q FAQRegex
31bdbec1 106
107Options:
137443ea 108 -h Display this help message
5315ba28 109 -r Recursive search (slow)
febd60db 110 -i Ignore case
137443ea 111 -t Display pod using pod2text instead of pod2man and nroff
112 (-t is the default on win32)
85880f03 113 -u Display unformatted pod text
a3cb178b 114 -m Display module's file in its entirety
a85d71bc 115 -n Specify replacement for nroff
a3cb178b 116 -l Display the module's file name
cce34969 117 -F Arguments are file names, not modules
137443ea 118 -v Verbosely describe what's going on
89b8affa 119 -X use index if present (looks for pod.idx at $Config{archlib})
54ac30b1 120 -q Search the text of questions (not answers) in perlfaq[1-9]
c185d8c4 121 -U Run in insecure mode (superuser only)
a3cb178b 122
4633a7c4 123PageName|ModuleName...
febd60db 124 is the name of a piece of documentation that you want to look at. You
4633a7c4 125 may either give a descriptive name of the page (as in the case of
febd60db 126 `perlfunc') the name of a module, either like `Term::Info',
127 `Term/Info', the partial name of a module, like `info', or
4633a7c4 128 `makemaker', or the name of a program, like `perldoc'.
31bdbec1 129
130BuiltinFunction
131 is the name of a perl function. Will extract documentation from
132 `perlfunc'.
a3cb178b 133
134FAQRegex
135 is a regex. Will search perlfaq[1-9] for and extract any
136 questions that match.
137
febd60db 138Any switches in the PERLDOC environment variable will be used before the
89b8affa 139command line arguments. The optional pod index file contains a list of
140filenames, one per line.
4633a7c4 141
142EOF
143}
144
febd60db 145if (defined $ENV{"PERLDOC"}) {
c5ae3962 146 require Text::ParseWords;
147 unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
148}
149!NO!SUBS!
150
c185d8c4 151my $getopts = "mhtluvriFf:Xq:n:U";
c5ae3962 152print OUT <<"!GET!OPTS!";
4633a7c4 153
c5ae3962 154use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
4633a7c4 155
c5ae3962 156getopts("$getopts") || usage;
157!GET!OPTS!
4633a7c4 158
c5ae3962 159print OUT <<'!NO!SUBS!';
85880f03 160
c5ae3962 161usage if $opt_h;
c185d8c4 162
163# refuse to run if we should be tainting and aren't
164# (but regular users deserve protection too, though!)
6dbadf30 165if (!($Is_VMS || $Is_MSWin32 || $Is_Dos || $Is_OS2) && ($> == 0 || $< == 0)
c185d8c4 166 && !am_taint_checking())
167{{
168 if ($opt_U) {
169 my $id = eval { getpwnam("nobody") };
170 $id = eval { getpwnam("nouser") } unless defined $id;
171 $id = -2 unless defined $id;
172 eval {
173 $> = $id; # must do this one first!
174 $< = $id;
175 };
176 last if !$@ && $< && $>;
177 }
178 die "Superuser must not run $0 without security audit and taint checks.\n";
179}}
180
a85d71bc 181$opt_n = "nroff" if !$opt_n;
4633a7c4 182
c5ae3962 183my $podidx;
febd60db 184if ($opt_X) {
0d3da1c8 185 $podidx = "$Config{'archlib'}/pod.idx";
186 $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
187}
89b8affa 188
8167b455 189if ((my $opts = do{ no warnings; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
137443ea 190 usage("only one of -t, -u, -m or -l")
febd60db 191}
d49321e7 192elsif ($Is_MSWin32
193 || $Is_Dos
8167b455 194 || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
d49321e7 195{
8167b455 196 $opt_t = 1 unless $opts;
137443ea 197}
4633a7c4 198
7eda7aea 199if ($opt_t) { require Pod::Text; import Pod::Text; }
4633a7c4 200
c5ae3962 201my @pages;
31bdbec1 202if ($opt_f) {
febd60db 203 @pages = ("perlfunc");
204}
205elsif ($opt_q) {
206 @pages = ("perlfaq1" .. "perlfaq9");
207}
208else {
209 @pages = @ARGV;
31bdbec1 210}
211
fb73857a 212# Does this look like a module or extension directory?
213if (-f "Makefile.PL") {
8167b455 214
215 # Add ., lib to @INC (if they exist)
216 eval q{ use lib qw(. lib); 1; } or die;
217
218 # don't add if superuser
aafed681 219 if ($< && $> && -f "blib") { # don't be looking too hard now!
6d0835e5 220 eval q{ use blib; 1 };
221 warn $@ if $@ && $opt_v;
8167b455 222 }
fb73857a 223}
224
4633a7c4 225sub containspod {
fb73857a 226 my($file, $readit) = @_;
8167b455 227 return 1 if !$readit && $file =~ /\.pod\z/i;
fb73857a 228 local($_);
8167b455 229 open(TEST,"<", $file) or die "Can't open $file: $!";
febd60db 230 while (<TEST>) {
231 if (/^=head/) {
8167b455 232 close(TEST) or die "Can't close $file: $!";
fb73857a 233 return 1;
4633a7c4 234 }
fb73857a 235 }
8167b455 236 close(TEST) or die "Can't close $file: $!";
fb73857a 237 return 0;
4633a7c4 238}
239
84902520 240sub minus_f_nocase {
5315ba28 241 my($dir,$file) = @_;
14178d34 242 my $path = catfile($dir,$file);
5315ba28 243 return $path if -f $path and -r _;
244 if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
febd60db 245 # on a case-forgiving file system or if case is important
5315ba28 246 # that is it all we can do
0cf744f2 247 warn "Ignored $path: unreadable\n" if -f _;
fb73857a 248 return '';
84902520 249 }
4633a7c4 250 local *DIR;
8167b455 251 # this is completely wicked. don't mess with $", and if
252 # you do, don't assume / is the dirsep!
4633a7c4 253 local($")="/";
5315ba28 254 my @p = ($dir);
255 my($p,$cip);
14178d34 256 foreach $p (splitdir $file){
257 my $try = catfile @p, $p;
fb73857a 258 stat $try;
febd60db 259 if (-d _) {
4633a7c4 260 push @p, $p;
fb73857a 261 if ( $p eq $global_target) {
14178d34 262 my $tmp_path = catfile @p;
fb73857a 263 my $path_f = 0;
264 for (@global_found) {
265 $path_f = 1 if $_ eq $tmp_path;
266 }
267 push (@global_found, $tmp_path) unless $path_f;
268 print STDERR "Found as @p but directory\n" if $opt_v;
269 }
febd60db 270 }
271 elsif (-f _ && -r _) {
fb73857a 272 return $try;
febd60db 273 }
274 elsif (-f _) {
fb73857a 275 warn "Ignored $try: unreadable\n";
febd60db 276 }
8167b455 277 elsif (-d "@p") {
4633a7c4 278 my $found=0;
279 my $lcp = lc $p;
8167b455 280 opendir DIR, "@p" or die "opendir @p: $!";
4633a7c4 281 while ($cip=readdir(DIR)) {
282 if (lc $cip eq $lcp){
283 $found++;
284 last;
285 }
286 }
8167b455 287 closedir DIR or die "closedir @p: $!";
4633a7c4 288 return "" unless $found;
289 push @p, $cip;
fb73857a 290 return "@p" if -f "@p" and -r _;
0cf744f2 291 warn "Ignored @p: unreadable\n" if -f _;
4633a7c4 292 }
293 }
5315ba28 294 return "";
fb73857a 295}
eb459f90 296
fb73857a 297
298sub check_file {
5315ba28 299 my($dir,$file) = @_;
7ec2cea4 300 return "" if length $dir and not -d $dir;
3046dd9f 301 if ($opt_m) {
5315ba28 302 return minus_f_nocase($dir,$file);
febd60db 303 }
304 else {
5315ba28 305 my $path = minus_f_nocase($dir,$file);
249edfdf 306 return $path if length $path and containspod($path);
3046dd9f 307 }
5315ba28 308 return "";
fb73857a 309}
310
311
312sub searchfor {
313 my($recurse,$s,@dirs) = @_;
314 $s =~ s!::!/!g;
315 $s = VMS::Filespec::unixify($s) if $Is_VMS;
316 return $s if -f $s && containspod($s);
317 printf STDERR "Looking for $s in @dirs\n" if $opt_v;
318 my $ret;
319 my $i;
320 my $dir;
14178d34 321 $global_target = (splitdir $s)[-1]; # XXX: why not use File::Basename?
fb73857a 322 for ($i=0; $i<@dirs; $i++) {
323 $dir = $dirs[$i];
8167b455 324 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
5315ba28 325 if ( ( $ret = check_file $dir,"$s.pod")
326 or ( $ret = check_file $dir,"$s.pm")
327 or ( $ret = check_file $dir,$s)
fb73857a 328 or ( $Is_VMS and
5315ba28 329 $ret = check_file $dir,"$s.com")
febd60db 330 or ( $^O eq 'os2' and
5315ba28 331 $ret = check_file $dir,"$s.cmd")
0151c6ef 332 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
5315ba28 333 $ret = check_file $dir,"$s.bat")
334 or ( $ret = check_file "$dir/pod","$s.pod")
335 or ( $ret = check_file "$dir/pod",$s)
7ec2cea4 336 or ( $ret = check_file "$dir/pods","$s.pod")
337 or ( $ret = check_file "$dir/pods",$s)
fb73857a 338 ) {
339 return $ret;
340 }
eb459f90 341
fb73857a 342 if ($recurse) {
8167b455 343 opendir(D,$dir) or die "Can't opendir $dir: $!";
14178d34 344 my @newdirs = map catfile($dir, $_), grep {
8167b455 345 not /^\.\.?\z/s and
346 not /^auto\z/s and # save time! don't search auto dirs
14178d34 347 -d catfile($dir, $_)
fb73857a 348 } readdir D;
8167b455 349 closedir(D) or die "Can't closedir $dir: $!";
fb73857a 350 next unless @newdirs;
8167b455 351 # what a wicked map!
352 @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $Is_VMS;
fb73857a 353 print STDERR "Also looking in @newdirs\n" if $opt_v;
354 push(@dirs,@newdirs);
355 }
356 }
357 return ();
358}
4633a7c4 359
eb459f90 360sub filter_nroff {
361 my @data = split /\n{2,}/, shift;
362 shift @data while @data and $data[0] !~ /\S/; # Go to header
363 shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
364 pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
365 # 28/Jan/99 perl 5.005, patch 53 1
366 join "\n\n", @data;
367}
368
febd60db 369sub page {
370 my ($tmp, $no_tty, @pagers) = @_;
371 if ($no_tty) {
8167b455 372 open(TMP,"<", $tmp) or die "Can't open $tmp: $!";
373 local $_;
374 while (<TMP>) {
375 print or die "Can't print to stdout: $!";
376 }
377 close TMP or die "Can't close while $tmp: $!";
febd60db 378 }
379 else {
f3298698 380 # On VMS, quoting prevents logical expansion, and temp files with no
381 # extension get the wrong default extension (such as .LIS for TYPE)
382
383 $tmp = VMS::Filespec::rmsexpand($tmp, '.') if ($Is_VMS);
384 foreach my $pager (@pagers) {
e0d5f7b4 385 if ($Is_VMS) {
f3298698 386 last if system("$pager $tmp") == 0;
e0d5f7b4 387 } else {
a79ff105 388 last if system("$pager \"$tmp\"") == 0;
e0d5f7b4 389 }
febd60db 390 }
391 }
392}
393
c5ae3962 394my @found;
4633a7c4 395foreach (@pages) {
febd60db 396 if ($podidx && open(PODIDX, $podidx)) {
14178d34 397 my $searchfor = catfile split '::';
febd60db 398 print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
8167b455 399 local $_;
febd60db 400 while (<PODIDX>) {
401 chomp;
8167b455 402 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
cce34969 403 }
8167b455 404 close(PODIDX) or die "Can't close $podidx: $!";
febd60db 405 next;
406 }
407 print STDERR "Searching for $_\n" if $opt_v;
febd60db 408 if ($opt_F) {
409 next unless -r;
410 push @found, $_ if $opt_m or containspod($_);
411 next;
412 }
6a43d2f9 413 # We must look both in @INC for library modules and in $bindir
414 # for executables, like h2xs or perldoc itself.
415 my @searchdirs = ($bindir, @INC);
febd60db 416 unless ($opt_m) {
417 if ($Is_VMS) {
418 my($i,$trn);
419 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
420 push(@searchdirs,$trn);
7eda7aea 421 }
febd60db 422 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
423 }
424 else {
425 push(@searchdirs, grep(-d, split($Config{path_sep},
426 $ENV{'PATH'})));
85880f03 427 }
febd60db 428 }
429 my @files = searchfor(0,$_,@searchdirs);
430 if (@files) {
431 print STDERR "Found as @files\n" if $opt_v;
432 }
433 else {
434 # no match, try recursive search
8167b455 435 @searchdirs = grep(!/^\.\z/s,@INC);
febd60db 436 @files= searchfor(1,$_,@searchdirs) if $opt_r;
437 if (@files) {
438 print STDERR "Loosely found as @files\n" if $opt_v;
439 }
440 else {
441 print STDERR "No documentation found for \"$_\".\n";
442 if (@global_found) {
443 print STDERR "However, try\n";
444 for my $dir (@global_found) {
8167b455 445 opendir(DIR, $dir) or die "opendir $dir: $!";
febd60db 446 while (my $file = readdir(DIR)) {
8167b455 447 next if ($file =~ /^\./s);
448 $file =~ s/\.(pm|pod)\z//; # XXX: badfs
febd60db 449 print STDERR "\tperldoc $_\::$file\n";
450 }
8167b455 451 closedir DIR or die "closedir $dir: $!";
4633a7c4 452 }
febd60db 453 }
4633a7c4 454 }
febd60db 455 }
456 push(@found,@files);
4633a7c4 457}
458
febd60db 459if (!@found) {
460 exit ($Is_VMS ? 98962 : 1);
4633a7c4 461}
462
44a8e56a 463if ($opt_l) {
464 print join("\n", @found), "\n";
465 exit;
466}
467
877622ba 468my $lines = $ENV{LINES} || 24;
469
c5ae3962 470my $no_tty;
febd60db 471if (! -t STDOUT) { $no_tty = 1 }
8167b455 472END { close(STDOUT) || die "Can't close STDOUT: $!" }
febd60db 473
137443ea 474if ($Is_MSWin32) {
febd60db 475 push @pagers, qw( more< less notepad );
476 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
477 for (@found) { s,/,\\,g }
478}
479elsif ($Is_VMS) {
febd60db 480 push @pagers, qw( most more less type/page );
481}
482elsif ($Is_Dos) {
febd60db 483 push @pagers, qw( less.exe more.com< );
484 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
485}
486else {
487 if ($^O eq 'os2') {
febd60db 488 unshift @pagers, 'less', 'cmd /c more <';
489 }
febd60db 490 push @pagers, qw( more less pg view cat );
491 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
4633a7c4 492}
44a8e56a 493unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
4633a7c4 494
7eda7aea 495if ($opt_m) {
febd60db 496 foreach my $pager (@pagers) {
8167b455 497 if (system($pager, @found) == 0) {
498 exit;
499 }
febd60db 500 }
8167b455 501 if ($Is_VMS) {
502 eval q{
503 use vmsish qw(status exit);
504 exit $?;
505 1;
506 } or die;
507 }
508 exit(1);
eb459f90 509}
7eda7aea 510
eb459f90 511my @pod;
31bdbec1 512if ($opt_f) {
febd60db 513 my $perlfunc = shift @found;
8167b455 514 open(PFUNC, "<", $perlfunc)
515 or die("Can't open $perlfunc: $!");
31bdbec1 516
febd60db 517 # Functions like -r, -e, etc. are listed under `-X'.
518 my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
519 ? 'I<-X' : $opt_f ;
a3cb178b 520
febd60db 521 # Skip introduction
8167b455 522 local $_;
febd60db 523 while (<PFUNC>) {
524 last if /^=head2 Alphabetical Listing of Perl Functions/;
525 }
7eda7aea 526
febd60db 527 # Look for our function
528 my $found = 0;
529 my $inlist = 0;
530 while (<PFUNC>) {
531 if (/^=item\s+\Q$search_string\E\b/o) {
532 $found = 1;
85880f03 533 }
febd60db 534 elsif (/^=item/) {
535 last if $found > 1 and not $inlist;
536 }
537 next unless $found;
538 if (/^=over/) {
539 ++$inlist;
540 }
541 elsif (/^=back/) {
542 --$inlist;
4633a7c4 543 }
febd60db 544 push @pod, $_;
545 ++$found if /^\w/; # found descriptive text
546 }
547 if (!@pod) {
548 die "No documentation for perl function `$opt_f' found\n";
549 }
8167b455 550 close PFUNC or die "Can't open $perlfunc: $!";
4633a7c4 551}
552
febd60db 553if ($opt_q) {
554 local @ARGV = @found; # I'm lazy, sue me.
555 my $found = 0;
556 my %found_in;
8167b455 557 my $rx = eval { qr/$opt_q/ } or die <<EOD;
b62b7eeb 558Invalid regular expression '$opt_q' given as -q pattern:
559 $@
560Did you mean \\Q$opt_q ?
561
562EOD
febd60db 563
8167b455 564 for (@found) { die "invalid file spec: $!" if /[<>|]/ }
565 local $_;
febd60db 566 while (<>) {
567 if (/^=head2\s+.*(?:$opt_q)/oi) {
568 $found = 1;
569 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
4633a7c4 570 }
febd60db 571 elsif (/^=head2/) {
572 $found = 0;
573 }
574 next unless $found;
575 push @pod, $_;
576 }
577 if (!@pod) {
8167b455 578 die("No documentation for perl FAQ keyword `$opt_q' found\n");
febd60db 579 }
580}
581
6a43d2f9 582require File::Temp;
583
008d9c33 584my ($tmpfd, $tmp) = File::Temp::tempfile(UNLINK => 1);
6a43d2f9 585
febd60db 586my $filter;
587
588if (@pod) {
008d9c33 589 my ($buffd, $buffer) = File::Temp::tempfile(UNLINK => 1);
6a43d2f9 590 print $buffd "=over 8\n\n";
591 print $buffd @pod or die "Can't print $buffer: $!";
592 print $buffd "=back\n";
593 close $buffd or die "Can't close $buffer: $!";
febd60db 594 @found = $buffer;
595 $filter = 1;
4633a7c4 596}
597
febd60db 598foreach (@found) {
6a43d2f9 599 my $file = $_;
600 my $err;
601
602 if ($opt_t) {
603 Pod::Text->new()->parse_from_file($file, $tmpfd);
604 }
605 elsif (not $opt_u) {
c6a5b0b7 606 my $cmd = catfile($bindir, $pod2man) . " --lax $file | $opt_n -man";
6a43d2f9 607 $cmd .= " | col -x" if $^O =~ /hpux/;
608 my $rslt = `$cmd`;
609 $rslt = filter_nroff($rslt) if $filter;
610 unless (($err = $?)) {
611 print $tmpfd $rslt
612 or die "Can't print $tmp: $!";
613 }
614 }
615 if ($opt_u or $err) {
616 open(IN,"<", $file) or die("Can't open $file: $!");
617 my $cut = 1;
618 local $_;
619 while (<IN>) {
620 $cut = $1 eq 'cut' if /^=(\w+)/;
621 next if $cut;
622 print $tmpfd $_
623 or die "Can't print $tmp: $!";
624 }
625 close IN or die "Can't close $file: $!";
626 }
eb459f90 627}
6a43d2f9 628close $tmpfd
629 or die "Can't close $tmp: $!";
febd60db 630page($tmp, $no_tty, @pagers);
4633a7c4 631
8167b455 632exit;
633
634sub is_tainted {
635 my $arg = shift;
636 my $nada = substr($arg, 0, 0); # zero-length
637 local $@; # preserve caller's version
638 eval { eval "# $nada" };
639 return length($@) != 0;
640}
641
642sub am_taint_checking {
643 my($k,$v) = each %ENV;
644 return is_tainted($v);
645}
646
7eda7aea 647
648__END__
649
650=head1 NAME
651
652perldoc - Look up Perl documentation in pod format.
653
654=head1 SYNOPSIS
655
89b8affa 656B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName|ModuleName|ProgramName
7eda7aea 657
31bdbec1 658B<perldoc> B<-f> BuiltinFunction
659
c8950503 660B<perldoc> B<-q> FAQ Keyword
661
7eda7aea 662=head1 DESCRIPTION
663
40fc7247 664I<perldoc> looks up a piece of documentation in .pod format that is embedded
665in the perl installation tree or in a perl script, and displays it via
666C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
667C<col -x> will be used.) This is primarily used for the documentation for
668the perl library modules.
7eda7aea 669
670Your system may also have man pages installed for those modules, in
671which case you can probably just use the man(1) command.
672
673=head1 OPTIONS
674
675=over 5
676
677=item B<-h> help
678
679Prints out a brief help message.
680
681=item B<-v> verbose
682
683Describes search for the item in detail.
684
685=item B<-t> text output
686
687Display docs using plain text converter, instead of nroff. This may be faster,
688but it won't look as nice.
689
690=item B<-u> unformatted
691
692Find docs only; skip reformatting by pod2*
693
694=item B<-m> module
695
696Display the entire module: both code and unformatted pod documentation.
697This may be useful if the docs don't explain a function in the detail
698you need, and you'd like to inspect the code directly; perldoc will find
699the file for you and simply hand it off for display.
700
44a8e56a 701=item B<-l> file name only
702
703Display the file name of the module found.
704
cce34969 705=item B<-F> file names
706
89b8affa 707Consider arguments as file names, no search in directories will be performed.
cce34969 708
31bdbec1 709=item B<-f> perlfunc
710
711The B<-f> option followed by the name of a perl built in function will
712extract the documentation of this function from L<perlfunc>.
713
c8950503 714=item B<-q> perlfaq
715
716The B<-q> option takes a regular expression as an argument. It will search
717the question headings in perlfaq[1-9] and print the entries matching
718the regular expression.
719
89b8affa 720=item B<-X> use an index if present
721
d1be9408 722The B<-X> option looks for an entry whose basename matches the name given on the
89b8affa 723command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
724contain fully qualified filenames, one per line.
725
c185d8c4 726=item B<-U> run insecurely
727
728Because B<perldoc> does not run properly tainted, and is known to
729have security issues, it will not normally execute as the superuser.
730If you use the B<-U> flag, it will do so, but only after setting
731the effective and real IDs to nobody's or nouser's account, or -2
d1be9408 732if unavailable. If it cannot relinquish its privileges, it will not
c185d8c4 733run.
734
7eda7aea 735=item B<PageName|ModuleName|ProgramName>
736
737The item you want to look up. Nested modules (such as C<File::Basename>)
738are specified either as C<File::Basename> or C<File/Basename>. You may also
1b420867 739give a descriptive name of a page, such as C<perlfunc>. You may also give a
7eda7aea 740partial or wrong-case name, such as "basename" for "File::Basename", but
741this will be slower, if there is more then one page with the same partial
742name, you will only get the first one.
743
744=back
745
746=head1 ENVIRONMENT
747
febd60db 748Any switches in the C<PERLDOC> environment variable will be used before the
7eda7aea 749command line arguments. C<perldoc> also searches directories
750specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
751defined) and C<PATH> environment variables.
752(The latter is so that embedded pods for executables, such as
a3cb178b 753C<perldoc> itself, are available.) C<perldoc> will use, in order of
754preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
755C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
756used if C<perldoc> was told to display plain text or unformatted pod.)
7eda7aea 757
eb459f90 758One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
759
febd60db 760=head1 VERSION
761
6d0835e5 762This is perldoc v2.03.
febd60db 763
7eda7aea 764=head1 AUTHOR
765
766Kenneth Albanowski <kjahds@kjahds.com>
767
febd60db 768Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
769and others.
7eda7aea 770
7eda7aea 771=cut
772
773#
6d0835e5 774# Version 2.03: Sun Apr 23 16:56:34 BST 2000
775# Hugo van der Sanden <hv@crypt0.demon.co.uk>
776# don't die when 'use blib' fails
c185d8c4 777# Version 2.02: Mon Mar 13 18:03:04 MST 2000
778# Tom Christiansen <tchrist@perl.com>
779# Added -U insecurity option
8167b455 780# Version 2.01: Sat Mar 11 15:22:33 MST 2000
781# Tom Christiansen <tchrist@perl.com>, querulously.
782# Security and correctness patches.
783# What a twisted bit of distasteful spaghetti code.
784# Version 2.0: ????
7ec2cea4 785# Version 1.15: Tue Aug 24 01:50:20 EST 1999
786# Charles Wilson <cwilson@ece.gatech.edu>
787# changed /pod/ directory to /pods/ for cygwin
788# to support cygwin/win32
c5ae3962 789# Version 1.14: Wed Jul 15 01:50:20 EST 1998
790# Robin Barker <rmb1@cise.npl.co.uk>
791# -strict, -w cleanups
89b8affa 792# Version 1.13: Fri Feb 27 16:20:50 EST 1997
6e238990 793# Gurusamy Sarathy <gsar@activestate.com>
89b8affa 794# -doc tweaks for -F and -X options
137443ea 795# Version 1.12: Sat Apr 12 22:41:09 EST 1997
6e238990 796# Gurusamy Sarathy <gsar@activestate.com>
137443ea 797# -various fixes for win32
7eda7aea 798# Version 1.11: Tue Dec 26 09:54:33 EST 1995
799# Kenneth Albanowski <kjahds@kjahds.com>
800# -added Charles Bailey's further VMS patches, and -u switch
801# -added -t switch, with pod2text support
febd60db 802#
7eda7aea 803# Version 1.10: Thu Nov 9 07:23:47 EST 1995
804# Kenneth Albanowski <kjahds@kjahds.com>
805# -added VMS support
806# -added better error recognition (on no found pages, just exit. On
807# missing nroff/pod2man, just display raw pod.)
808# -added recursive/case-insensitive matching (thanks, Andreas). This
809# slows things down a bit, unfortunately. Give a precise name, and
810# it'll run faster.
811#
812# Version 1.01: Tue May 30 14:47:34 EDT 1995
813# Andy Dougherty <doughera@lafcol.lafayette.edu>
814# -added pod documentation.
815# -added PATH searching.
816# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
817# and friends.
818#
819#
820# TODO:
821#
822# Cache directories read during sloppy match
4633a7c4 823!NO!SUBS!
824
825close OUT or die "Can't close $file: $!";
826chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
827exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 828chdir $origdir;