problems with pod2man
[p5sagit/p5-mst-13.2.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{installscript}
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             $> = $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
181 $opt_n = "nroff" if !$opt_n;
182
183 my $podidx;
184 if ($opt_X) {
185     $podidx = "$Config{'archlib'}/pod.idx";
186     $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
187 }
188
189 if ((my $opts = do{ no warnings; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
190     usage("only one of -t, -u, -m or -l")
191 }
192 elsif ($Is_MSWin32
193        || $Is_Dos
194        || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i))
195 {
196     $opt_t = 1 unless $opts;
197 }
198
199 if ($opt_t) { require Pod::Text; import Pod::Text; }
200
201 my @pages;
202 if ($opt_f) {
203     @pages = ("perlfunc");
204 }
205 elsif ($opt_q) {
206     @pages = ("perlfaq1" .. "perlfaq9");
207 }
208 else {
209     @pages = @ARGV;
210 }
211
212 # Does this look like a module or extension directory?
213 if (-f "Makefile.PL") {
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
219     if ($< && $> && -f "blib") {   # don't be looking too hard now!
220         eval q{ use blib; 1 };
221         warn $@ if $@ && $opt_v;
222     }
223 }
224
225 sub containspod {
226     my($file, $readit) = @_;
227     return 1 if !$readit && $file =~ /\.pod\z/i;
228     local($_);
229     open(TEST,"<", $file)       or die "Can't open $file: $!";
230     while (<TEST>) {
231         if (/^=head/) {
232             close(TEST)         or die "Can't close $file: $!";
233             return 1;
234         }
235     }
236     close(TEST)                 or die "Can't close $file: $!";
237     return 0;
238 }
239
240 sub minus_f_nocase {
241      my($dir,$file) = @_;
242      my $path = catfile($dir,$file);
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') {
245         # on a case-forgiving file system or if case is important
246         # that is it all we can do
247         warn "Ignored $path: unreadable\n" if -f _;
248         return '';
249      }
250      local *DIR;
251      # this is completely wicked.  don't mess with $", and if 
252      # you do, don't assume / is the dirsep!
253      local($")="/";
254      my @p = ($dir);
255      my($p,$cip);
256      foreach $p (splitdir $file){
257         my $try = catfile @p, $p;
258         stat $try;
259         if (-d _) {
260             push @p, $p;
261             if ( $p eq $global_target) {
262                 my $tmp_path = catfile @p;
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             }
270         }
271         elsif (-f _ && -r _) {
272             return $try;
273         }
274         elsif (-f _) {
275             warn "Ignored $try: unreadable\n";
276         }
277         elsif (-d "@p") {
278             my $found=0;
279             my $lcp = lc $p;
280             opendir DIR, "@p"       or die "opendir @p: $!";
281             while ($cip=readdir(DIR)) {
282                 if (lc $cip eq $lcp){
283                     $found++;
284                     last;
285                 }
286             }
287             closedir DIR            or die "closedir @p: $!";
288             return "" unless $found;
289             push @p, $cip;
290             return "@p" if -f "@p" and -r _;
291             warn "Ignored @p: unreadable\n" if -f _;
292         }
293      }
294      return "";
295 }
296
297
298 sub check_file {
299     my($dir,$file) = @_;
300     return "" if length $dir and not -d $dir;
301     if ($opt_m) {
302         return minus_f_nocase($dir,$file);
303     }
304     else {
305         my $path = minus_f_nocase($dir,$file);
306         return $path if length $path and containspod($path);
307     }
308     return "";
309 }
310
311
312 sub 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;
321     $global_target = (splitdir $s)[-1];   # XXX: why not use File::Basename?
322     for ($i=0; $i<@dirs; $i++) {
323         $dir = $dirs[$i];
324         ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
325         if (       ( $ret = check_file $dir,"$s.pod")
326                 or ( $ret = check_file $dir,"$s.pm")
327                 or ( $ret = check_file $dir,$s)
328                 or ( $Is_VMS and
329                      $ret = check_file $dir,"$s.com")
330                 or ( $^O eq 'os2' and
331                      $ret = check_file $dir,"$s.cmd")
332                 or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
333                      $ret = check_file $dir,"$s.bat")
334                 or ( $ret = check_file "$dir/pod","$s.pod")
335                 or ( $ret = check_file "$dir/pod",$s)
336                 or ( $ret = check_file "$dir/pods","$s.pod")
337                 or ( $ret = check_file "$dir/pods",$s)
338         ) {
339             return $ret;
340         }
341
342         if ($recurse) {
343             opendir(D,$dir)     or die "Can't opendir $dir: $!";
344             my @newdirs = map catfile($dir, $_), grep {
345                 not /^\.\.?\z/s and
346                 not /^auto\z/s  and   # save time! don't search auto dirs
347                 -d  catfile($dir, $_)
348             } readdir D;
349             closedir(D)         or die "Can't closedir $dir: $!";
350             next unless @newdirs;
351             # what a wicked map!
352             @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $Is_VMS;
353             print STDERR "Also looking in @newdirs\n" if $opt_v;
354             push(@dirs,@newdirs);
355         }
356     }
357     return ();
358 }
359
360 sub 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
369 sub page {
370     my ($tmp, $no_tty, @pagers) = @_;
371     if ($no_tty) {
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: $!";
378     }
379     else {
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) {
385           if ($Is_VMS) {
386             last if system("$pager $tmp") == 0;
387           } else {
388             last if system("$pager \"$tmp\"") == 0;
389           }
390         }
391     }
392 }
393
394 my @found;
395 foreach (@pages) {
396     if ($podidx && open(PODIDX, $podidx)) {
397         my $searchfor = catfile split '::';
398         print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
399         local $_;
400         while (<PODIDX>) {
401             chomp;
402             push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
403         }
404         close(PODIDX)       or die "Can't close $podidx: $!";
405         next;
406     }
407     print STDERR "Searching for $_\n" if $opt_v;
408     if ($opt_F) {
409         next unless -r;
410         push @found, $_ if $opt_m or containspod($_);
411         next;
412     }
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);
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);
421             }
422             push(@searchdirs,'perl_root:[lib.pod]')  # installed pods
423         }
424         else {
425             push(@searchdirs, grep(-d, split($Config{path_sep},
426                                              $ENV{'PATH'})));
427         }
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
435         @searchdirs = grep(!/^\.\z/s,@INC);
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) {
445                     opendir(DIR, $dir) or die "opendir $dir: $!";
446                     while (my $file = readdir(DIR)) {
447                         next if ($file =~ /^\./s);
448                         $file =~ s/\.(pm|pod)\z//;  # XXX: badfs
449                         print STDERR "\tperldoc $_\::$file\n";
450                     }
451                     closedir DIR    or die "closedir $dir: $!";
452                 }
453             }
454         }
455     }
456     push(@found,@files);
457 }
458
459 if (!@found) {
460     exit ($Is_VMS ? 98962 : 1);
461 }
462
463 if ($opt_l) {
464     print join("\n", @found), "\n";
465     exit;
466 }
467
468 my $lines = $ENV{LINES} || 24;
469
470 my $no_tty;
471 if (! -t STDOUT) { $no_tty = 1 }
472 END { close(STDOUT) || die "Can't close STDOUT: $!" }
473
474 if ($Is_MSWin32) {
475     push @pagers, qw( more< less notepad );
476     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
477     for (@found) { s,/,\\,g }
478 }
479 elsif ($Is_VMS) {
480     push @pagers, qw( most more less type/page );
481 }
482 elsif ($Is_Dos) {
483     push @pagers, qw( less.exe more.com< );
484     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
485 }
486 else {
487     if ($^O eq 'os2') {
488       unshift @pagers, 'less', 'cmd /c more <';
489     }
490     push @pagers, qw( more less pg view cat );
491     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
492 }
493 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
494
495 if ($opt_m) {
496     foreach my $pager (@pagers) {
497         if (system($pager, @found) == 0) {
498             exit;
499     }
500     }
501     if ($Is_VMS) { 
502         eval q{
503             use vmsish qw(status exit); 
504             exit $?;
505             1;
506         } or die;
507     }
508     exit(1);
509 }
510
511 my @pod;
512 if ($opt_f) {
513     my $perlfunc = shift @found;
514     open(PFUNC, "<", $perlfunc)
515         or die("Can't open $perlfunc: $!");
516
517     # Functions like -r, -e, etc. are listed under `-X'.
518     my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
519                         ? 'I<-X' : $opt_f ;
520
521     # Skip introduction
522     local $_;
523     while (<PFUNC>) {
524         last if /^=head2 Alphabetical Listing of Perl Functions/;
525     }
526
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;
533         }
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;
543         }
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     }
550     close PFUNC         or die "Can't open $perlfunc: $!";
551 }
552
553 if ($opt_q) {
554     local @ARGV = @found;       # I'm lazy, sue me.
555     my $found = 0;
556     my %found_in;
557     my $rx = eval { qr/$opt_q/ } or die <<EOD;
558 Invalid regular expression '$opt_q' given as -q pattern:
559   $@
560 Did you mean \\Q$opt_q ?
561
562 EOD
563
564     for (@found) { die "invalid file spec: $!" if /[<>|]/ } 
565     local $_;
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}++;
570         }
571         elsif (/^=head2/) {
572             $found = 0;
573         }
574         next unless $found;
575         push @pod, $_;
576     }
577     if (!@pod) {
578         die("No documentation for perl FAQ keyword `$opt_q' found\n");
579     }
580 }
581
582 require File::Temp;
583
584 my ($tmpfd, $tmp) = File::Temp::tempfile(UNLINK => 1);
585
586 my $filter;
587
588 if (@pod) {
589     my ($buffd, $buffer) = File::Temp::tempfile(UNLINK => 1);
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: $!";
594     @found = $buffer;
595     $filter = 1;
596 }
597
598 foreach (@found) {
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) {
606         my $cmd = catfile($bindir, $pod2man) . " --lax $file | $opt_n -man";
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     }
627 }
628 close $tmpfd
629     or die "Can't close $tmp: $!";
630 page($tmp, $no_tty, @pagers);
631
632 exit;
633
634 sub 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
642 sub am_taint_checking {
643     my($k,$v) = each %ENV;
644     return is_tainted($v);  
645 }
646
647
648 __END__
649
650 =head1 NAME
651
652 perldoc - Look up Perl documentation in pod format.
653
654 =head1 SYNOPSIS
655
656 B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]  [B<-X>] PageName|ModuleName|ProgramName
657
658 B<perldoc> B<-f> BuiltinFunction
659
660 B<perldoc> B<-q> FAQ Keyword
661
662 =head1 DESCRIPTION
663
664 I<perldoc> looks up a piece of documentation in .pod format that is embedded
665 in the perl installation tree or in a perl script, and displays it via
666 C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
667 C<col -x> will be used.) This is primarily used for the documentation for
668 the perl library modules.
669
670 Your system may also have man pages installed for those modules, in
671 which 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
679 Prints out a brief help message.
680
681 =item B<-v> verbose
682
683 Describes search for the item in detail.
684
685 =item B<-t> text output
686
687 Display docs using plain text converter, instead of nroff. This may be faster,
688 but it won't look as nice.
689
690 =item B<-u> unformatted
691
692 Find docs only; skip reformatting by pod2*
693
694 =item B<-m> module
695
696 Display the entire module: both code and unformatted pod documentation.
697 This may be useful if the docs don't explain a function in the detail
698 you need, and you'd like to inspect the code directly; perldoc will find
699 the file for you and simply hand it off for display.
700
701 =item B<-l> file name only
702
703 Display the file name of the module found.
704
705 =item B<-F> file names
706
707 Consider arguments as file names, no search in directories will be performed.
708
709 =item B<-f> perlfunc
710
711 The B<-f> option followed by the name of a perl built in function will
712 extract the documentation of this function from L<perlfunc>.
713
714 =item B<-q> perlfaq
715
716 The B<-q> option takes a regular expression as an argument.  It will search
717 the question headings in perlfaq[1-9] and print the entries matching
718 the regular expression.
719
720 =item B<-X> use an index if present
721
722 The B<-X> option looks for an entry whose basename matches the name given on the
723 command line in the file C<$Config{archlib}/pod.idx>.  The pod.idx file should
724 contain fully qualified filenames, one per line.
725
726 =item B<-U> run insecurely
727
728 Because B<perldoc> does not run properly tainted, and is known to
729 have security issues, it will not normally execute as the superuser.
730 If you use the B<-U> flag, it will do so, but only after setting
731 the effective and real IDs to nobody's or nouser's account, or -2
732 if unavailable.  If it cannot relinquish its privileges, it will not
733 run.  
734
735 =item B<PageName|ModuleName|ProgramName>
736
737 The item you want to look up.  Nested modules (such as C<File::Basename>)
738 are specified either as C<File::Basename> or C<File/Basename>.  You may also
739 give a descriptive name of a page, such as C<perlfunc>. You may also give a
740 partial or wrong-case name, such as "basename" for "File::Basename", but
741 this will be slower, if there is more then one page with the same partial
742 name, you will only get the first one.
743
744 =back
745
746 =head1 ENVIRONMENT
747
748 Any switches in the C<PERLDOC> environment variable will be used before the
749 command line arguments.  C<perldoc> also searches directories
750 specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
751 defined) and C<PATH> environment variables.
752 (The latter is so that embedded pods for executables, such as
753 C<perldoc> itself, are available.)  C<perldoc> will use, in order of
754 preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
755 C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
756 used if C<perldoc> was told to display plain text or unformatted pod.)
757
758 One useful value for C<PERLDOC_PAGER> is C<less -+C -E>.
759
760 =head1 VERSION
761
762 This is perldoc v2.03.
763
764 =head1 AUTHOR
765
766 Kenneth Albanowski <kjahds@kjahds.com>
767
768 Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>,
769 and others.
770
771 =cut
772
773 #
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
777 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
778 #       Tom Christiansen <tchrist@perl.com>
779 #       Added -U insecurity option
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: ????
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
789 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
790 #       Robin Barker <rmb1@cise.npl.co.uk>
791 #       -strict, -w cleanups
792 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
793 #       Gurusamy Sarathy <gsar@activestate.com>
794 #       -doc tweaks for -F and -X options
795 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
796 #       Gurusamy Sarathy <gsar@activestate.com>
797 #       -various fixes for win32
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
802 #
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
823 !NO!SUBS!
824
825 close OUT or die "Can't close $file: $!";
826 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
827 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
828 chdir $origdir;