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