This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
62a82f381ff2c53c55b5617984b15232140439b0
[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 my $versiononly = $Config{versiononly} ? $Config{version} : '';
29
30 print OUT <<"!GROK!THIS!";
31 $Config{startperl}
32     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
33         if 0;
34
35 use warnings;
36 use strict;
37
38 # make sure creat()s are neither too much nor too little
39 INIT { eval { umask(0077) } }   # doubtless someone has no mask
40
41 (my \$pager = <<'/../') =~ s/\\s*\\z//;
42 $Config{pager}
43 /../
44 my \@pagers = ();
45 push \@pagers, \$pager if -x \$pager;
46
47 (my \$bindir = <<'/../') =~ s/\\s*\\z//;
48 $Config{scriptdirexp}
49 /../
50
51 (my \$pod2man = <<'/../') =~ s/\\s*\\z//;
52 pod2man$versiononly
53 /../
54
55 !GROK!THIS!
56
57 # In the following, perl variables are not expanded during extraction.
58
59 print OUT <<'!NO!SUBS!';
60
61 use Fcntl;    # for sysopen
62 use Getopt::Std;
63 use Config '%Config';
64 use 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
77 if (@ARGV<1) {
78         my $me = $0;            # Editing $0 is unportable
79         $me =~ s,.*/,,;
80         die <<EOF;
81 Usage: $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
85 The -h option prints more help.  Also try "perldoc perldoc" to get
86 acquainted with the system.
87 EOF
88 }
89
90 my @global_found = ();
91 my $global_target = "";
92
93 my $Is_VMS = $^O eq 'VMS';
94 my $Is_MSWin32 = $^O eq 'MSWin32';
95 my $Is_Dos = $^O eq 'dos';
96 my $Is_OS2 = $^O eq 'os2';
97
98 sub usage{
99     warn "@_\n" if @_;
100     # Erase evidence of previous errors (if any), so exit status is simple.
101     $! = 0;
102     die <<EOF;
103 perldoc [options] PageName|ModuleName|ProgramName...
104 perldoc [options] -f BuiltinFunction
105 perldoc [options] -q FAQRegex
106
107 Options:
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
123 PageName|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',
127          `Term/Info', the partial name of a module, like `info', or
128          `makemaker', or the name of a program, like `perldoc'.
129
130 BuiltinFunction
131          is the name of a perl function.  Will extract documentation from
132          `perlfunc'.
133
134 FAQRegex
135          is a regex. Will search perlfaq[1-9] for and extract any
136          questions that match.
137
138 Any switches in the PERLDOC environment variable will be used before the
139 command line arguments.  The optional pod index file contains a list of
140 filenames, one per line.
141
142 EOF
143 }
144
145 if (defined $ENV{"PERLDOC"}) {
146     require Text::ParseWords;
147     unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
148 }
149 !NO!SUBS!
150
151 my $getopts = "mhtluvriFf:Xq:n:U";
152 print OUT <<"!GET!OPTS!";
153
154 use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
155
156 getopts("$getopts") || usage;
157 !GET!OPTS!
158
159 print OUT <<'!NO!SUBS!';
160
161 usage if $opt_h;
162
163 # refuse to run if we should be tainting and aren't
164 # (but regular users deserve protection too, though!)
165 if (!($Is_VMS || $Is_MSWin32 || $Is_Dos || $Is_OS2) && ($> == 0 || $< == 0)
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             # According to Stevens' APUE and various
174             # (BSD, Solaris, HP-UX) man pages setting
175             # the real uid first and effective uid second
176             # is the way to go if one wants to drop privileges,
177             # because if one changes into an effective uid of
178             # non-zero, one cannot change the real uid any more.
179             $< = $id; # real uid
180             $> = $id; # effective uid
181         };
182         last if !$@ && $< && $>;
183     }
184     die "Superuser must not run $0 without security audit and taint checks.\n";
185 }}
186
187 $opt_n = "nroff" if !$opt_n;
188
189 my $podidx;
190 if ($opt_X) {
191     $podidx = "$Config{'archlib'}/pod.idx";
192     $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
193 }
194
195 if ((my $opts = do{ no warnings; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
196     usage("only one of -t, -u, -m or -l")
197 }
198 elsif ($Is_MSWin32
199        || $Is_Dos
200        || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
201 {
202     $opt_t = 1 unless $opts;
203 }
204
205 if ($opt_t) { require Pod::Text; import Pod::Text; }
206
207 my @pages;
208 if ($opt_f) {
209     @pages = ("perlfunc");
210 }
211 elsif ($opt_q) {
212     @pages = ("perlfaq1" .. "perlfaq9");
213 }
214 else {
215     @pages = @ARGV;
216 }
217
218 # Does this look like a module or extension directory?
219 if (-f "Makefile.PL") {
220
221     # Add ., lib to @INC (if they exist)
222     eval q{ use lib qw(. lib); 1; } or die;
223
224     # don't add if superuser
225     if ($< && $> && -f "blib") {   # don't be looking too hard now!
226         eval q{ use blib; 1 };
227         warn $@ if $@ && $opt_v;
228     }
229 }
230
231 sub containspod {
232     my($file, $readit) = @_;
233     return 1 if !$readit && $file =~ /\.pod\z/i;
234     local($_);
235     open(TEST,"<", $file)       or die "Can't open $file: $!";
236     while (<TEST>) {
237         if (/^=head/) {
238             close(TEST)         or die "Can't close $file: $!";
239             return 1;
240         }
241     }
242     close(TEST)                 or die "Can't close $file: $!";
243     return 0;
244 }
245
246 sub minus_f_nocase {
247      my($dir,$file) = @_;
248      my $path = catfile($dir,$file);
249      return $path if -f $path and -r _;
250      if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
251         # on a case-forgiving file system or if case is important
252         # that is it all we can do
253         warn "Ignored $path: unreadable\n" if -f _;
254         return '';
255      }
256      local *DIR;
257      # this is completely wicked.  don't mess with $", and if 
258      # you do, don't assume / is the dirsep!
259      local($")="/";
260      my @p = ($dir);
261      my($p,$cip);
262      foreach $p (splitdir $file){
263         my $try = catfile @p, $p;
264         stat $try;
265         if (-d _) {
266             push @p, $p;
267             if ( $p eq $global_target) {
268                 my $tmp_path = catfile @p;
269                 my $path_f = 0;
270                 for (@global_found) {
271                     $path_f = 1 if $_ eq $tmp_path;
272                 }
273                 push (@global_found, $tmp_path) unless $path_f;
274                 print STDERR "Found as @p but directory\n" if $opt_v;
275             }
276         }
277         elsif (-f _ && -r _) {
278             return $try;
279         }
280         elsif (-f _) {
281             warn "Ignored $try: unreadable\n";
282         }
283         elsif (-d "@p") {
284             my $found=0;
285             my $lcp = lc $p;
286             opendir DIR, "@p"       or die "opendir @p: $!";
287             while ($cip=readdir(DIR)) {
288                 if (lc $cip eq $lcp){
289                     $found++;
290                     last;
291                 }
292             }
293             closedir DIR            or die "closedir @p: $!";
294             return "" unless $found;
295             push @p, $cip;
296             return "@p" if -f "@p" and -r _;
297             warn "Ignored @p: unreadable\n" if -f _;
298         }
299      }
300      return "";
301 }
302
303
304 sub check_file {
305     my($dir,$file) = @_;
306     return "" if length $dir and not -d $dir;
307     if ($opt_m) {
308         return minus_f_nocase($dir,$file);
309     }
310     else {
311         my $path = minus_f_nocase($dir,$file);
312         return $path if length $path and containspod($path);
313     }
314     return "";
315 }
316
317
318 sub searchfor {
319     my($recurse,$s,@dirs) = @_;
320     $s =~ s!::!/!g;
321     $s = VMS::Filespec::unixify($s) if $Is_VMS;
322     return $s if -f $s && containspod($s);
323     printf STDERR "Looking for $s in @dirs\n" if $opt_v;
324     my $ret;
325     my $i;
326     my $dir;
327     $global_target = (splitdir $s)[-1];   # XXX: why not use File::Basename?
328     for ($i=0; $i<@dirs; $i++) {
329         $dir = $dirs[$i];
330         ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
331         if (       ( $ret = check_file $dir,"$s.pod")
332                 or ( $ret = check_file $dir,"$s.pm")
333                 or ( $ret = check_file $dir,$s)
334                 or ( $Is_VMS and
335                      $ret = check_file $dir,"$s.com")
336                 or ( $^O eq 'os2' and
337                      $ret = check_file $dir,"$s.cmd")
338                 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
339                      $ret = check_file $dir,"$s.bat")
340                 or ( $ret = check_file "$dir/pod","$s.pod")
341                 or ( $ret = check_file "$dir/pod",$s)
342                 or ( $ret = check_file "$dir/pods","$s.pod")
343                 or ( $ret = check_file "$dir/pods",$s)
344         ) {
345             return $ret;
346         }
347
348         if ($recurse) {
349             opendir(D,$dir)     or die "Can't opendir $dir: $!";
350             my @newdirs = map catfile($dir, $_), grep {
351                 not /^\.\.?\z/s and
352                 not /^auto\z/s  and   # save time! don't search auto dirs
353                 -d  catfile($dir, $_)
354             } readdir D;
355             closedir(D)         or die "Can't closedir $dir: $!";
356             next unless @newdirs;
357             # what a wicked map!
358             @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $Is_VMS;
359             print STDERR "Also looking in @newdirs\n" if $opt_v;
360             push(@dirs,@newdirs);
361         }
362     }
363     return ();
364 }
365
366 sub filter_nroff {
367   my @data = split /\n{2,}/, shift;
368   shift @data while @data and $data[0] !~ /\S/; # Go to header
369   shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
370   pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
371                                 # 28/Jan/99 perl 5.005, patch 53 1
372   join "\n\n", @data;
373 }
374
375 sub page {
376     my ($tmp, $no_tty, @pagers) = @_;
377     if ($no_tty) {
378         open(TMP,"<", $tmp)     or die "Can't open $tmp: $!";
379         local $_;
380         while (<TMP>) {
381             print or die "Can't print to stdout: $!";
382         } 
383         close TMP               or die "Can't close while $tmp: $!";
384     }
385     else {
386         # On VMS, quoting prevents logical expansion, and temp files with no
387         # extension get the wrong default extension (such as .LIS for TYPE)
388
389         $tmp = VMS::Filespec::rmsexpand($tmp, '.') if ($Is_VMS);
390         foreach my $pager (@pagers) {
391           if ($Is_VMS) {
392             last if system("$pager $tmp") == 0;
393           } else {
394             last if system("$pager \"$tmp\"") == 0;
395           }
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 require File::Temp;
589
590 my ($tmpfd, $tmp) = File::Temp::tempfile(UNLINK => 1);
591
592 my $filter;
593
594 if (@pod) {
595     my ($buffd, $buffer) = File::Temp::tempfile(UNLINK => 1);
596     print $buffd "=over 8\n\n";
597     print $buffd @pod   or die "Can't print $buffer: $!";
598     print $buffd "=back\n";
599     close $buffd        or die "Can't close $buffer: $!";
600     @found = $buffer;
601     $filter = 1;
602 }
603
604 foreach (@found) {
605     my $file = $_;
606     my $err;
607
608     if ($opt_t) {
609         Pod::Text->new()->parse_from_file($file, $tmpfd);
610     }
611     elsif (not $opt_u) {
612         my $cmd = catfile($bindir, $pod2man) . " --lax $file | $opt_n -man";
613         $cmd .= " | col -x" if $^O =~ /hpux/;
614         my $rslt = `$cmd`;
615         $rslt = filter_nroff($rslt) if $filter;
616         unless (($err = $?)) {
617             print $tmpfd $rslt
618                 or die "Can't print $tmp: $!";
619         }
620     }
621     if ($opt_u or $err) {
622         open(IN,"<", $file)   or die("Can't open $file: $!");
623         my $cut = 1;
624         local $_;
625         while (<IN>) {
626             $cut = $1 eq 'cut' if /^=(\w+)/;
627             next if $cut;
628             print $tmpfd $_
629                 or die "Can't print $tmp: $!";
630         }
631         close IN    or die "Can't close $file: $!";
632     }
633 }
634 close $tmpfd
635     or die "Can't close $tmp: $!";
636 page($tmp, $no_tty, @pagers);
637
638 exit;
639
640 sub is_tainted {
641     my $arg = shift;
642     my $nada = substr($arg, 0, 0);  # zero-length
643     local $@;  # preserve caller's version
644     eval { eval "# $nada" };
645     return length($@) != 0;
646 }
647
648 sub am_taint_checking {
649     my($k,$v) = each %ENV;
650     return is_tainted($v);  
651 }
652
653
654 __END__
655
656 =head1 NAME
657
658 perldoc - Look up Perl documentation in pod format.
659
660 =head1 SYNOPSIS
661
662 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]  [B<-X>] PageName|ModuleName|ProgramName
663
664 B<perldoc> B<-f> BuiltinFunction
665
666 B<perldoc> B<-q> FAQ Keyword
667
668 =head1 DESCRIPTION
669
670 I<perldoc> looks up a piece of documentation in .pod format that is embedded
671 in the perl installation tree or in a perl script, and displays it via
672 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
673 C<col -x> will be used.) This is primarily used for the documentation for
674 the perl library modules.
675
676 Your system may also have man pages installed for those modules, in
677 which case you can probably just use the man(1) command.
678
679 =head1 OPTIONS
680
681 =over 5
682
683 =item B<-h> help
684
685 Prints out a brief help message.
686
687 =item B<-v> verbose
688
689 Describes search for the item in detail.
690
691 =item B<-t> text output
692
693 Display docs using plain text converter, instead of nroff. This may be faster,
694 but it won't look as nice.
695
696 =item B<-u> unformatted
697
698 Find docs only; skip reformatting by pod2*
699
700 =item B<-m> module
701
702 Display the entire module: both code and unformatted pod documentation.
703 This may be useful if the docs don't explain a function in the detail
704 you need, and you'd like to inspect the code directly; perldoc will find
705 the file for you and simply hand it off for display.
706
707 =item B<-l> file name only
708
709 Display the file name of the module found.
710
711 =item B<-F> file names
712
713 Consider arguments as file names, no search in directories will be performed.
714
715 =item B<-f> perlfunc
716
717 The B<-f> option followed by the name of a perl built in function will
718 extract the documentation of this function from L<perlfunc>.
719
720 =item B<-q> perlfaq
721
722 The B<-q> option takes a regular expression as an argument.  It will search
723 the question headings in perlfaq[1-9] and print the entries matching
724 the regular expression.
725
726 =item B<-X> use an index if present
727
728 The B<-X> option looks for an entry whose basename matches the name given on the
729 command line in the file C<$Config{archlib}/pod.idx>.  The pod.idx file should
730 contain fully qualified filenames, one per line.
731
732 =item B<-U> run insecurely
733
734 Because B<perldoc> does not run properly tainted, and is known to
735 have security issues, it will not normally execute as the superuser.
736 If you use the B<-U> flag, it will do so, but only after setting
737 the effective and real IDs to nobody's or nouser's account, or -2
738 if unavailable.  If it cannot relinquish its privileges, it will not
739 run.  
740
741 =item B<PageName|ModuleName|ProgramName>
742
743 The item you want to look up.  Nested modules (such as C<File::Basename>)
744 are specified either as C<File::Basename> or C<File/Basename>.  You may also
745 give a descriptive name of a page, such as C<perlfunc>. You may also give a
746 partial or wrong-case name, such as "basename" for "File::Basename", but
747 this will be slower, if there is more then one page with the same partial
748 name, you will only get the first one.
749
750 =back
751
752 =head1 ENVIRONMENT
753
754 Any switches in the C<PERLDOC> environment variable will be used before the
755 command line arguments.  C<perldoc> also searches directories
756 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
757 defined) and C<PATH> environment variables.
758 (The latter is so that embedded pods for executables, such as
759 C<perldoc> itself, are available.)  C<perldoc> will use, in order of
760 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
761 C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
762 used if C<perldoc> was told to display plain text or unformatted pod.)
763
764 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
765
766 =head1 VERSION
767
768 This is perldoc v2.03.
769
770 =head1 AUTHOR
771
772 Kenneth Albanowski <kjahds@kjahds.com>
773
774 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
775 and others.
776
777 =cut
778
779 #
780 # Version 2.03: Sun Apr 23 16:56:34 BST 2000
781 #       Hugo van der Sanden <hv@crypt0.demon.co.uk>
782 #       don't die when 'use blib' fails
783 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
784 #       Tom Christiansen <tchrist@perl.com>
785 #       Added -U insecurity option
786 # Version 2.01: Sat Mar 11 15:22:33 MST 2000 
787 #       Tom Christiansen <tchrist@perl.com>, querulously.
788 #       Security and correctness patches.
789 #       What a twisted bit of distasteful spaghetti code.
790 # Version 2.0: ????
791 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
792 #       Charles Wilson <cwilson@ece.gatech.edu>
793 #       changed /pod/ directory to /pods/ for cygwin
794 #         to support cygwin/win32
795 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
796 #       Robin Barker <rmb1@cise.npl.co.uk>
797 #       -strict, -w cleanups
798 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
799 #       Gurusamy Sarathy <gsar@activestate.com>
800 #       -doc tweaks for -F and -X options
801 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
802 #       Gurusamy Sarathy <gsar@activestate.com>
803 #       -various fixes for win32
804 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
805 #       Kenneth Albanowski <kjahds@kjahds.com>
806 #   -added Charles Bailey's further VMS patches, and -u switch
807 #   -added -t switch, with pod2text support
808 #
809 # Version 1.10: Thu Nov  9 07:23:47 EST 1995
810 #               Kenneth Albanowski <kjahds@kjahds.com>
811 #       -added VMS support
812 #       -added better error recognition (on no found pages, just exit. On
813 #        missing nroff/pod2man, just display raw pod.)
814 #       -added recursive/case-insensitive matching (thanks, Andreas). This
815 #        slows things down a bit, unfortunately. Give a precise name, and
816 #        it'll run faster.
817 #
818 # Version 1.01: Tue May 30 14:47:34 EDT 1995
819 #               Andy Dougherty  <doughera@lafcol.lafayette.edu>
820 #   -added pod documentation.
821 #   -added PATH searching.
822 #   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
823 #    and friends.
824 #
825 #
826 # TODO:
827 #
828 #       Cache directories read during sloppy match
829 !NO!SUBS!
830
831 close OUT or die "Can't close $file: $!";
832 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
833 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
834 chdir $origdir;