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