source: trunk/third/perl/utils/perldoc.PL @ 14545

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