3 use 5.006; # we use some open(X, "<", $y) syntax
9 use Fcntl; # for sysopen
10 use File::Spec::Functions qw(catfile catdir splitdir);
12 use vars qw($VERSION @Pagers $Bindir $Pod2man
13 $Temp_Files_Created $Temp_File_Lifetime
16 #..........................................................................
18 BEGIN { # Make a DEBUG constant very first thing...
19 unless(defined &DEBUG) {
20 if(($ENV{'PERLDOCDEBUG'} || '') =~ m/^(\d+)/) { # untaint
21 eval("sub DEBUG () {$1}");
22 die "WHAT? Couldn't eval-up a DEBUG constant!? $@" if $@;
29 use Pod::Perldoc::GetOptsOO; # uses the DEBUG.
31 #..........................................................................
37 *IS_VMS = $^O eq 'VMS' ? \&TRUE : \&FALSE unless defined &IS_VMS;
38 *IS_MSWin32 = $^O eq 'MSWin32' ? \&TRUE : \&FALSE unless defined &IS_MSWin32;
39 *IS_Dos = $^O eq 'dos' ? \&TRUE : \&FALSE unless defined &IS_Dos;
40 *IS_OS2 = $^O eq 'os2' ? \&TRUE : \&FALSE unless defined &IS_OS2;
41 *IS_Cygwin = $^O eq 'cygwin' ? \&TRUE : \&FALSE unless defined &IS_Cygwin;
42 *IS_Linux = $^O eq 'linux' ? \&TRUE : \&FALSE unless defined &IS_Linux;
43 *IS_HPUX = $^O =~ m/hpux/ ? \&TRUE : \&FALSE unless defined &IS_HPUX;
46 $Temp_File_Lifetime ||= 60 * 60 * 24 * 5;
47 # If it's older than five days, it's quite unlikely
48 # that anyone's still looking at it!!
49 # (Currently used only by the MSWin cleanup routine)
52 #..........................................................................
53 { my $pager = $Config{'pager'};
54 push @Pagers, $pager if -x (split /\s+/, $pager)[0] or IS_VMS;
56 $Bindir = $Config{'scriptdirexp'};
57 $Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' );
59 # End of class-init stuff
61 ###########################################################################
65 foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdUL}) {
67 *$subname = do{ use strict 'refs'; sub () { shift->_elem($subname, @_) } };
70 # And these are so that GetOptsOO knows they take options:
71 sub opt_f_with { shift->_elem('opt_f', @_) }
72 sub opt_q_with { shift->_elem('opt_q', @_) }
73 sub opt_d_with { shift->_elem('opt_d', @_) }
74 sub opt_L_with { shift->_elem('opt_L', @_) }
76 sub opt_w_with { # Specify an option for the formatter subclass
77 my($self, $value) = @_;
78 if($value =~ m/^([-_a-zA-Z][-_a-zA-Z0-9]*)(?:[=\:](.*?))?$/s) {
80 my $option_value = defined($2) ? $2 : "TRUE";
81 $option =~ tr/\-/_/s; # tolerate "foo-bar" for "foo_bar"
82 $self->add_formatter_option( $option, $option_value );
84 warn "\"$value\" isn't a good formatter option name. I'm ignoring it!\n";
89 sub opt_M_with { # specify formatter class name(s)
90 my($self, $classes) = @_;
91 return unless defined $classes and length $classes;
92 DEBUG > 4 and print "Considering new formatter classes -M$classes\n";
94 foreach my $classname (split m/[,;]+/s, $classes) {
95 next unless $classname =~ m/\S/;
96 if( $classname =~ m/^(\w+(::\w+)+)$/s ) {
97 # A mildly restrictive concept of what modulenames are valid.
98 push @classes_to_add, $1; # untaint
100 warn "\"$classname\" isn't a valid classname. Ignoring.\n";
104 unshift @{ $self->{'formatter_classes'} }, @classes_to_add;
107 "Adding @classes_to_add to the list of formatter classes, "
108 . "making them @{ $self->{'formatter_classes'} }.\n"
114 sub opt_V { # report version and exit
116 "Perldoc v$VERSION, under perl v$] for $^O",
118 (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
119 ? (" (win32 build ", &Win32::BuildNumber(), ")") : (),
121 (chr(65) eq 'A') ? () : " (non-ASCII)",
128 sub opt_t { # choose plaintext as output format
130 $self->opt_o_with('text') if @_ and $_[0];
131 return $self->_elem('opt_t', @_);
134 sub opt_u { # choose raw pod as output format
136 $self->opt_o_with('pod') if @_ and $_[0];
137 return $self->_elem('opt_u', @_);
141 # choose man as the output format, and specify the proggy to run
143 $self->opt_o_with('man') if @_ and $_[0];
144 $self->_elem('opt_n', @_);
147 sub opt_o_with { # "o" for output format
148 my($self, $rest) = @_;
149 return unless defined $rest and length $rest;
150 if($rest =~ m/^(\w+)$/s) {
153 warn "\"$rest\" isn't a valid output format. Skipping.\n";
157 $self->aside("Noting \"$rest\" as desired output format...\n");
159 # Figure out what class(es) that could actually mean...
162 foreach my $prefix ("Pod::Perldoc::To", "Pod::Simple::", "Pod::") {
165 $rest, # Yes, try it first with the given capitalization
166 "\L$rest", "\L\u$rest", "\U$rest" # And then try variations
169 push @classes, $prefix . $stem;
170 #print "Considering $prefix$stem\n";
173 # Tidier, but misses too much:
174 #push @classes, $prefix . ucfirst(lc($rest));
176 $self->opt_M_with( join ";", @classes );
180 ###########################################################################
181 # % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
183 sub run { # to be called by the "perldoc" executable
186 print "Parameters to $class\->run:\n";
189 $x[1] = '<undef>' unless defined $x[1];
190 $x[1] = "@{$x[1]}" if ref( $x[1] ) eq 'ARRAY';
191 print " [$x[0]] => [$x[1]]\n";
196 return $class -> new(@_) -> process() || 0;
199 # % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
200 ###########################################################################
202 sub new { # yeah, nothing fancy
204 my $new = bless {@_}, (ref($class) || $class);
205 DEBUG > 1 and print "New $class object $new\n";
210 #..........................................................................
212 sub aside { # If we're in -v or DEBUG mode, say this.
214 if( DEBUG or $self->opt_v ) {
217 my $callsub = (caller(1))[3];
218 my $package = quotemeta(__PACKAGE__ . '::');
219 $callsub =~ s/^$package/'/os;
220 # the o is justified, as $package really won't change.
225 if(DEBUG) { print $out } else { print STDERR $out }
230 #..........................................................................
236 # Erase evidence of previous errors (if any), so exit status is simple.
240 perldoc [options] PageName|ModuleName|ProgramName...
241 perldoc [options] -f BuiltinFunction
242 perldoc [options] -q FAQRegex
245 -h Display this help message
247 -r Recursive search (slow)
249 -t Display pod using pod2text instead of pod2man and nroff
250 (-t is the default on win32 unless -n is specified)
251 -u Display unformatted pod text
252 -m Display module's file in its entirety
253 -n Specify replacement for nroff
254 -l Display the module's file name
255 -F Arguments are file names, not modules
256 -v Verbosely describe what's going on
257 -T Send output to STDOUT without any pager
258 -d output_filename_to_send_to
259 -o output_format_name
260 -M FormatterModuleNameToUse
261 -w formatter_option:option_value
262 -L translation_code Choose doc translation (if any)
263 -X use index if present (looks for pod.idx at $Config{archlib})
264 -q Search the text of questions (not answers) in perlfaq[1-9]
266 PageName|ModuleName...
267 is the name of a piece of documentation that you want to look at. You
268 may either give a descriptive name of the page (as in the case of
269 `perlfunc') the name of a module, either like `Term::Info' or like
270 `Term/Info', or the name of a program, like `perldoc'.
273 is the name of a perl function. Will extract documentation from
277 is a regex. Will search perlfaq[1-9] for and extract any
278 questions that match.
280 Any switches in the PERLDOC environment variable will be used before the
281 command line arguments. The optional pod index file contains a list of
282 filenames, one per line.
288 #..........................................................................
291 my $me = $0; # Editing $0 is unportable
293 $me =~ s,.*[/\\],,; # get basename
296 Usage: $me [-h] [-V] [-r] [-i] [-v] [-t] [-u] [-m] [-n nroffer_program] [-l] [-T] [-d output_filename] [-o output_format] [-M FormatterModuleNameToUse] [-w formatter_option:option_value] [-L translation_code] [-F] [-X] PageName|ModuleName|ProgramName
300 The -h option prints more help. Also try "perldoc perldoc" to get
301 acquainted with the system. [Perldoc v$VERSION]
306 #..........................................................................
308 sub pagers { @{ shift->{'pagers'} } }
310 #..........................................................................
312 sub _elem { # handy scalar meta-accessor: shift->_elem("foo", @_)
313 if(@_ > 2) { return $_[0]{ $_[1] } = $_[2] }
314 else { return $_[0]{ $_[1] } }
316 #..........................................................................
317 ###########################################################################
319 # Init formatter switches, and start it off with __bindir and all that
320 # other stuff that ToMan.pm needs.
326 # Make sure creat()s are neither too much nor too little
327 eval { umask(0077) }; # doubtless someone has no mask
329 $self->{'args'} ||= \@ARGV;
330 $self->{'found'} ||= [];
331 $self->{'temp_file_list'} ||= [];
334 $self->{'target'} = undef;
336 $self->init_formatter_class_list;
338 $self->{'pagers' } = [@Pagers] unless exists $self->{'pagers'};
339 $self->{'bindir' } = $Bindir unless exists $self->{'bindir'};
340 $self->{'pod2man'} = $Pod2man unless exists $self->{'pod2man'};
342 push @{ $self->{'formatter_switches'} = [] }, (
343 # Yeah, we could use a hashref, but maybe there's some class where options
344 # have to be ordered; so we'll use an arrayref.
346 [ '__bindir' => $self->{'bindir' } ],
347 [ '__pod2man' => $self->{'pod2man'} ],
350 DEBUG > 3 and printf "Formatter switches now: [%s]\n",
351 join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
356 #..........................................................................
358 sub init_formatter_class_list {
360 $self->{'formatter_classes'} ||= [];
362 # Remember, no switches have been read yet, when
363 # we've started this routine.
365 $self->opt_M_with('Pod::Perldoc::ToPod'); # the always-there fallthru
366 $self->opt_o_with('text');
367 $self->opt_o_with('man') unless IS_MSWin32 || IS_Dos
369 ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i
375 #..........................................................................
378 # if this ever returns, its retval will be used for exit(RETVAL)
381 DEBUG > 1 and print " Beginning process.\n";
382 DEBUG > 1 and print " Args: @{$self->{'args'}}\n\n";
384 print "Object contents:\n";
387 $x[1] = '<undef>' unless defined $x[1];
388 $x[1] = "@{$x[1]}" if ref( $x[1] ) eq 'ARRAY';
389 print " [$x[0]] => [$x[1]]\n";
395 # TODO: make it deal with being invoked as various different things
398 return $self->usage_brief unless @{ $self->{'args'} };
399 $self->pagers_guessing;
400 $self->options_reading;
401 $self->aside(sprintf "$0 => %s v%s\n", ref($self), $self->VERSION);
402 $self->drop_privs_maybe;
403 $self->options_processing;
405 # Hm, we have @pages and @found, but we only really act on one
406 # file per call, with the exception of the opt_q hack, and with
412 $self->{'pages'} = \@pages;
413 if( $self->opt_f) { @pages = ("perlfunc") }
414 elsif( $self->opt_q) { @pages = ("perlfaq1" .. "perlfaq9") }
415 else { @pages = @{$self->{'args'}};
417 # if @pages == 1 and $pages[0] eq 'perldoc';
420 return $self->usage_brief unless @pages;
422 # Adjusts pages for translation packages
423 if ( $self->opt_L ) {
424 eval "require POD2::" . uc($self->opt_L);
425 @pages = map { 'POD2::' . uc($self->opt_L) . '::' . $_ } @pages if ! $@;
428 $self->find_good_formatter_class();
429 $self->formatter_sanity_check();
431 $self->maybe_diddle_INC();
432 # for when we're apparently in a module or extension directory
434 my @found = $self->grand_search_init(\@pages);
435 exit (IS_VMS ? 98962 : 1) unless @found;
438 DEBUG and print "We're in -l mode, so byebye after this:\n";
439 print join("\n", @found), "\n";
443 $self->tweak_found_pathnames(\@found);
444 $self->assert_closing_stdout;
445 return $self->page_module_file(@found) if $self->opt_m;
446 DEBUG > 2 and print "Found: [@found]\n";
448 return $self->render_and_page(\@found);
451 #..........................................................................
454 my( %class_seen, %class_loaded );
455 sub find_good_formatter_class {
457 my @class_list = @{ $self->{'formatter_classes'} || [] };
458 die "WHAT? Nothing in the formatter class list!?" unless @class_list;
460 my $good_class_found;
461 foreach my $c (@class_list) {
462 DEBUG > 4 and print "Trying to load $c...\n";
463 if($class_loaded{$c}) {
464 DEBUG > 4 and print "OK, the already-loaded $c it is!\n";
465 $good_class_found = $c;
469 if($class_seen{$c}) {
471 "I've tried $c before, and it's no good. Skipping.\n";
477 if( $c->can('parse_from_file') ) {
479 "Interesting, the formatter class $c is already loaded!\n";
482 (IS_VMS or IS_MSWin32 or IS_Dos or IS_OS2)
483 # the alway case-insensitive fs's
484 and $class_seen{lc("~$c")}++
487 "We already used something quite like \"\L$c\E\", so no point using $c\n";
488 # This avoids redefining the package.
490 DEBUG > 4 and print "Trying to eval 'require $c'...\n";
493 if(DEBUG() or $self->opt_v) {
494 # feh, let 'em see it
497 # The average user just has no reason to be seeing
498 # $^W-suppressable warnings from the the require!
503 DEBUG > 4 and print "Couldn't load $c: $!\n";
508 if( $c->can('parse_from_file') ) {
509 DEBUG > 4 and print "Settling on $c\n";
511 $v = ( defined $v and length $v ) ? " version $v" : '';
512 $self->aside("Formatter class $c$v successfully loaded!\n");
513 $good_class_found = $c;
516 DEBUG > 4 and print "Class $c isn't a formatter?! Skipping.\n";
520 die "Can't find any loadable formatter class in @class_list?!\nAborting"
521 unless $good_class_found;
523 $self->{'formatter_class'} = $good_class_found;
524 $self->aside("Will format with the class $good_class_found\n");
530 #..........................................................................
532 sub formatter_sanity_check {
534 my $formatter_class = $self->{'formatter_class'}
535 || die "NO FORMATTER CLASS YET!?";
537 if(!$self->opt_T # so -T can FORCE sending to STDOUT
538 and $formatter_class->can('is_pageable')
539 and !$formatter_class->is_pageable
540 and !$formatter_class->can('page_for_perldoc')
543 ($formatter_class->can('output_extension')
544 && $formatter_class->output_extension
546 $ext = ".$ext" if length $ext;
549 "When using Perldoc to format with $formatter_class, you have to\n"
550 . "specify -T or -dsomefile$ext\n"
551 . "See `perldoc perldoc' for more information on those switches.\n"
556 #..........................................................................
558 sub render_and_page {
559 my($self, $found_list) = @_;
561 $self->maybe_generate_dynamic_pod($found_list);
563 my($out, $formatter) = $self->render_findings($found_list);
566 printf "Perldoc (%s) output saved to %s\n",
567 $self->{'formatter_class'} || ref($self),
569 print "But notice that it's 0 bytes long!\n" unless -s $out;
572 } elsif( # Allow the formatter to "page" itself, if it wants.
573 $formatter->can('page_for_perldoc')
575 $self->aside("Going to call $formatter\->page_for_perldoc(\"$out\")\n");
576 if( $formatter->page_for_perldoc($out, $self) ) {
577 $self->aside("page_for_perldoc returned true, so NOT paging with $self.\n");
580 $self->aside("page_for_perldoc returned false, so paging with $self instead.\n");
585 # Do nothing, since the formatter has "paged" it for itself.
588 # Page it normally (internally)
590 if( -s $out ) { # Usual case:
591 $self->page($out, $self->{'output_to_stdout'}, $self->pagers);
595 $self->aside("Skipping $out (from $$found_list[0] "
596 . "via $$self{'formatter_class'}) as it is 0-length.\n");
598 push @{ $self->{'temp_file_list'} }, $out;
599 $self->unlink_if_temp_file($out);
603 $self->after_rendering(); # any extra cleanup or whatever
608 #..........................................................................
610 sub options_reading {
613 if( defined $ENV{"PERLDOC"} and length $ENV{"PERLDOC"} ) {
614 require Text::ParseWords;
615 $self->aside("Noting env PERLDOC setting of $ENV{'PERLDOC'}\n");
616 # Yes, appends to the beginning
617 unshift @{ $self->{'args'} },
618 Text::ParseWords::shellwords( $ENV{"PERLDOC"} )
620 DEBUG > 1 and print " Args now: @{$self->{'args'}}\n\n";
622 DEBUG > 1 and print " Okay, no PERLDOC setting in ENV.\n";
626 and print " Args right before switch processing: @{$self->{'args'}}\n";
628 Pod::Perldoc::GetOptsOO::getopts( $self, $self->{'args'}, 'YES' )
629 or return $self->usage;
632 and print " Args after switch processing: @{$self->{'args'}}\n";
634 return $self->usage if $self->opt_h;
639 #..........................................................................
641 sub options_processing {
645 my $podidx = "$Config{'archlib'}/pod.idx";
646 $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
647 $self->{'podidx'} = $podidx;
650 $self->{'output_to_stdout'} = 1 if $self->opt_T or ! -t STDOUT;
652 $self->options_sanity;
654 $self->opt_n("nroff") unless $self->opt_n;
655 $self->add_formatter_option( '__nroffer' => $self->opt_n );
660 #..........................................................................
665 # The opts-counting stuff interacts quite badly with
666 # the $ENV{"PERLDOC"} stuff. I.e., if I have $ENV{"PERLDOC"}
667 # set to -t, and I specify -u on the command line, I don't want
668 # to be hectored at that -u and -t don't make sense together.
670 #my $opts = grep $_ && 1, # yes, the count of the set ones
671 # $self->opt_t, $self->opt_u, $self->opt_m, $self->opt_l
674 #$self->usage("only one of -t, -u, -m or -l") if $opts > 1;
677 # Any sanity-checking need doing here?
679 # But does not make sense to set either -f or -q in $ENV{"PERLDOC"}
680 if( $self->opt_f or $self->opt_q ) {
681 $self->usage("Only one of -f -or -q") if $self->opt_f and $self->opt_q;
683 "Perldoc is only really meant for reading one word at a time.\n",
684 "So these parameters are being ignored: ",
685 join(' ', @{$self->{'args'}}),
687 if @{$self->{'args'}}
692 #..........................................................................
694 sub grand_search_init {
695 my($self, $pages, @found) = @_;
698 if ($self->{'podidx'} && open(PODIDX, $self->{'podidx'})) {
699 my $searchfor = catfile split '::', $_;
700 $self->aside( "Searching for '$searchfor' in $self->{'podidx'}\n" );
704 push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
706 close(PODIDX) or die "Can't close $$self{'podidx'}: $!";
710 $self->aside( "Searching for $_\n" );
714 push @found, $_ if $self->opt_m or $self->containspod($_);
718 # We must look both in @INC for library modules and in $bindir
719 # for executables, like h2xs or perldoc itself.
721 my @searchdirs = ($self->{'bindir'}, @INC);
722 unless ($self->opt_m) {
725 for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
726 push(@searchdirs,$trn);
728 push(@searchdirs,'perl_root:[lib.pod]') # installed pods
731 push(@searchdirs, grep(-d, split($Config{path_sep},
735 my @files = $self->searchfor(0,$_,@searchdirs);
737 $self->aside( "Found as @files\n" );
740 # no match, try recursive search
741 @searchdirs = grep(!/^\.\z/s,@INC);
742 @files= $self->searchfor(1,$_,@searchdirs) if $self->opt_r;
744 $self->aside( "Loosely found as @files\n" );
748 ($self->opt_m ? "module" : "documentation") . " found for \"$_\".\n";
749 if ( @{ $self->{'found'} } ) {
750 print STDERR "However, try\n";
751 for my $dir (@{ $self->{'found'} }) {
752 opendir(DIR, $dir) or die "opendir $dir: $!";
753 while (my $file = readdir(DIR)) {
754 next if ($file =~ /^\./s);
755 $file =~ s/\.(pm|pod)\z//; # XXX: badfs
756 print STDERR "\tperldoc $_\::$file\n";
758 closedir(DIR) or die "closedir $dir: $!";
768 #..........................................................................
770 sub maybe_generate_dynamic_pod {
771 my($self, $found_things) = @_;
774 $self->search_perlfunc($found_things, \@dynamic_pod) if $self->opt_f;
776 $self->search_perlfaqs($found_things, \@dynamic_pod) if $self->opt_q;
778 if( ! $self->opt_f and ! $self->opt_q ) {
779 DEBUG > 4 and print "That's a non-dynamic pod search.\n";
780 } elsif ( @dynamic_pod ) {
781 $self->aside("Hm, I found some Pod from that search!\n");
782 my ($buffd, $buffer) = $self->new_tempfile('pod', 'dyn');
784 push @{ $self->{'temp_file_list'} }, $buffer;
785 # I.e., it MIGHT be deleted at the end.
787 my $in_list = $self->opt_f;
789 print $buffd "=over 8\n\n" if $in_list;
790 print $buffd @dynamic_pod or die "Can't print $buffer: $!";
791 print $buffd "=back\n" if $in_list;
793 close $buffd or die "Can't close $buffer: $!";
795 @$found_things = $buffer;
796 # Yes, so found_things never has more than one thing in
797 # it, by time we leave here
799 $self->add_formatter_option('__filter_nroff' => 1);
803 $self->aside("I found no Pod from that search!\n");
809 #..........................................................................
811 sub add_formatter_option { # $self->add_formatter_option('key' => 'value');
813 push @{ $self->{'formatter_switches'} }, [ @_ ] if @_;
815 DEBUG > 3 and printf "Formatter switches now: [%s]\n",
816 join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
821 #..........................................................................
823 sub search_perlfunc {
824 my($self, $found_things, $pod) = @_;
826 DEBUG > 2 and print "Search: @$found_things\n";
828 my $perlfunc = shift @$found_things;
829 open(PFUNC, "<", $perlfunc) # "Funk is its own reward"
830 or die("Can't open $perlfunc: $!");
832 # Functions like -r, -e, etc. are listed under `-X'.
833 my $search_re = ($self->opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
834 ? '(?:I<)?-X' : quotemeta($self->opt_f) ;
837 print "Going to perlfunc-scan for $search_re in $perlfunc\n";
839 my $re = 'Alphabetical Listing of Perl Functions';
840 if ( $self->opt_L ) {
841 my $code = 'POD2::' . uc($self->opt_L);
842 $re = $code->search_perlfunc_re if $code->can('search_perlfunc_re');
848 last if /^=head2 $re/;
851 # Look for our function
854 while (<PFUNC>) { # "The Mothership Connection is here!"
855 if ( m/^=item\s+$search_re\b/ ) {
859 last if $found > 1 and not $inlist;
869 ++$found if /^\w/; # found descriptive text
873 "No documentation for perl function `%s' found\n",
877 close PFUNC or die "Can't open $perlfunc: $!";
882 #..........................................................................
884 sub search_perlfaqs {
885 my( $self, $found_things, $pod) = @_;
889 my $search_key = $self->opt_q;
891 my $rx = eval { qr/$search_key/ }
893 Invalid regular expression '$search_key' given as -q pattern:
895 Did you mean \\Q$search_key ?
900 foreach my $file (@$found_things) {
901 die "invalid file spec: $!" if $file =~ /[<>|]/;
902 open(INFAQ, "<", $file) # XXX 5.6ism
903 or die "Can't read-open $file: $!\nAborting";
905 if ( m/^=head2\s+.*(?:$search_key)/i ) {
907 push @$pod, "=head1 Found in $file\n\n" unless $found_in{$file}++;
909 elsif (/^=head[12]/) {
917 die("No documentation for perl FAQ keyword `$search_key' found\n")
924 #..........................................................................
926 sub render_findings {
927 # Return the filename to open
929 my($self, $found_things) = @_;
931 my $formatter_class = $self->{'formatter_class'}
932 || die "No formatter class set!?";
933 my $formatter = $formatter_class->can('new')
934 ? $formatter_class->new
938 if(! @$found_things) {
939 die "Nothing found?!";
940 # should have been caught before here
941 } elsif(@$found_things > 1) {
943 "Perldoc is only really meant for reading one document at a time.\n",
944 "So these parameters are being ignored: ",
945 join(' ', @$found_things[1 .. $#$found_things] ),
949 my $file = $found_things->[0];
951 DEBUG > 3 and printf "Formatter switches now: [%s]\n",
952 join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
954 # Set formatter options:
955 if( ref $formatter ) {
956 foreach my $f (@{ $self->{'formatter_switches'} || [] }) {
957 my($switch, $value, $silent_fail) = @$f;
958 if( $formatter->can($switch) ) {
959 eval { $formatter->$switch( defined($value) ? $value : () ) };
960 warn "Got an error when setting $formatter_class\->$switch:\n$@\n"
963 if( $silent_fail or $switch =~ m/^__/s ) {
964 DEBUG > 2 and print "Formatter $formatter_class doesn't support $switch\n";
966 warn "$formatter_class doesn't recognize the $switch switch.\n";
972 $self->{'output_is_binary'} =
973 $formatter->can('write_with_binmode') && $formatter->write_with_binmode;
975 my ($out_fh, $out) = $self->new_output_file(
976 ( $formatter->can('output_extension') && $formatter->output_extension )
978 $self->useful_filename_bit,
981 # Now, finally, do the formatting!
984 if(DEBUG() or $self->opt_v) {
985 # feh, let 'em see it
988 # The average user just has no reason to be seeing
989 # $^W-suppressable warnings from the formatting!
992 eval { $formatter->parse_from_file( $file, $out_fh ) };
995 warn "Error while formatting with $formatter_class:\n $@\n" if $@;
996 DEBUG > 2 and print "Back from formatting with $formatter_class\n";
999 or warn "Can't close $out: $!\n(Did $formatter already close it?)";
1000 sleep 0; sleep 0; sleep 0;
1001 # Give the system a few timeslices to meditate on the fact
1002 # that the output file does in fact exist and is closed.
1004 $self->unlink_if_temp_file($file);
1007 if( $formatter->can( 'if_zero_length' ) ) {
1008 # Basically this is just a hook for Pod::Simple::Checker; since
1009 # what other class could /happily/ format an input file with Pod
1010 # as a 0-length output file?
1011 $formatter->if_zero_length( $file, $out, $out_fh );
1013 warn "Got a 0-length file from $$found_things[0] via $formatter_class!?\n"
1017 DEBUG and print "Finished writing to $out.\n";
1018 return($out, $formatter) if wantarray;
1022 #..........................................................................
1024 sub unlink_if_temp_file {
1025 # Unlink the specified file IFF it's in the list of temp files.
1026 # Really only used in the case of -f / -q things when we can
1027 # throw away the dynamically generated source pod file once
1028 # we've formatted it.
1030 my($self, $file) = @_;
1031 return unless defined $file and length $file;
1033 my $temp_file_list = $self->{'temp_file_list'} || return;
1034 if(grep $_ eq $file, @$temp_file_list) {
1035 $self->aside("Unlinking $file\n");
1036 unlink($file) or warn "Odd, couldn't unlink $file: $!";
1038 DEBUG > 1 and print "$file isn't a temp file, so not unlinking.\n";
1043 #..........................................................................
1045 sub MSWin_temp_cleanup {
1047 # Nothing particularly MSWin-specific in here, but I don't know if any
1048 # other OS needs its temp dir policed like MSWin does!
1052 my $tempdir = $ENV{'TEMP'};
1053 return unless defined $tempdir and length $tempdir
1054 and -e $tempdir and -d _ and -w _;
1057 "Considering whether any old files of mine in $tempdir need unlinking.\n"
1060 opendir(TMPDIR, $tempdir) || return;
1063 my $limit = time() - $Temp_File_Lifetime;
1065 DEBUG > 5 and printf "Looking for things pre-dating %s (%x)\n",
1070 while(defined($filespec = readdir(TMPDIR))) {
1072 $filespec =~ m{^perldoc_[a-zA-Z0-9]+_T([a-fA-F0-9]{7,})_[a-fA-F0-9]{3,}}s
1074 if( hex($1) < $limit ) {
1075 push @to_unlink, "$tempdir/$filespec";
1076 $self->aside( "Will unlink my old temp file $to_unlink[-1]\n" );
1079 printf " $tempdir/$filespec is too recent (after %x)\n", $limit;
1083 print " $tempdir/$filespec doesn't look like a perldoc temp file.\n";
1087 $self->aside(sprintf "Unlinked %s items of mine in %s\n",
1088 scalar(unlink(@to_unlink)),
1094 # . . . . . . . . . . . . . . . . . . . . . . . . .
1096 sub MSWin_perldoc_tempfile {
1097 my($self, $suffix, $infix) = @_;
1099 my $tempdir = $ENV{'TEMP'};
1100 return unless defined $tempdir and length $tempdir
1101 and -e $tempdir and -d _ and -w _;
1106 $spec = sprintf "%s\\perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
1107 # Yes, we embed the create-time in the filename!
1112 defined( &Win32::GetTickCount )
1113 ? (Win32::GetTickCount() & 0xff)
1115 # Under MSWin, $$ values get reused quickly! So if we ran
1116 # perldoc foo and then perldoc bar before there was time for
1117 # time() to increment time."_$$" would likely be the same
1118 # for each process! So we tack on the tick count's lower
1119 # bits (or, in a pinch, rand)
1123 } while( -e $spec );
1127 while($counter < 50) {
1129 # If we are running before perl5.6.0, we can't autovivify
1132 $fh = Symbol::gensym();
1134 DEBUG > 3 and print "About to try making temp file $spec\n";
1135 return($fh, $spec) if open($fh, ">", $spec); # XXX 5.6ism
1136 $self->aside("Can't create temp file $spec: $!\n");
1139 $self->aside("Giving up on making a temp file!\n");
1140 die "Can't make a tempfile!?";
1143 #..........................................................................
1146 sub after_rendering {
1148 $self->after_rendering_VMS if IS_VMS;
1149 $self->after_rendering_MSWin32 if IS_MSWin32;
1150 $self->after_rendering_Dos if IS_Dos;
1151 $self->after_rendering_OS2 if IS_OS2;
1155 sub after_rendering_VMS { return }
1156 sub after_rendering_Dos { return }
1157 sub after_rendering_OS2 { return }
1159 sub after_rendering_MSWin32 {
1160 shift->MSWin_temp_cleanup() if $Temp_Files_Created;
1163 #..........................................................................
1165 #..........................................................................
1168 sub minus_f_nocase { # i.e., do like -f, but without regard to case
1170 my($self, $dir, $file) = @_;
1171 my $path = catfile($dir,$file);
1172 return $path if -f $path and -r _;
1175 or IS_VMS or IS_MSWin32
1178 # On a case-forgiving file system, or if case is important,
1179 # that is it, all we can do.
1180 warn "Ignored $path: unreadable\n" if -f _;
1187 foreach $p (splitdir $file){
1188 my $try = catfile @p, $p;
1189 $self->aside("Scrutinizing $try...\n");
1193 if ( $p eq $self->{'target'} ) {
1194 my $tmp_path = catfile @p;
1196 for (@{ $self->{'found'} }) {
1197 $path_f = 1 if $_ eq $tmp_path;
1199 push (@{ $self->{'found'} }, $tmp_path) unless $path_f;
1200 $self->aside( "Found as $tmp_path but directory\n" );
1203 elsif (-f _ && -r _) {
1207 warn "Ignored $try: unreadable\n";
1209 elsif (-d catdir(@p)) { # at least we see the containing directory!
1212 my $p_dirspec = catdir(@p);
1213 opendir DIR, $p_dirspec or die "opendir $p_dirspec: $!";
1214 while(defined( $cip = readdir(DIR) )) {
1215 if (lc $cip eq $lcp){
1217 last; # XXX stop at the first? what if there's others?
1220 closedir DIR or die "closedir $p_dirspec: $!";
1221 return "" unless $found;
1224 my $p_filespec = catfile(@p);
1225 return $p_filespec if -f $p_filespec and -r _;
1226 warn "Ignored $p_filespec: unreadable\n" if -f _;
1232 #..........................................................................
1234 sub pagers_guessing {
1238 push @pagers, $self->pagers;
1239 $self->{'pagers'} = \@pagers;
1242 push @pagers, qw( more< less notepad );
1243 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
1246 push @pagers, qw( most more less type/page );
1249 push @pagers, qw( less.exe more.com< );
1250 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
1254 unshift @pagers, 'less', 'cmd /c more <';
1256 push @pagers, qw( more less pg view cat );
1257 unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
1261 if (($pagers[0] eq 'less') || ($pagers[0] eq '/usr/bin/less')) {
1262 unshift @pagers, '/usr/bin/less -isrR';
1266 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
1271 #..........................................................................
1273 sub page_module_file {
1274 my($self, @found) = @_;
1277 # Don't ever just pass this off to anything like MSWin's "start.exe",
1278 # since we might be calling on a .pl file, and we wouldn't want that
1279 # to actually /execute/ the file that we just want to page thru!
1280 # Also a consideration if one were to use a web browser as a pager;
1281 # doing so could trigger the browser's MIME mapping for whatever
1282 # it thinks .pm/.pl/whatever is. Probably just a (useless and
1283 # annoying) "Save as..." dialog, but potentially executing the file
1284 # in question -- particularly in the case of MSIE and it's, ahem,
1285 # occasionally hazy distinction between OS-local extension
1286 # associations, and browser-specific MIME mappings.
1288 if ($self->{'output_to_stdout'}) {
1289 $self->aside("Sending unpaged output to STDOUT.\n");
1292 foreach my $output (@found) {
1293 unless( open(TMP, "<", $output) ) { # XXX 5.6ism
1294 warn("Can't open $output: $!");
1299 print or die "Can't print to stdout: $!";
1301 close TMP or die "Can't close while $output: $!";
1302 $self->unlink_if_temp_file($output);
1304 return $any_error; # successful
1307 foreach my $pager ( $self->pagers ) {
1308 $self->aside("About to try calling $pager @found\n");
1309 if (system($pager, @found) == 0) {
1310 $self->aside("Yay, it worked.\n");
1313 $self->aside("That didn't work.\n");
1315 # Odd -- when it fails, under Win32, this seems to neither
1316 # return with a fail nor return with a success!!
1317 # That's discouraging!
1321 sprintf "Can't manage to find a way to page [%s] via pagers [%s]\n",
1323 join(' ', $self->pagers),
1327 DEBUG > 1 and print "Bailing out in a VMSish way.\n";
1329 use vmsish qw(status exit);
1336 # i.e., an UNSUCCESSFUL return value!
1339 #..........................................................................
1342 my($self, $dir, $file) = @_;
1344 unless( ref $self ) {
1345 # Should never get called:
1348 Carp::croak( join '',
1349 "Crazy ", __PACKAGE__, " error:\n",
1350 "check_file must be an object_method!\n",
1355 if(length $dir and not -d $dir) {
1356 DEBUG > 3 and print " No dir $dir -- skipping.\n";
1361 return $self->minus_f_nocase($dir,$file);
1365 my $path = $self->minus_f_nocase($dir,$file);
1366 if( length $path and $self->containspod($path) ) {
1368 " The file $path indeed looks promising!\n";
1372 DEBUG > 3 and print " No good: $file in $dir\n";
1377 #..........................................................................
1380 my($self, $file, $readit) = @_;
1381 return 1 if !$readit && $file =~ /\.pod\z/i;
1384 # Under cygwin the /usr/bin/perl is legal executable, but
1385 # you cannot open a file with that name. It must be spelled
1386 # out as "/usr/bin/perl.exe".
1388 # The following if-case under cygwin prevents error
1391 # Cannot open /usr/bin/perl: no such file or directory
1393 # This would work though
1395 # $ perldoc perl.pod
1397 if ( IS_Cygwin and -x $file and -f "$file.exe" )
1399 warn "Cygwin $file.exe search skipped\n" if DEBUG or $self->opt_v;
1404 open(TEST,"<", $file) or die "Can't open $file: $!"; # XXX 5.6ism
1407 close(TEST) or die "Can't close $file: $!";
1411 close(TEST) or die "Can't close $file: $!";
1415 #..........................................................................
1417 sub maybe_diddle_INC {
1420 # Does this look like a module or extension directory?
1422 if (-f "Makefile.PL") {
1424 # Add "." and "lib" to @INC (if they exist)
1425 eval q{ use lib qw(. lib); 1; } or die;
1427 # don't add if superuser
1428 if ($< && $> && -f "blib") { # don't be looking too hard now!
1429 eval q{ use blib; 1 };
1430 warn $@ if $@ && $self->opt_v;
1437 #..........................................................................
1439 sub new_output_file {
1441 my $outspec = $self->opt_d; # Yes, -d overrides all else!
1442 # So don't call this twice per format-job!
1444 return $self->new_tempfile(@_) unless defined $outspec and length $outspec;
1446 # Otherwise open a write-handle on opt_d!f
1449 # If we are running before perl5.6.0, we can't autovivify
1452 $fh = Symbol::gensym();
1454 DEBUG > 3 and print "About to try writing to specified output file $outspec\n";
1455 die "Can't write-open $outspec: $!"
1456 unless open($fh, ">", $outspec); # XXX 5.6ism
1458 DEBUG > 3 and print "Successfully opened $outspec\n";
1459 binmode($fh) if $self->{'output_is_binary'};
1460 return($fh, $outspec);
1463 #..........................................................................
1465 sub useful_filename_bit {
1466 # This tries to provide a meaningful bit of text to do with the query,
1467 # such as can be used in naming the file -- since if we're going to be
1468 # opening windows on temp files (as a "pager" may well do!) then it's
1469 # better if the temp file's name (which may well be used as the window
1470 # title) isn't ALL just random garbage!
1471 # In other words "perldoc_LWPSimple_2371981429" is a better temp file
1472 # name than "perldoc_2371981429". So this routine is what tries to
1473 # provide the "LWPSimple" bit.
1476 my $pages = $self->{'pages'} || return undef;
1477 return undef unless @$pages;
1479 my $chunk = $pages->[0];
1480 return undef unless defined $chunk;
1482 $chunk =~ s/\.\w+$//g; # strip any extension
1483 if( $chunk =~ m/([^\#\\:\/\$]+)$/s ) { # get basename, if it's a file
1488 $chunk =~ s/[^a-zA-Z0-9]+//g; # leave ONLY a-zA-Z0-9 things!
1489 $chunk = substr($chunk, -10) if length($chunk) > 10;
1493 #..........................................................................
1495 sub new_tempfile { # $self->new_tempfile( [$suffix, [$infix] ] )
1498 ++$Temp_Files_Created;
1501 my @out = $self->MSWin_perldoc_tempfile(@_);
1502 return @out if @out;
1503 # otherwise fall thru to the normal stuff below...
1507 return File::Temp::tempfile(UNLINK => 1);
1510 #..........................................................................
1512 sub page { # apply a pager to the output file
1513 my ($self, $output, $output_to_stdout, @pagers) = @_;
1514 if ($output_to_stdout) {
1515 $self->aside("Sending unpaged output to STDOUT.\n");
1516 open(TMP, "<", $output) or die "Can't open $output: $!"; # XXX 5.6ism
1519 print or die "Can't print to stdout: $!";
1521 close TMP or die "Can't close while $output: $!";
1522 $self->unlink_if_temp_file($output);
1524 # On VMS, quoting prevents logical expansion, and temp files with no
1525 # extension get the wrong default extension (such as .LIS for TYPE)
1527 $output = VMS::Filespec::rmsexpand($output, '.') if IS_VMS;
1529 $output =~ s{/}{\\}g if IS_MSWin32 || IS_Dos;
1530 # Altho "/" under MSWin is in theory good as a pathsep,
1531 # many many corners of the OS don't like it. So we
1532 # have to force it to be "\" to make everyone happy.
1534 foreach my $pager (@pagers) {
1535 $self->aside("About to try calling $pager $output\n");
1537 last if system("$pager $output") == 0;
1539 last if system("$pager \"$output\"") == 0;
1546 #..........................................................................
1549 my($self, $recurse,$s,@dirs) = @_;
1551 $s = VMS::Filespec::unixify($s) if IS_VMS;
1552 return $s if -f $s && $self->containspod($s);
1553 $self->aside( "Looking for $s in @dirs\n" );
1557 $self->{'target'} = (splitdir $s)[-1]; # XXX: why not use File::Basename?
1558 for ($i=0; $i<@dirs; $i++) {
1560 ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if IS_VMS;
1561 if ( (! $self->opt_m && ( $ret = $self->check_file($dir,"$s.pod")))
1562 or ( $ret = $self->check_file($dir,"$s.pm"))
1563 or ( $ret = $self->check_file($dir,$s))
1565 $ret = $self->check_file($dir,"$s.com"))
1567 $ret = $self->check_file($dir,"$s.cmd"))
1568 or ( (IS_MSWin32 or IS_Dos or IS_OS2) and
1569 $ret = $self->check_file($dir,"$s.bat"))
1570 or ( $ret = $self->check_file("$dir/pod","$s.pod"))
1571 or ( $ret = $self->check_file("$dir/pod",$s))
1572 or ( $ret = $self->check_file("$dir/pods","$s.pod"))
1573 or ( $ret = $self->check_file("$dir/pods",$s))
1575 DEBUG > 1 and print " Found $ret\n";
1580 opendir(D,$dir) or die "Can't opendir $dir: $!";
1581 my @newdirs = map catfile($dir, $_), grep {
1583 not /^auto\z/s and # save time! don't search auto dirs
1584 -d catfile($dir, $_)
1586 closedir(D) or die "Can't closedir $dir: $!";
1587 next unless @newdirs;
1588 # what a wicked map!
1589 @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if IS_VMS;
1590 $self->aside( "Also looking in @newdirs\n" );
1591 push(@dirs,@newdirs);
1597 #..........................................................................
1599 my $already_asserted;
1600 sub assert_closing_stdout {
1603 return if $already_asserted;
1605 eval q~ END { close(STDOUT) || die "Can't close STDOUT: $!" } ~;
1606 # What for? to let the pager know that nothing more will come?
1609 $already_asserted = 1;
1614 #..........................................................................
1616 sub tweak_found_pathnames {
1617 my($self, $found) = @_;
1619 foreach (@$found) { s,/,\\,g }
1624 #..........................................................................
1626 #..........................................................................
1628 sub am_taint_checking {
1630 die "NO ENVIRONMENT?!?!" unless keys %ENV; # reset iterator along the way
1631 my($k,$v) = each %ENV;
1632 return is_tainted($v);
1635 #..........................................................................
1637 sub is_tainted { # just a function
1639 my $nada = substr($arg, 0, 0); # zero-length!
1640 local $@; # preserve the caller's version of $@
1641 eval { eval "# $nada" };
1642 return length($@) != 0;
1645 #..........................................................................
1647 sub drop_privs_maybe {
1650 # Attempt to drop privs if we should be tainting and aren't
1651 if (!(IS_VMS || IS_MSWin32 || IS_Dos
1654 && ($> == 0 || $< == 0)
1655 && !$self->am_taint_checking()
1657 my $id = eval { getpwnam("nobody") };
1658 $id = eval { getpwnam("nouser") } unless defined $id;
1659 $id = -2 unless defined $id;
1661 # According to Stevens' APUE and various
1662 # (BSD, Solaris, HP-UX) man pages, setting
1663 # the real uid first and effective uid second
1664 # is the way to go if one wants to drop privileges,
1665 # because if one changes into an effective uid of
1666 # non-zero, one cannot change the real uid any more.
1668 # Actually, it gets even messier. There is
1669 # a third uid, called the saved uid, and as
1670 # long as that is zero, one can get back to
1671 # uid of zero. Setting the real-effective *twice*
1672 # helps in *most* systems (FreeBSD and Solaris)
1673 # but apparently in HP-UX even this doesn't help:
1674 # the saved uid stays zero (apparently the only way
1675 # in HP-UX to change saved uid is to call setuid()
1676 # when the effective uid is zero).
1679 $< = $id; # real uid
1680 $> = $id; # effective uid
1681 $< = $id; # real uid
1682 $> = $id; # effective uid
1684 if( !$@ && $< && $> ) {
1685 DEBUG and print "OK, I dropped privileges.\n";
1686 } elsif( $self->opt_U ) {
1687 DEBUG and print "Couldn't drop privileges, but in -U mode, so feh."
1689 DEBUG and print "Hm, couldn't drop privileges. Ah well.\n";
1690 # We used to die here; but that seemed pointless.
1696 #..........................................................................
1702 # See "perldoc perldoc" for basic details.
1704 # Perldoc -- look up a piece of documentation in .pod format that
1705 # is embedded in the perl installation tree.
1709 # See ChangeLog in CPAN dist for Pod::Perldoc for later notes.
1711 # Version 3.01: Sun Nov 10 21:38:09 MST 2002
1712 # Sean M. Burke <sburke@cpan.org>
1713 # Massive refactoring and code-tidying.
1714 # Now it's a module(-family)!
1715 # Formatter-specific stuff pulled out into Pod::Perldoc::To(Whatever).pm
1716 # Added -T, -d, -o, -M, -w.
1717 # Added some improved MSWin funk.
1721 # Version 2.05: Sat Oct 12 16:09:00 CEST 2002
1722 # Hugo van der Sanden <hv@crypt.org>
1723 # Made -U the default, based on patch from Simon Cozens
1724 # Version 2.04: Sun Aug 18 13:27:12 BST 2002
1725 # Randy W. Sims <RandyS@ThePierianSpring.org>
1726 # allow -n to enable nroff under Win32
1727 # Version 2.03: Sun Apr 23 16:56:34 BST 2000
1728 # Hugo van der Sanden <hv@crypt.org>
1729 # don't die when 'use blib' fails
1730 # Version 2.02: Mon Mar 13 18:03:04 MST 2000
1731 # Tom Christiansen <tchrist@perl.com>
1732 # Added -U insecurity option
1733 # Version 2.01: Sat Mar 11 15:22:33 MST 2000
1734 # Tom Christiansen <tchrist@perl.com>, querulously.
1735 # Security and correctness patches.
1736 # What a twisted bit of distasteful spaghetti code.
1741 # Version 1.15: Tue Aug 24 01:50:20 EST 1999
1742 # Charles Wilson <cwilson@ece.gatech.edu>
1743 # changed /pod/ directory to /pods/ for cygwin
1744 # to support cygwin/win32
1745 # Version 1.14: Wed Jul 15 01:50:20 EST 1998
1746 # Robin Barker <rmb1@cise.npl.co.uk>
1747 # -strict, -w cleanups
1748 # Version 1.13: Fri Feb 27 16:20:50 EST 1997
1749 # Gurusamy Sarathy <gsar@activestate.com>
1750 # -doc tweaks for -F and -X options
1751 # Version 1.12: Sat Apr 12 22:41:09 EST 1997
1752 # Gurusamy Sarathy <gsar@activestate.com>
1753 # -various fixes for win32
1754 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
1755 # Kenneth Albanowski <kjahds@kjahds.com>
1756 # -added Charles Bailey's further VMS patches, and -u switch
1757 # -added -t switch, with pod2text support
1759 # Version 1.10: Thu Nov 9 07:23:47 EST 1995
1760 # Kenneth Albanowski <kjahds@kjahds.com>
1761 # -added VMS support
1762 # -added better error recognition (on no found pages, just exit. On
1763 # missing nroff/pod2man, just display raw pod.)
1764 # -added recursive/case-insensitive matching (thanks, Andreas). This
1765 # slows things down a bit, unfortunately. Give a precise name, and
1768 # Version 1.01: Tue May 30 14:47:34 EDT 1995
1769 # Andy Dougherty <doughera@lafcol.lafayette.edu>
1770 # -added pod documentation.
1771 # -added PATH searching.
1772 # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
1779 # Cache the directories read during sloppy match
1780 # (To disk, or just in-memory?)
1782 # Backport this to perl 5.005?
1784 # Implement at least part of the "perlman" interface described
1785 # in Programming Perl 3e?