import perl 5.16.3 from CPAN - worked on by Andrew Fresh and myself

1 files changed, 1960 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm
new file mode 100644
index 00000000000..a0dd24addc2
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm
@@ -0,0 +1,1960 @@
+use 5.006;  # we use some open(X, "<", $y) syntax
+
+package Pod::Perldoc;
+use strict;
+use warnings;
+use Config '%Config';
+
+use Fcntl;    # for sysopen
+use File::Basename qw(basename);
+use File::Spec::Functions qw(catfile catdir splitdir);
+
+use vars qw($VERSION @Pagers $Bindir $Pod2man
+  $Temp_Files_Created $Temp_File_Lifetime
+);
+$VERSION = '3.17';
+
+#..........................................................................
+
+BEGIN {  # Make a DEBUG constant very first thing...
+  unless(defined &DEBUG) {
+    if(($ENV{'PERLDOCDEBUG'} || '') =~ m/^(\d+)/) { # untaint
+      eval("sub DEBUG () {$1}");
+      die "WHAT? Couldn't eval-up a DEBUG constant!? $@" if $@;
+    } else {
+      *DEBUG = sub () {0};
+    }
+  }
+}
+
+use Pod::Perldoc::GetOptsOO; # uses the DEBUG.
+use Carp qw(croak carp);
+
+# these are also in BaseTo, which I don't want to inherit
+sub debugging {
+	my $self = shift;
+
+    ( defined(&Pod::Perldoc::DEBUG) and &Pod::Perldoc::DEBUG() )
+	}
+
+sub debug {
+	my( $self, @messages ) = @_;
+	return unless $self->debugging;
+	print STDERR map { "DEBUG : $_" } @messages;
+	}
+
+sub warn {
+  my( $self, @messages ) = @_;
+
+  carp( join "\n", @messages, '' );
+  }
+
+sub die {
+  my( $self, @messages ) = @_;
+
+  croak( join "\n", @messages, '' );
+  }
+
+#..........................................................................
+
+sub TRUE  () {1}
+sub FALSE () {return}
+sub BE_LENIENT () {1}
+
+BEGIN {
+ *is_vms     = $^O eq 'VMS'     ? \&TRUE : \&FALSE unless defined &is_vms;
+ *is_mswin32 = $^O eq 'MSWin32' ? \&TRUE : \&FALSE unless defined &is_mswin32;
+ *is_dos     = $^O eq 'dos'     ? \&TRUE : \&FALSE unless defined &is_dos;
+ *is_os2     = $^O eq 'os2'     ? \&TRUE : \&FALSE unless defined &is_os2;
+ *is_cygwin  = $^O eq 'cygwin'  ? \&TRUE : \&FALSE unless defined &is_cygwin;
+ *is_linux   = $^O eq 'linux'   ? \&TRUE : \&FALSE unless defined &is_linux;
+ *is_hpux    = $^O =~ m/hpux/   ? \&TRUE : \&FALSE unless defined &is_hpux;
+}
+
+$Temp_File_Lifetime ||= 60 * 60 * 24 * 5;
+  # If it's older than five days, it's quite unlikely
+  #  that anyone's still looking at it!!
+  # (Currently used only by the MSWin cleanup routine)
+
+
+#..........................................................................
+{ my $pager = $Config{'pager'};
+  push @Pagers, $pager if -x (split /\s+/, $pager)[0] or __PACKAGE__->is_vms;
+}
+$Bindir  = $Config{'scriptdirexp'};
+$Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' );
+
+# End of class-init stuff
+#
+###########################################################################
+#
+# Option accessors...
+
+foreach my $subname (map "opt_$_", split '', q{mhlDriFfXqnTdULv}) {
+  no strict 'refs';
+  *$subname = do{ use strict 'refs';  sub () { shift->_elem($subname, @_) } };
+}
+
+# And these are so that GetOptsOO knows they take options:
+sub opt_f_with { shift->_elem('opt_f', @_) }
+sub opt_q_with { shift->_elem('opt_q', @_) }
+sub opt_d_with { shift->_elem('opt_d', @_) }
+sub opt_L_with { shift->_elem('opt_L', @_) }
+sub opt_v_with { shift->_elem('opt_v', @_) }
+
+sub opt_w_with { # Specify an option for the formatter subclass
+  my($self, $value) = @_;
+  if($value =~ m/^([-_a-zA-Z][-_a-zA-Z0-9]*)(?:[=\:](.*?))?$/s) {
+    my $option = $1;
+    my $option_value = defined($2) ? $2 : "TRUE";
+    $option =~ tr/\-/_/s;  # tolerate "foo-bar" for "foo_bar"
+    $self->add_formatter_option( $option, $option_value );
+  } else {
+    $self->warn( qq("$value" isn't a good formatter option name.  I'm ignoring it!\n ) );
+  }
+  return;
+}
+
+sub opt_M_with { # specify formatter class name(s)
+  my($self, $classes) = @_;
+  return unless defined $classes and length $classes;
+  DEBUG > 4 and print "Considering new formatter classes -M$classes\n";
+  my @classes_to_add;
+  foreach my $classname (split m/[,;]+/s, $classes) {
+    next unless $classname =~ m/\S/;
+    if( $classname =~ m/^(\w+(::\w+)+)$/s ) {
+      # A mildly restrictive concept of what modulenames are valid.
+      push @classes_to_add, $1; # untaint
+    } else {
+      $self->warn(  qq("$classname" isn't a valid classname.  Ignoring.\n) );
+    }
+  }
+
+  unshift @{ $self->{'formatter_classes'} }, @classes_to_add;
+
+  DEBUG > 3 and print(
+    "Adding @classes_to_add to the list of formatter classes, "
+    . "making them @{ $self->{'formatter_classes'} }.\n"
+  );
+
+  return;
+}
+
+sub opt_V { # report version and exit
+  print join '',
+    "Perldoc v$VERSION, under perl v$] for $^O",
+
+    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
+     ? (" (win32 build ", &Win32::BuildNumber(), ")") : (),
+
+    (chr(65) eq 'A') ? () : " (non-ASCII)",
+
+    "\n",
+  ;
+  exit;
+}
+
+sub opt_t { # choose plaintext as output format
+  my $self = shift;
+  $self->opt_o_with('text')  if @_ and $_[0];
+  return $self->_elem('opt_t', @_);
+}
+
+sub opt_u { # choose raw pod as output format
+  my $self = shift;
+  $self->opt_o_with('pod')  if @_ and $_[0];
+  return $self->_elem('opt_u', @_);
+}
+
+sub opt_n_with {
+  # choose man as the output format, and specify the proggy to run
+  my $self = shift;
+  $self->opt_o_with('man')  if @_ and $_[0];
+  $self->_elem('opt_n', @_);
+}
+
+sub opt_o_with { # "o" for output format
+  my($self, $rest) = @_;
+  return unless defined $rest and length $rest;
+  if($rest =~ m/^(\w+)$/s) {
+    $rest = $1; #untaint
+  } else {
+    $self->warn( qq("$rest" isn't a valid output format.  Skipping.\n") );
+    return;
+  }
+
+  $self->aside("Noting \"$rest\" as desired output format...\n");
+
+  # Figure out what class(es) that could actually mean...
+
+  my @classes;
+  foreach my $prefix ("Pod::Perldoc::To", "Pod::Simple::", "Pod::") {
+    # Messy but smart:
+    foreach my $stem (
+      $rest,  # Yes, try it first with the given capitalization
+      "\L$rest", "\L\u$rest", "\U$rest" # And then try variations
+
+    ) {
+      $self->aside("Considering $prefix$stem\n");
+      push @classes, $prefix . $stem;
+    }
+
+    # Tidier, but misses too much:
+    #push @classes, $prefix . ucfirst(lc($rest));
+  }
+  $self->opt_M_with( join ";", @classes );
+  return;
+}
+
+###########################################################################
+# % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
+
+sub run {  # to be called by the "perldoc" executable
+  my $class = shift;
+  if(DEBUG > 3) {
+    print "Parameters to $class\->run:\n";
+    my @x = @_;
+    while(@x) {
+      $x[1] = '<undef>'  unless defined $x[1];
+      $x[1] = "@{$x[1]}" if ref( $x[1] ) eq 'ARRAY';
+      print "  [$x[0]] => [$x[1]]\n";
+      splice @x,0,2;
+    }
+    print "\n";
+  }
+  return $class -> new(@_) -> process() || 0;
+}
+
+# % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
+###########################################################################
+
+sub new {  # yeah, nothing fancy
+  my $class = shift;
+  my $new = bless {@_}, (ref($class) || $class);
+  DEBUG > 1 and print "New $class object $new\n";
+  $new->init();
+  $new;
+}
+
+#..........................................................................
+
+sub aside {  # If we're in -D or DEBUG mode, say this.
+  my $self = shift;
+  if( DEBUG or $self->opt_D ) {
+    my $out = join( '',
+      DEBUG ? do {
+        my $callsub = (caller(1))[3];
+        my $package = quotemeta(__PACKAGE__ . '::');
+        $callsub =~ s/^$package/'/os;
+         # the o is justified, as $package really won't change.
+        $callsub . ": ";
+      } : '',
+      @_,
+    );
+    if(DEBUG) { print $out } else { print STDERR $out }
+  }
+  return;
+}
+
+#..........................................................................
+
+sub usage {
+  my $self = shift;
+  $self->warn( "@_\n" ) if @_;
+
+  # Erase evidence of previous errors (if any), so exit status is simple.
+  $! = 0;
+
+  CORE::die( <<EOF );
+perldoc [options] PageName|ModuleName|ProgramName|URL...
+perldoc [options] -f BuiltinFunction
+perldoc [options] -q FAQRegex
+perldoc [options] -v PerlVariable
+
+Options:
+    -h   Display this help message
+    -V   Report version
+    -r   Recursive search (slow)
+    -i   Ignore case
+    -t   Display pod using pod2text instead of Pod::Man and groff
+             (-t is the default on win32 unless -n is specified)
+    -u   Display unformatted pod text
+    -m   Display module's file in its entirety
+    -n   Specify replacement for groff
+    -l   Display the module's file name
+    -F   Arguments are file names, not modules
+    -D   Verbosely describe what's going on
+    -T   Send output to STDOUT without any pager
+    -d output_filename_to_send_to
+    -o output_format_name
+    -M FormatterModuleNameToUse
+    -w formatter_option:option_value
+    -L translation_code   Choose doc translation (if any)
+    -X   Use index if present (looks for pod.idx at $Config{archlib})
+    -q   Search the text of questions (not answers) in perlfaq[1-9]
+    -f   Search Perl built-in functions
+    -v   Search predefined Perl variables
+
+PageName|ModuleName|ProgramName|URL...
+         is the name of a piece of documentation that you want to look at. You
+         may either give a descriptive name of the page (as in the case of
+         `perlfunc') the name of a module, either like `Term::Info' or like
+         `Term/Info', or the name of a program, like `perldoc', or a URL
+         starting with http(s).
+
+BuiltinFunction
+         is the name of a perl function.  Will extract documentation from
+         `perlfunc' or `perlop'.
+
+FAQRegex
+         is a regex. Will search perlfaq[1-9] for and extract any
+         questions that match.
+
+Any switches in the PERLDOC environment variable will be used before the
+command line arguments.  The optional pod index file contains a list of
+filenames, one per line.
+                                                       [Perldoc v$VERSION]
+EOF
+
+}
+
+#..........................................................................
+
+sub program_name {
+  my( $self ) = @_;
+
+  if( my $link = readlink( $0 ) ) {
+    $self->debug( "The value in $0 is a symbolic link to $link\n" );
+    }
+
+  my $basename = basename( $0 );
+
+  $self->debug( "\$0 is [$0]\nbasename is [$basename]\n" );
+  # possible name forms
+  #   perldoc
+  #   perldoc-v5.14
+  #   perldoc-5.14
+  #   perldoc-5.14.2
+  #   perlvar         # an alias mentioned in Camel 3
+  {
+  my( $untainted ) = $basename =~ m/(
+    \A
+    perl
+      (?: doc | func | faq | help | op | toc | var # Camel 3
+      ) 
+    (?: -? v? \d+ \. \d+ (?:\. \d+)? )? # possible version
+    (?: \. (?: bat | exe | com ) )?    # possible extension
+    \z
+    )
+    /x;
+
+  $self->debug($untainted);
+  return $untainted if $untainted;
+  }
+
+  $self->warn(<<"HERE");
+You called the perldoc command with a name that I didn't recognize.
+This might mean that someone is tricking you into running a
+program you don't intend to use, but it also might mean that you
+created your own link to perldoc. I think your program name is
+[$basename].
+
+I'll allow this if the filename only has [a-zA-Z0-9._-].
+HERE
+
+  {
+  my( $untainted ) = $basename =~ m/(
+    \A [a-zA-Z0-9._-]+ \z
+    )/x;
+
+  $self->debug($untainted);
+  return $untainted if $untainted;
+  }
+
+  $self->die(<<"HERE");
+I think that your name for perldoc is potentially unsafe, so I'm
+going to disallow it. I'd rather you be safe than sorry. If you
+intended to use the name I'm disallowing, please tell the maintainers
+about it. Write to:
+
+    Pod-Perldoc\@rt.cpan.org
+
+HERE
+}
+
+#..........................................................................
+
+sub usage_brief {
+  my $self = shift;
+  my $program_name = $self->program_name;
+
+  CORE::die( <<"EOUSAGE" );
+Usage: $program_name [-hVriDtumFXlT] [-n nroffer_program]
+    [-d output_filename] [-o output_format] [-M FormatterModule]
+    [-w formatter_option:option_value] [-L translation_code]
+    PageName|ModuleName|ProgramName
+
+Examples:
+
+    $program_name -f PerlFunc
+    $program_name -q FAQKeywords
+    $program_name -v PerlVar
+
+The -h option prints more help.  Also try "$program_name perldoc" to get
+acquainted with the system.                        [Perldoc v$VERSION]
+EOUSAGE
+
+}
+
+#..........................................................................
+
+sub pagers { @{ shift->{'pagers'} } }
+
+#..........................................................................
+
+sub _elem {  # handy scalar meta-accessor: shift->_elem("foo", @_)
+  if(@_ > 2) { return  $_[0]{ $_[1] } = $_[2]  }
+  else       { return  $_[0]{ $_[1] }          }
+}
+#..........................................................................
+###########################################################################
+#
+# Init formatter switches, and start it off with __bindir and all that
+# other stuff that ToMan.pm needs.
+#
+
+sub init {
+  my $self = shift;
+
+  # Make sure creat()s are neither too much nor too little
+  eval { umask(0077) };   # doubtless someone has no mask
+
+  $self->{'args'}              ||= \@ARGV;
+  $self->{'found'}             ||= [];
+  $self->{'temp_file_list'}    ||= [];
+
+
+  $self->{'target'} = undef;
+
+  $self->init_formatter_class_list;
+
+  $self->{'pagers' } = [@Pagers] unless exists $self->{'pagers'};
+  $self->{'bindir' } = $Bindir   unless exists $self->{'bindir'};
+  $self->{'pod2man'} = $Pod2man  unless exists $self->{'pod2man'};
+
+  push @{ $self->{'formatter_switches'} = [] }, (
+   # Yeah, we could use a hashref, but maybe there's some class where options
+   # have to be ordered; so we'll use an arrayref.
+
+     [ '__bindir'  => $self->{'bindir' } ],
+     [ '__pod2man' => $self->{'pod2man'} ],
+  );
+
+  DEBUG > 3 and printf "Formatter switches now: [%s]\n",
+   join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
+
+  $self->{'translators'} = [];
+  $self->{'extra_search_dirs'} = [];
+
+  return;
+}
+
+#..........................................................................
+
+sub init_formatter_class_list {
+  my $self = shift;
+  $self->{'formatter_classes'} ||= [];
+
+  # Remember, no switches have been read yet, when
+  # we've started this routine.
+
+  $self->opt_M_with('Pod::Perldoc::ToPod');   # the always-there fallthru
+  $self->opt_o_with('text');
+  $self->opt_o_with('man') unless $self->is_mswin32 || $self->is_dos
+       || !($ENV{TERM} && (
+              ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i
+           ));
+
+  return;
+}
+
+#..........................................................................
+
+sub process {
+    # if this ever returns, its retval will be used for exit(RETVAL)
+
+    my $self = shift;
+    DEBUG > 1 and print "  Beginning process.\n";
+    DEBUG > 1 and print "  Args: @{$self->{'args'}}\n\n";
+    if(DEBUG > 3) {
+        print "Object contents:\n";
+        my @x = %$self;
+        while(@x) {
+            $x[1] = '<undef>'  unless defined $x[1];
+            $x[1] = "@{$x[1]}" if ref( $x[1] ) eq 'ARRAY';
+            print "  [$x[0]] => [$x[1]]\n";
+            splice @x,0,2;
+        }
+        print "\n";
+    }
+
+    # TODO: make it deal with being invoked as various different things
+    #  such as perlfaq".
+
+    return $self->usage_brief  unless  @{ $self->{'args'} };
+    $self->pagers_guessing;
+    $self->options_reading;
+    $self->aside(sprintf "$0 => %s v%s\n", ref($self), $self->VERSION);
+    $self->drop_privs_maybe;
+    $self->options_processing;
+
+    # Hm, we have @pages and @found, but we only really act on one
+    # file per call, with the exception of the opt_q hack, and with
+    # -l things
+
+    $self->aside("\n");
+
+    my @pages;
+    $self->{'pages'} = \@pages;
+    if(    $self->opt_f) { @pages = qw(perlfunc perlop)        }
+    elsif( $self->opt_q) { @pages = ("perlfaq1" .. "perlfaq9") }
+    elsif( $self->opt_v) { @pages = ("perlvar")                }
+    else                 { @pages = @{$self->{'args'}};
+                           # @pages = __FILE__
+                           #  if @pages == 1 and $pages[0] eq 'perldoc';
+                         }
+
+    return $self->usage_brief  unless  @pages;
+
+    $self->find_good_formatter_class();
+    $self->formatter_sanity_check();
+
+    $self->maybe_diddle_INC();
+      # for when we're apparently in a module or extension directory
+
+    my @found = $self->grand_search_init(\@pages);
+    exit ($self->is_vms ? 98962 : 1) unless @found;
+
+    if ($self->opt_l and not $self->opt_q ) {
+        DEBUG and print "We're in -l mode, so byebye after this:\n";
+        print join("\n", @found), "\n";
+        return;
+    }
+
+    $self->tweak_found_pathnames(\@found);
+    $self->assert_closing_stdout;
+    return $self->page_module_file(@found)  if  $self->opt_m;
+    DEBUG > 2 and print "Found: [@found]\n";
+
+    return $self->render_and_page(\@found);
+}
+
+#..........................................................................
+{
+
+my( %class_seen, %class_loaded );
+sub find_good_formatter_class {
+  my $self = $_[0];
+  my @class_list = @{ $self->{'formatter_classes'} || [] };
+  $self->die( "WHAT?  Nothing in the formatter class list!?" ) unless @class_list;
+
+  my $good_class_found;
+  foreach my $c (@class_list) {
+    DEBUG > 4 and print "Trying to load $c...\n";
+    if($class_loaded{$c}) {
+      DEBUG > 4 and print "OK, the already-loaded $c it is!\n";
+      $good_class_found = $c;
+      last;
+    }
+
+    if($class_seen{$c}) {
+      DEBUG > 4 and print
+       "I've tried $c before, and it's no good.  Skipping.\n";
+      next;
+    }
+
+    $class_seen{$c} = 1;
+
+    if( $c->can('parse_from_file') ) {
+      DEBUG > 4 and print
+       "Interesting, the formatter class $c is already loaded!\n";
+
+    } elsif(
+      ( $self->is_os2 or $self->is_mswin32 or $self->is_dos or $self->is_os2)
+       # the always case-insensitive filesystems
+      and $class_seen{lc("~$c")}++
+    ) {
+      DEBUG > 4 and print
+       "We already used something quite like \"\L$c\E\", so no point using $c\n";
+      # This avoids redefining the package.
+    } else {
+      DEBUG > 4 and print "Trying to eval 'require $c'...\n";
+
+      local $^W = $^W;
+      if(DEBUG() or $self->opt_D) {
+        # feh, let 'em see it
+      } else {
+        $^W = 0;
+        # The average user just has no reason to be seeing
+        #  $^W-suppressible warnings from the the require!
+      }
+
+      eval "require $c";
+      if($@) {
+        DEBUG > 4 and print "Couldn't load $c: $!\n";
+        next;
+      }
+    }
+
+    if( $c->can('parse_from_file') ) {
+      DEBUG > 4 and print "Settling on $c\n";
+      my $v = $c->VERSION;
+      $v = ( defined $v and length $v ) ? " version $v" : '';
+      $self->aside("Formatter class $c$v successfully loaded!\n");
+      $good_class_found = $c;
+      last;
+    } else {
+      DEBUG > 4 and print "Class $c isn't a formatter?!  Skipping.\n";
+    }
+  }
+
+  $self->die( "Can't find any loadable formatter class in @class_list?!\nAborting" )
+    unless $good_class_found;
+
+  $self->{'formatter_class'} = $good_class_found;
+  $self->aside("Will format with the class $good_class_found\n");
+
+  return;
+}
+
+}
+#..........................................................................
+
+sub formatter_sanity_check {
+  my $self = shift;
+  my $formatter_class = $self->{'formatter_class'}
+   || $self->die( "NO FORMATTER CLASS YET!?" );
+
+  if(!$self->opt_T # so -T can FORCE sending to STDOUT
+    and $formatter_class->can('is_pageable')
+    and !$formatter_class->is_pageable
+    and !$formatter_class->can('page_for_perldoc')
+  ) {
+    my $ext =
+     ($formatter_class->can('output_extension')
+       && $formatter_class->output_extension
+     ) || '';
+    $ext = ".$ext" if length $ext;
+
+    my $me = $self->program_name;
+    $self->die(
+       "When using Perldoc to format with $formatter_class, you have to\n"
+     . "specify -T or -dsomefile$ext\n"
+     . "See `$me perldoc' for more information on those switches.\n" )
+    ;
+  }
+}
+
+#..........................................................................
+
+sub render_and_page {
+    my($self, $found_list) = @_;
+
+    $self->maybe_generate_dynamic_pod($found_list);
+
+    my($out, $formatter) = $self->render_findings($found_list);
+
+    if($self->opt_d) {
+      printf "Perldoc (%s) output saved to %s\n",
+        $self->{'formatter_class'} || ref($self),
+        $out;
+      print "But notice that it's 0 bytes long!\n" unless -s $out;
+
+
+    } elsif(  # Allow the formatter to "page" itself, if it wants.
+      $formatter->can('page_for_perldoc')
+      and do {
+        $self->aside("Going to call $formatter\->page_for_perldoc(\"$out\")\n");
+        if( $formatter->page_for_perldoc($out, $self) ) {
+          $self->aside("page_for_perldoc returned true, so NOT paging with $self.\n");
+          1;
+        } else {
+          $self->aside("page_for_perldoc returned false, so paging with $self instead.\n");
+          '';
+        }
+      }
+    ) {
+      # Do nothing, since the formatter has "paged" it for itself.
+
+    } else {
+      # Page it normally (internally)
+
+      if( -s $out ) {  # Usual case:
+        $self->page($out, $self->{'output_to_stdout'}, $self->pagers);
+
+      } else {
+        # Odd case:
+        $self->aside("Skipping $out (from $$found_list[0] "
+         . "via $$self{'formatter_class'}) as it is 0-length.\n");
+
+        push @{ $self->{'temp_file_list'} }, $out;
+        $self->unlink_if_temp_file($out);
+      }
+    }
+
+    $self->after_rendering();  # any extra cleanup or whatever
+
+    return;
+}
+
+#..........................................................................
+
+sub options_reading {
+    my $self = shift;
+
+    if( defined $ENV{"PERLDOC"} and length $ENV{"PERLDOC"} ) {
+      require Text::ParseWords;
+      $self->aside("Noting env PERLDOC setting of $ENV{'PERLDOC'}\n");
+      # Yes, appends to the beginning
+      unshift @{ $self->{'args'} },
+        Text::ParseWords::shellwords( $ENV{"PERLDOC"} )
+      ;
+      DEBUG > 1 and print "  Args now: @{$self->{'args'}}\n\n";
+    } else {
+      DEBUG > 1 and print "  Okay, no PERLDOC setting in ENV.\n";
+    }
+
+    DEBUG > 1
+     and print "  Args right before switch processing: @{$self->{'args'}}\n";
+
+    Pod::Perldoc::GetOptsOO::getopts( $self, $self->{'args'}, 'YES' )
+     or return $self->usage;
+
+    DEBUG > 1
+     and print "  Args after switch processing: @{$self->{'args'}}\n";
+
+    return $self->usage if $self->opt_h;
+
+    return;
+}
+
+#..........................................................................
+
+sub options_processing {
+    my $self = shift;
+
+    if ($self->opt_X) {
+        my $podidx = "$Config{'archlib'}/pod.idx";
+        $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
+        $self->{'podidx'} = $podidx;
+    }
+
+    $self->{'output_to_stdout'} = 1  if  $self->opt_T or ! -t STDOUT;
+
+    $self->options_sanity;
+
+    # This used to set a default, but that's now moved into any
+    # formatter that cares to have a default.
+    if( $self->opt_n ) {
+        $self->add_formatter_option( '__nroffer' => $self->opt_n );
+    }
+
+    # Get language from PERLDOC_POD2 environment variable
+    if ( ! $self->opt_L && $ENV{PERLDOC_POD2} ) {
+        if ( $ENV{PERLDOC_POD2} eq '1' ) {
+          $self->_elem('opt_L',(split(/\_/, $ENV{LC_ALL} || $ENV{LC_LANG} || $ENV{LANG}))[0] );
+        }
+        else {
+          $self->_elem('opt_L', $ENV{PERLDOC_POD2});
+        }
+    };
+
+    # Adjust for using translation packages
+    $self->add_translator(split(/\s+/,$self->opt_L)) if $self->opt_L;
+
+    return;
+}
+
+#..........................................................................
+
+sub options_sanity {
+    my $self = shift;
+
+    # The opts-counting stuff interacts quite badly with
+    # the $ENV{"PERLDOC"} stuff.  I.e., if I have $ENV{"PERLDOC"}
+    # set to -t, and I specify -u on the command line, I don't want
+    # to be hectored at that -u and -t don't make sense together.
+
+    #my $opts = grep $_ && 1, # yes, the count of the set ones
+    #  $self->opt_t, $self->opt_u, $self->opt_m, $self->opt_l
+    #;
+    #
+    #$self->usage("only one of -t, -u, -m or -l") if $opts > 1;
+
+
+    # Any sanity-checking need doing here?
+
+    # But does not make sense to set either -f or -q in $ENV{"PERLDOC"}
+    if( $self->opt_f or $self->opt_q ) {
+    $self->usage("Only one of -f -or -q") if $self->opt_f and $self->opt_q;
+    $self->warn(
+        "Perldoc is only really meant for reading one word at a time.\n",
+        "So these parameters are being ignored: ",
+        join(' ', @{$self->{'args'}}),
+        "\n" )
+        if @{$self->{'args'}}
+    }
+    return;
+}
+
+#..........................................................................
+
+sub grand_search_init {
+    my($self, $pages, @found) = @_;
+
+    foreach (@$pages) {
+        if (/^http(s)?:\/\//) {
+            require HTTP::Tiny;
+            require File::Temp;
+            my $response = HTTP::Tiny->new->get($_);
+            if ($response->{success}) {
+                my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
+                $fh->print($response->{content});
+                push @found, $filename;
+                ($self->{podnames}{$filename} =
+                  m{.*/([^/#?]+)} ? uc $1 : "UNKNOWN")
+                   =~ s/\.P(?:[ML]|OD)\z//;
+            }
+            else {
+                print STDERR "No " .
+                    ($self->opt_m ? "module" : "documentation") . " found for \"$_\".\n";
+            }
+            next;
+        }
+        if ($self->{'podidx'} && open(PODIDX, $self->{'podidx'})) {
+            my $searchfor = catfile split '::', $_;
+            $self->aside( "Searching for '$searchfor' in $self->{'podidx'}\n" );
+            local $_;
+            while (<PODIDX>) {
+                chomp;
+                push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?\z,i;
+            }
+            close(PODIDX)            or $self->die( "Can't close $$self{'podidx'}: $!" );
+            next;
+        }
+
+        $self->aside( "Searching for $_\n" );
+
+        if ($self->opt_F) {
+            next unless -r;
+            push @found, $_ if $self->opt_l or $self->opt_m or $self->containspod($_);
+            next;
+        }
+
+        my @searchdirs;
+
+        # prepend extra search directories (including language specific)
+        push @searchdirs, @{ $self->{'extra_search_dirs'} };
+
+        # We must look both in @INC for library modules and in $bindir
+        # for executables, like h2xs or perldoc itself.
+        push @searchdirs, ($self->{'bindir'}, @INC);
+        unless ($self->opt_m) {
+            if ($self->is_vms) {
+                my($i,$trn);
+                for ($i = 0; $trn = $ENV{'DCL$PATH;'.$i}; $i++) {
+                    push(@searchdirs,$trn);
+                }
+                push(@searchdirs,'perl_root:[lib.pods]')  # installed pods
+            }
+            else {
+                push(@searchdirs, grep(-d, split($Config{path_sep},
+                                                 $ENV{'PATH'})));
+            }
+        }
+        my @files = $self->searchfor(0,$_,@searchdirs);
+        if (@files) {
+            $self->aside( "Found as @files\n" );
+        }
+        # add "perl" prefix, so "perldoc foo" may find perlfoo.pod
+    elsif (BE_LENIENT and !/\W/ and  @files = $self->searchfor(0, "perl$_", @searchdirs)) {
+            $self->aside( "Loosely found as @files\n" );
+        }
+        else {
+            # no match, try recursive search
+            @searchdirs = grep(!/^\.\z/s,@INC);
+            @files= $self->searchfor(1,$_,@searchdirs) if $self->opt_r;
+            if (@files) {
+                $self->aside( "Loosely found as @files\n" );
+            }
+            else {
+                print STDERR "No " .
+                    ($self->opt_m ? "module" : "documentation") . " found for \"$_\".\n";
+                if ( @{ $self->{'found'} } ) {
+                    print STDERR "However, try\n";
+                    my $me = $self->program_name;
+                    for my $dir (@{ $self->{'found'} }) {
+                        opendir(DIR, $dir) or $self->die( "opendir $dir: $!" );
+                        while (my $file = readdir(DIR)) {
+                            next if ($file =~ /^\./s);
+                            $file =~ s/\.(pm|pod)\z//;  # XXX: badfs
+                            print STDERR "\t$me $_\::$file\n";
+                        }
+                        closedir(DIR)    or $self->die( "closedir $dir: $!" );
+                    }
+                }
+            }
+        }
+        push(@found,@files);
+    }
+    return @found;
+}
+
+#..........................................................................
+
+sub maybe_generate_dynamic_pod {
+    my($self, $found_things) = @_;
+    my @dynamic_pod;
+
+    $self->search_perlfunc($found_things, \@dynamic_pod)  if  $self->opt_f;
+
+    $self->search_perlvar($found_things, \@dynamic_pod)   if  $self->opt_v;
+
+    $self->search_perlfaqs($found_things, \@dynamic_pod)  if  $self->opt_q;
+
+    if( ! $self->opt_f and ! $self->opt_q and ! $self->opt_v ) {
+        DEBUG > 4 and print "That's a non-dynamic pod search.\n";
+    } elsif ( @dynamic_pod ) {
+        $self->aside("Hm, I found some Pod from that search!\n");
+        my ($buffd, $buffer) = $self->new_tempfile('pod', 'dyn');
+
+        push @{ $self->{'temp_file_list'} }, $buffer;
+         # I.e., it MIGHT be deleted at the end.
+
+        my $in_list = !$self->not_dynamic && $self->opt_f || $self->opt_v;
+
+        print $buffd "=over 8\n\n" if $in_list;
+        print $buffd @dynamic_pod  or $self->die( "Can't print $buffer: $!" );
+        print $buffd "=back\n"     if $in_list;
+
+        close $buffd        or $self->die( "Can't close $buffer: $!" );
+
+        @$found_things = $buffer;
+          # Yes, so found_things never has more than one thing in
+          #  it, by time we leave here
+
+        $self->add_formatter_option('__filter_nroff' => 1);
+
+    } else {
+        @$found_things = ();
+        $self->aside("I found no Pod from that search!\n");
+    }
+
+    return;
+}
+
+#..........................................................................
+
+sub not_dynamic {
+  my ($self,$value) = @_;
+  $self->{__not_dynamic} = $value if @_ == 2;
+  return $self->{__not_dynamic};
+}
+
+#..........................................................................
+
+sub add_formatter_option { # $self->add_formatter_option('key' => 'value');
+  my $self = shift;
+  push @{ $self->{'formatter_switches'} }, [ @_ ] if @_;
+
+  DEBUG > 3 and printf "Formatter switches now: [%s]\n",
+   join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
+
+  return;
+}
+
+#.........................................................................
+
+sub new_translator { # $tr = $self->new_translator($lang);
+    my $self = shift;
+    my $lang = shift;
+
+    my $pack = 'POD2::' . uc($lang);
+    eval "require $pack";
+    if ( !$@ && $pack->can('new') ) {
+    return $pack->new();
+    }
+
+    eval { require POD2::Base };
+    return if $@;
+
+    return POD2::Base->new({ lang => $lang });
+}
+
+#.........................................................................
+
+sub add_translator { # $self->add_translator($lang);
+    my $self = shift;
+    for my $lang (@_) {
+        my $tr = $self->new_translator($lang);
+        if ( defined $tr ) {
+            push @{ $self->{'translators'} }, $tr;
+            push @{ $self->{'extra_search_dirs'} }, $tr->pod_dirs;
+
+            $self->aside( "translator for '$lang' loaded\n" );
+        } else {
+            # non-installed or bad translator package
+            $self->warn( "Perldoc cannot load translator package for '$lang': ignored\n" );
+        }
+
+    }
+    return;
+}
+
+#..........................................................................
+
+sub search_perlvar {
+    my($self, $found_things, $pod) = @_;
+
+    my $opt = $self->opt_v;
+
+    if ( $opt !~ /^ (?: [\@\%\$]\S+ | [A-Z]\w* ) $/x ) {
+        CORE::die( "'$opt' does not look like a Perl variable\n" );
+    }
+
+    DEBUG > 2 and print "Search: @$found_things\n";
+
+    my $perlvar = shift @$found_things;
+    open(PVAR, "<", $perlvar)               # "Funk is its own reward"
+        or $self->die("Can't open $perlvar: $!");
+
+    if ( $opt ne '$0' && $opt =~ /^\$\d+$/ ) { # handle $1, $2, ...
+      $opt = '$<I<digits>>';
+    }
+    my $search_re = quotemeta($opt);
+
+    DEBUG > 2 and
+     print "Going to perlvar-scan for $search_re in $perlvar\n";
+
+    # Skip introduction
+    local $_;
+    while (<PVAR>) {
+        last if /^=over 8/;
+    }
+
+    # Look for our variable
+    my $found = 0;
+    my $inheader = 1;
+    my $inlist = 0;
+    while (<PVAR>) {  # "The Mothership Connection is here!"
+        last if /^=head2 Error Indicators/;
+        # \b at the end of $` and friends borks things!
+        if ( m/^=item\s+$search_re\s/ )  {
+            $found = 1;
+        }
+        elsif (/^=item/) {
+            last if $found && !$inheader && !$inlist;
+        }
+        elsif (!/^\s+$/) { # not a blank line
+            if ( $found ) {
+                $inheader = 0; # don't accept more =item (unless inlist)
+        }
+            else {
+                @$pod = (); # reset
+                $inheader = 1; # start over
+                next;
+            }
+    }
+
+        if (/^=over/) {
+            ++$inlist;
+        }
+        elsif (/^=back/) {
+            last if $found && !$inheader && !$inlist;
+            --$inlist;
+        }
+        push @$pod, $_;
+#        ++$found if /^\w/;        # found descriptive text
+    }
+    @$pod = () unless $found;
+    if (!@$pod) {
+        CORE::die( "No documentation for perl variable '$opt' found\n" );
+    }
+    close PVAR                or $self->die( "Can't open $perlvar: $!" );
+
+    return;
+}
+
+#..........................................................................
+
+sub search_perlop {
+  my ($self,$found_things,$pod) = @_;
+
+  $self->not_dynamic( 1 );
+
+  my $perlop = shift @$found_things;
+  open( PERLOP, '<', $perlop ) or $self->die( "Can't open $perlop: $!" );
+
+  my $paragraph = "";
+  my $has_text_seen = 0;
+  my $thing = $self->opt_f;
+  my $list = 0;
+
+  while( my $line = <PERLOP> ){
+    if( $paragraph and $line =~ m!^=(?:head|item)! and $paragraph =~ m!X<+\s*\Q$thing\E\s*>+! ){
+      if( $list ){
+        $paragraph =~ s!=back.*?\z!!s;
+      }
+
+      if( $paragraph =~ m!^=item! ){
+        $paragraph = "=over 8\n\n" . $paragraph . "=back\n";
+      }
+
+      push @$pod, $paragraph;
+      $paragraph = "";
+      $has_text_seen = 0;
+      $list = 0;
+    }
+
+    if( $line =~ m!^=over! ){
+      $list++;
+    }
+    elsif( $line =~ m!^=back! ){
+      $list--;
+    }
+
+    if( $line =~ m!^=(?:head|item)! and $has_text_seen ){
+      $paragraph = "";
+    }
+    elsif( $line !~ m!^=(?:head|item)! and $line !~ m!^\s*$! and $line !~ m!^\s*X<! ){
+      $has_text_seen = 1;
+    }
+
+    $paragraph .= $line;
+    }
+
+  close PERLOP;
+
+  return;
+}
+
+#..........................................................................
+
+sub search_perlfunc {
+    my($self, $found_things, $pod) = @_;
+
+    DEBUG > 2 and print "Search: @$found_things\n";
+
+    my $perlfunc = shift @$found_things;
+    open(PFUNC, "<", $perlfunc)               # "Funk is its own reward"
+        or $self->die("Can't open $perlfunc: $!");
+
+    # Functions like -r, -e, etc. are listed under `-X'.
+    my $search_re = ($self->opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/)
+                        ? '(?:I<)?-X' : quotemeta($self->opt_f) ;
+
+    DEBUG > 2 and
+     print "Going to perlfunc-scan for $search_re in $perlfunc\n";
+
+    my $re = 'Alphabetical Listing of Perl Functions';
+
+    # Check available translator or backup to default (english)
+    if ( $self->opt_L && defined $self->{'translators'}->[0] ) {
+        my $tr = $self->{'translators'}->[0];
+        $re =  $tr->search_perlfunc_re if $tr->can('search_perlfunc_re');
+    }
+
+    # Skip introduction
+    local $_;
+    while (<PFUNC>) {
+        last if /^=head2 $re/;
+    }
+
+    # Look for our function
+    my $found = 0;
+    my $inlist = 0;
+
+    my @perlops = qw(m q qq qr qx qw s tr y);
+
+    my @related;
+    my $related_re;
+    while (<PFUNC>) {  # "The Mothership Connection is here!"
+        last if( grep{ $self->opt_f eq $_ }@perlops );
+        if ( m/^=item\s+$search_re\b/ )  {
+            $found = 1;
+        }
+        elsif (@related > 1 and /^=item/) {
+            $related_re ||= join "|", @related;
+            if (m/^=item\s+(?:$related_re)\b/) {
+                $found = 1;
+            }
+            else {
+                last;
+            }
+        }
+        elsif (/^=item/) {
+            last if $found > 1 and not $inlist;
+        }
+        elsif ($found and /^X<[^>]+>/) {
+            push @related, m/X<([^>]+)>/g;
+        }
+        next unless $found;
+        if (/^=over/) {
+            ++$inlist;
+        }
+        elsif (/^=back/) {
+            last if $found > 1 and not $inlist;
+            --$inlist;
+        }
+        push @$pod, $_;
+        ++$found if /^\w/;        # found descriptive text
+    }
+
+    if( !@$pod ){
+        $self->search_perlop( $found_things, $pod );
+    }
+
+    if (!@$pod) {
+        CORE::die( sprintf
+          "No documentation for perl function '%s' found\n",
+          $self->opt_f )
+        ;
+    }
+    close PFUNC                or $self->die( "Can't open $perlfunc: $!" );
+
+    return;
+}
+
+#..........................................................................
+
+sub search_perlfaqs {
+    my( $self, $found_things, $pod) = @_;
+
+    my $found = 0;
+    my %found_in;
+    my $search_key = $self->opt_q;
+
+    my $rx = eval { qr/$search_key/ }
+     or $self->die( <<EOD );
+Invalid regular expression '$search_key' given as -q pattern:
+$@
+Did you mean \\Q$search_key ?
+
+EOD
+
+    local $_;
+    foreach my $file (@$found_things) {
+        $self->die( "invalid file spec: $!" ) if $file =~ /[<>|]/;
+        open(INFAQ, "<", $file)  # XXX 5.6ism
+         or $self->die( "Can't read-open $file: $!\nAborting" );
+        while (<INFAQ>) {
+            if ( m/^=head2\s+.*(?:$search_key)/i ) {
+                $found = 1;
+                push @$pod, "=head1 Found in $file\n\n" unless $found_in{$file}++;
+            }
+            elsif (/^=head[12]/) {
+                $found = 0;
+            }
+            next unless $found;
+            push @$pod, $_;
+        }
+        close(INFAQ);
+    }
+    CORE::die("No documentation for perl FAQ keyword '$search_key' found\n")
+     unless @$pod;
+
+    if ( $self->opt_l ) {
+        CORE::die((join "\n", keys %found_in) . "\n");
+    }
+    return;
+}
+
+
+#..........................................................................
+
+sub render_findings {
+  # Return the filename to open
+
+  my($self, $found_things) = @_;
+
+  my $formatter_class = $self->{'formatter_class'}
+   || $self->die( "No formatter class set!?" );
+  my $formatter = $formatter_class->can('new')
+    ? $formatter_class->new
+    : $formatter_class
+  ;
+
+  if(! @$found_things) {
+    $self->die( "Nothing found?!" );
+    # should have been caught before here
+  } elsif(@$found_things > 1) {
+    $self->warn(
+     "Perldoc is only really meant for reading one document at a time.\n",
+     "So these parameters are being ignored: ",
+     join(' ', @$found_things[1 .. $#$found_things] ),
+     "\n" );
+  }
+
+  my $file = $found_things->[0];
+
+  DEBUG > 3 and printf "Formatter switches now: [%s]\n",
+   join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
+
+  # Set formatter options:
+  if( ref $formatter ) {
+    foreach my $f (@{ $self->{'formatter_switches'} || [] }) {
+      my($switch, $value, $silent_fail) = @$f;
+      if( $formatter->can($switch) ) {
+        eval { $formatter->$switch( defined($value) ? $value : () ) };
+        $self->warn( "Got an error when setting $formatter_class\->$switch:\n$@\n" )
+         if $@;
+      } else {
+        if( $silent_fail or $switch =~ m/^__/s ) {
+          DEBUG > 2 and print "Formatter $formatter_class doesn't support $switch\n";
+        } else {
+          $self->warn( "$formatter_class doesn't recognize the $switch switch.\n" );
+        }
+      }
+    }
+  }
+
+  $self->{'output_is_binary'} =
+    $formatter->can('write_with_binmode') && $formatter->write_with_binmode;
+
+  if( $self->{podnames} and exists $self->{podnames}{$file} and
+      $formatter->can('name') ) {
+    $formatter->name($self->{podnames}{$file});
+  }
+
+  my ($out_fh, $out) = $self->new_output_file(
+    ( $formatter->can('output_extension') && $formatter->output_extension )
+     || undef,
+    $self->useful_filename_bit,
+  );
+
+  # Now, finally, do the formatting!
+  {
+    local $^W = $^W;
+    if(DEBUG() or $self->opt_D) {
+      # feh, let 'em see it
+    } else {
+      $^W = 0;
+      # The average user just has no reason to be seeing
+      #  $^W-suppressible warnings from the formatting!
+    }
+
+    eval {  $formatter->parse_from_file( $file, $out_fh )  };
+  }
+
+  $self->warn( "Error while formatting with $formatter_class:\n $@\n" ) if $@;
+  DEBUG > 2 and print "Back from formatting with $formatter_class\n";
+
+  close $out_fh
+   or $self->warn( "Can't close $out: $!\n(Did $formatter already close it?)" );
+  sleep 0; sleep 0; sleep 0;
+   # Give the system a few timeslices to meditate on the fact
+   # that the output file does in fact exist and is closed.
+
+  $self->unlink_if_temp_file($file);
+
+  unless( -s $out ) {
+    if( $formatter->can( 'if_zero_length' ) ) {
+      # Basically this is just a hook for Pod::Simple::Checker; since
+      # what other class could /happily/ format an input file with Pod
+      # as a 0-length output file?
+      $formatter->if_zero_length( $file, $out, $out_fh );
+    } else {
+      $self->warn( "Got a 0-length file from $$found_things[0] via $formatter_class!?\n" );
+    }
+  }
+
+  DEBUG and print "Finished writing to $out.\n";
+  return($out, $formatter) if wantarray;
+  return $out;
+}
+
+#..........................................................................
+
+sub unlink_if_temp_file {
+  # Unlink the specified file IFF it's in the list of temp files.
+  # Really only used in the case of -f / -q things when we can
+  #  throw away the dynamically generated source pod file once
+  #  we've formatted it.
+  #
+  my($self, $file) = @_;
+  return unless defined $file and length $file;
+
+  my $temp_file_list = $self->{'temp_file_list'} || return;
+  if(grep $_ eq $file, @$temp_file_list) {
+    $self->aside("Unlinking $file\n");
+    unlink($file) or $self->warn( "Odd, couldn't unlink $file: $!" );
+  } else {
+    DEBUG > 1 and print "$file isn't a temp file, so not unlinking.\n";
+  }
+  return;
+}
+
+#..........................................................................
+
+
+sub after_rendering {
+  my $self = $_[0];
+  $self->after_rendering_VMS     if $self->is_vms;
+  $self->after_rendering_MSWin32 if $self->is_mswin32;
+  $self->after_rendering_Dos     if $self->is_dos;
+  $self->after_rendering_OS2     if $self->is_os2;
+  return;
+}
+
+sub after_rendering_VMS      { return }
+sub after_rendering_Dos      { return }
+sub after_rendering_OS2      { return }
+sub after_rendering_MSWin32  { return }
+
+#..........................................................................
+#   :   :   :   :   :   :   :   :   :
+#..........................................................................
+
+sub minus_f_nocase {   # i.e., do like -f, but without regard to case
+
+     my($self, $dir, $file) = @_;
+     my $path = catfile($dir,$file);
+     return $path if -f $path and -r _;
+
+     if(!$self->opt_i
+        or $self->is_vms or $self->is_mswin32
+        or $self->Is_dos or $self->is_os2
+     ) {
+        # On a case-forgiving file system, or if case is important,
+    #  that is it, all we can do.
+    $self->warn( "Ignored $path: unreadable\n" ) if -f _;
+    return '';
+     }
+
+     local *DIR;
+     my @p = ($dir);
+     my($p,$cip);
+     foreach $p (splitdir $file){
+    my $try = catfile @p, $p;
+        $self->aside("Scrutinizing $try...\n");
+    stat $try;
+    if (-d _) {
+        push @p, $p;
+        if ( $p eq $self->{'target'} ) {
+        my $tmp_path = catfile @p;
+        my $path_f = 0;
+        for (@{ $self->{'found'} }) {
+            $path_f = 1 if $_ eq $tmp_path;
+        }
+        push (@{ $self->{'found'} }, $tmp_path) unless $path_f;
+        $self->aside( "Found as $tmp_path but directory\n" );
+        }
+    }
+    elsif (-f _ && -r _ && lc($try) eq lc($path)) {
+        return $try;
+    }
+    elsif (-f _) {
+        $self->warn( "Ignored $try: unreadable or file/dir mismatch\n" );
+    }
+    elsif (-d catdir(@p)) {  # at least we see the containing directory!
+        my $found = 0;
+        my $lcp = lc $p;
+        my $p_dirspec = catdir(@p);
+        opendir DIR, $p_dirspec  or $self->die( "opendir $p_dirspec: $!" );
+        while(defined( $cip = readdir(DIR) )) {
+        if (lc $cip eq $lcp){
+            $found++;
+            last; # XXX stop at the first? what if there's others?
+        }
+        }
+        closedir DIR  or $self->die( "closedir $p_dirspec: $!" );
+        return "" unless $found;
+
+        push @p, $cip;
+        my $p_filespec = catfile(@p);
+        return $p_filespec if -f $p_filespec and -r _;
+        $self->warn( "Ignored $p_filespec: unreadable\n" ) if -f _;
+    }
+     }
+     return "";
+}
+
+#..........................................................................
+
+sub pagers_guessing {
+    my $self = shift;
+
+    my @pagers;
+    push @pagers, $self->pagers;
+    $self->{'pagers'} = \@pagers;
+
+    if ($self->is_mswin32) {
+        push @pagers, qw( more< less notepad );
+        unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
+    }
+    elsif ($self->is_vms) {
+        push @pagers, qw( most more less type/page );
+    }
+    elsif ($self->is_dos) {
+        push @pagers, qw( less.exe more.com< );
+        unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
+    }
+    else {
+        if ($self->is_os2) {
+          unshift @pagers, 'less', 'cmd /c more <';
+        }
+        push @pagers, qw( more less pg view cat );
+        unshift @pagers, "$ENV{PAGER} <"  if $ENV{PAGER};
+    }
+
+    if ($self->is_cygwin) {
+        if (($pagers[0] eq 'less') || ($pagers[0] eq '/usr/bin/less')) {
+            unshift @pagers, '/usr/bin/less -isrR';
+            unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
+       }
+    }
+
+    unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
+
+    return;
+}
+
+#..........................................................................
+
+sub page_module_file {
+    my($self, @found) = @_;
+
+    # Security note:
+    # Don't ever just pass this off to anything like MSWin's "start.exe",
+    # since we might be calling on a .pl file, and we wouldn't want that
+    # to actually /execute/ the file that we just want to page thru!
+    # Also a consideration if one were to use a web browser as a pager;
+    # doing so could trigger the browser's MIME mapping for whatever
+    # it thinks .pm/.pl/whatever is.  Probably just a (useless and
+    # annoying) "Save as..." dialog, but potentially executing the file
+    # in question -- particularly in the case of MSIE and it's, ahem,
+    # occasionally hazy distinction between OS-local extension
+    # associations, and browser-specific MIME mappings.
+
+    if(@found > 1) {
+        $self->warn(
+            "Perldoc is only really meant for reading one document at a time.\n" .
+            "So these files are being ignored: " .
+            join(' ', @found[1 .. $#found] ) .
+            "\n" )
+    }
+
+    return $self->page($found[0], $self->{'output_to_stdout'}, $self->pagers);
+
+}
+
+#..........................................................................
+
+sub check_file {
+    my($self, $dir, $file) = @_;
+
+    unless( ref $self ) {
+      # Should never get called:
+      $Carp::Verbose = 1;
+      require Carp;
+      Carp::croak( join '',
+        "Crazy ", __PACKAGE__, " error:\n",
+        "check_file must be an object_method!\n",
+        "Aborting"
+      );
+    }
+
+    if(length $dir and not -d $dir) {
+      DEBUG > 3 and print "  No dir $dir -- skipping.\n";
+      return "";
+    }
+
+    my $path = $self->minus_f_nocase($dir,$file);
+    if( length $path and ($self->opt_m ? $self->isprintable($path)
+                                      : $self->containspod($path)) ) {
+        DEBUG > 3 and print
+            "  The file $path indeed looks promising!\n";
+        return $path;
+    }
+    DEBUG > 3 and print "  No good: $file in $dir\n";
+
+    return "";
+}
+
+sub isprintable {
+	my($self, $file, $readit) = @_;
+	my $size= 1024;
+	my $maxunprintfrac= 0.2;   # tolerate some unprintables for UTF-8 comments etc.
+
+	return 1 if !$readit && $file =~ /\.(?:pl|pm|pod|cmd|com|bat)\z/i;
+
+	my $data;
+	local($_);
+	open(TEST,"<", $file)     or $self->die( "Can't open $file: $!" );
+	read TEST, $data, $size;
+	close TEST;
+	$size= length($data);
+	$data =~ tr/\x09-\x0D\x20-\x7E//d;
+	return length($data) <= $size*$maxunprintfrac;
+}
+
+#..........................................................................
+
+sub containspod {
+    my($self, $file, $readit) = @_;
+    return 1 if !$readit && $file =~ /\.pod\z/i;
+
+
+    #  Under cygwin the /usr/bin/perl is legal executable, but
+    #  you cannot open a file with that name. It must be spelled
+    #  out as "/usr/bin/perl.exe".
+    #
+    #  The following if-case under cygwin prevents error
+    #
+    #     $ perldoc perl
+    #     Cannot open /usr/bin/perl: no such file or directory
+    #
+    #  This would work though
+    #
+    #     $ perldoc perl.pod
+
+    if ( $self->is_cygwin  and  -x $file  and  -f "$file.exe" )
+    {
+        $self->warn( "Cygwin $file.exe search skipped\n" ) if DEBUG or $self->opt_D;
+        return 0;
+    }
+
+    local($_);
+    open(TEST,"<", $file)   or $self->die( "Can't open $file: $!" );   # XXX 5.6ism
+    while (<TEST>) {
+    if (/^=head/) {
+        close(TEST)     or $self->die( "Can't close $file: $!" );
+        return 1;
+    }
+    }
+    close(TEST)         or $self->die( "Can't close $file: $!" );
+    return 0;
+}
+
+#..........................................................................
+
+sub maybe_diddle_INC {
+  my $self = shift;
+
+  # Does this look like a module or extension directory?
+
+  if (-f "Makefile.PL" || -f "Build.PL") {
+
+    # Add "." and "lib" to @INC (if they exist)
+    eval q{ use lib qw(. lib); 1; } or $self->die;
+
+    # don't add if superuser
+    if ($< && $> && -d "blib") {   # don't be looking too hard now!
+      eval q{ use blib; 1 };
+      $self->warn( $@ ) if $@ && $self->opt_D;
+    }
+  }
+
+  return;
+}
+
+#..........................................................................
+
+sub new_output_file {
+  my $self = shift;
+  my $outspec = $self->opt_d;  # Yes, -d overrides all else!
+                               # So don't call this twice per format-job!
+
+  return $self->new_tempfile(@_) unless defined $outspec and length $outspec;
+
+  # Otherwise open a write-handle on opt_d!f
+
+  my $fh;
+  # If we are running before perl5.6.0, we can't autovivify
+  if ($^V < 5.006) {
+    require Symbol;
+    $fh = Symbol::gensym();
+  }
+  DEBUG > 3 and print "About to try writing to specified output file $outspec\n";
+  $self->die( "Can't write-open $outspec: $!" )
+   unless open($fh, ">", $outspec); # XXX 5.6ism
+
+  DEBUG > 3 and print "Successfully opened $outspec\n";
+  binmode($fh) if $self->{'output_is_binary'};
+  return($fh, $outspec);
+}
+
+#..........................................................................
+
+sub useful_filename_bit {
+  # This tries to provide a meaningful bit of text to do with the query,
+  # such as can be used in naming the file -- since if we're going to be
+  # opening windows on temp files (as a "pager" may well do!) then it's
+  # better if the temp file's name (which may well be used as the window
+  # title) isn't ALL just random garbage!
+  # In other words "perldoc_LWPSimple_2371981429" is a better temp file
+  # name than "perldoc_2371981429".  So this routine is what tries to
+  # provide the "LWPSimple" bit.
+  #
+  my $self = shift;
+  my $pages = $self->{'pages'} || return undef;
+  return undef unless @$pages;
+
+  my $chunk = $pages->[0];
+  return undef unless defined $chunk;
+  $chunk =~ s/:://g;
+  $chunk =~ s/\.\w+$//g; # strip any extension
+  if( $chunk =~ m/([^\#\\:\/\$]+)$/s ) { # get basename, if it's a file
+    $chunk = $1;
+  } else {
+    return undef;
+  }
+  $chunk =~ s/[^a-zA-Z0-9]+//g; # leave ONLY a-zA-Z0-9 things!
+  $chunk = substr($chunk, -10) if length($chunk) > 10;
+  return $chunk;
+}
+
+#..........................................................................
+
+sub new_tempfile {    # $self->new_tempfile( [$suffix, [$infix] ] )
+  my $self = shift;
+
+  ++$Temp_Files_Created;
+
+  require File::Temp;
+  return File::Temp::tempfile(UNLINK => 1);
+}
+
+#..........................................................................
+
+sub page {  # apply a pager to the output file
+    my ($self, $output, $output_to_stdout, @pagers) = @_;
+    if ($output_to_stdout) {
+        $self->aside("Sending unpaged output to STDOUT.\n");
+        open(TMP, "<", $output)  or  $self->die( "Can't open $output: $!" ); # XXX 5.6ism
+        local $_;
+        while (<TMP>) {
+            print or $self->die( "Can't print to stdout: $!" );
+        }
+        close TMP  or $self->die( "Can't close while $output: $!" );
+        $self->unlink_if_temp_file($output);
+    } else {
+        # On VMS, quoting prevents logical expansion, and temp files with no
+        # extension get the wrong default extension (such as .LIS for TYPE)
+
+        $output = VMS::Filespec::rmsexpand($output, '.') if $self->is_vms;
+
+        $output =~ s{/}{\\}g if $self->is_mswin32 || $self->is_dos;
+        # Altho "/" under MSWin is in theory good as a pathsep,
+        #  many many corners of the OS don't like it.  So we
+        #  have to force it to be "\" to make everyone happy.
+
+        foreach my $pager (@pagers) {
+            $self->aside("About to try calling $pager $output\n");
+            if ($self->is_vms) {
+                last if system("$pager $output") == 0;
+            } else {
+                last if system("$pager \"$output\"") == 0;
+            }
+        }
+    }
+    return;
+}
+
+#..........................................................................
+
+sub searchfor {
+    my($self, $recurse,$s,@dirs) = @_;
+    $s =~ s!::!/!g;
+    $s = VMS::Filespec::unixify($s) if $self->is_vms;
+    return $s if -f $s && $self->containspod($s);
+    $self->aside( "Looking for $s in @dirs\n" );
+    my $ret;
+    my $i;
+    my $dir;
+    $self->{'target'} = (splitdir $s)[-1];  # XXX: why not use File::Basename?
+    for ($i=0; $i<@dirs; $i++) {
+    $dir = $dirs[$i];
+    next unless -d $dir;
+    ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $self->is_vms;
+    if (       (! $self->opt_m && ( $ret = $self->check_file($dir,"$s.pod")))
+        or ( $ret = $self->check_file($dir,"$s.pm"))
+        or ( $ret = $self->check_file($dir,$s))
+        or ( $self->is_vms and
+             $ret = $self->check_file($dir,"$s.com"))
+        or ( $self->is_os2 and
+             $ret = $self->check_file($dir,"$s.cmd"))
+        or ( ($self->is_mswin32 or $self->is_dos or $self->is_os2) and
+             $ret = $self->check_file($dir,"$s.bat"))
+        or ( $ret = $self->check_file("$dir/pod","$s.pod"))
+        or ( $ret = $self->check_file("$dir/pod",$s))
+        or ( $ret = $self->check_file("$dir/pods","$s.pod"))
+        or ( $ret = $self->check_file("$dir/pods",$s))
+    ) {
+        DEBUG > 1 and print "  Found $ret\n";
+        return $ret;
+    }
+
+    if ($recurse) {
+        opendir(D,$dir) or $self->die( "Can't opendir $dir: $!" );
+        my @newdirs = map catfile($dir, $_), grep {
+        not /^\.\.?\z/s and
+        not /^auto\z/s  and   # save time! don't search auto dirs
+        -d  catfile($dir, $_)
+        } readdir D;
+        closedir(D)     or $self->die( "Can't closedir $dir: $!" );
+        next unless @newdirs;
+        # what a wicked map!
+        @newdirs = map((s/\.dir\z//,$_)[1],@newdirs) if $self->is_vms;
+        $self->aside( "Also looking in @newdirs\n" );
+        push(@dirs,@newdirs);
+    }
+    }
+    return ();
+}
+
+#..........................................................................
+{
+  my $already_asserted;
+  sub assert_closing_stdout {
+    my $self = shift;
+
+    return if $already_asserted;
+
+    eval  q~ END { close(STDOUT) || CORE::die "Can't close STDOUT: $!" } ~;
+     # What for? to let the pager know that nothing more will come?
+
+    $self->die( $@ ) if $@;
+    $already_asserted = 1;
+    return;
+  }
+}
+
+#..........................................................................
+
+sub tweak_found_pathnames {
+  my($self, $found) = @_;
+  if ($self->is_mswin32) {
+    foreach (@$found) { s,/,\\,g }
+  }
+  foreach (@$found) { s,',\\',g } # RT 37347
+  return;
+}
+
+#..........................................................................
+#   :   :   :   :   :   :   :   :   :
+#..........................................................................
+
+sub am_taint_checking {
+    my $self = shift;
+    $self->die( "NO ENVIRONMENT?!?!" ) unless keys %ENV; # reset iterator along the way
+    my($k,$v) = each %ENV;
+    return is_tainted($v);
+}
+
+#..........................................................................
+
+sub is_tainted { # just a function
+    my $arg  = shift;
+    my $nada = substr($arg, 0, 0);  # zero-length!
+    local $@;  # preserve the caller's version of $@
+    eval { eval "# $nada" };
+    return length($@) != 0;
+}
+
+#..........................................................................
+
+sub drop_privs_maybe {
+    my $self = shift;
+
+    # Attempt to drop privs if we should be tainting and aren't
+    if (!( $self->is_vms || $self->is_mswin32 || $self->is_dos
+          || $self->is_os2
+         )
+        && ($> == 0 || $< == 0)
+        && !$self->am_taint_checking()
+    ) {
+        my $id = eval { getpwnam("nobody") };
+        $id = eval { getpwnam("nouser") } unless defined $id;
+        $id = -2 unless defined $id;
+            #
+            # According to Stevens' APUE and various
+            # (BSD, Solaris, HP-UX) man pages, setting
+            # the real uid first and effective uid second
+            # is the way to go if one wants to drop privileges,
+            # because if one changes into an effective uid of
+            # non-zero, one cannot change the real uid any more.
+            #
+            # Actually, it gets even messier.  There is
+            # a third uid, called the saved uid, and as
+            # long as that is zero, one can get back to
+            # uid of zero.  Setting the real-effective *twice*
+            # helps in *most* systems (FreeBSD and Solaris)
+            # but apparently in HP-UX even this doesn't help:
+            # the saved uid stays zero (apparently the only way
+            # in HP-UX to change saved uid is to call setuid()
+            # when the effective uid is zero).
+            #
+        eval {
+            $< = $id; # real uid
+            $> = $id; # effective uid
+            $< = $id; # real uid
+            $> = $id; # effective uid
+        };
+        if( !$@ && $< && $> ) {
+          DEBUG and print "OK, I dropped privileges.\n";
+        } elsif( $self->opt_U ) {
+          DEBUG and print "Couldn't drop privileges, but in -U mode, so feh."
+        } else {
+          DEBUG and print "Hm, couldn't drop privileges.  Ah well.\n";
+          # We used to die here; but that seemed pointless.
+        }
+    }
+    return;
+}
+
+#..........................................................................
+
+1;
+
+__END__
+
+=head1 NAME
+
+Pod::Perldoc - Look up Perl documentation in Pod format.
+
+=head1 SYNOPSIS
+
+    use Pod::Perldoc ();
+
+    Pod::Perldoc->run();
+
+=head1 DESCRIPTION
+
+The guts of L<perldoc> utility.
+
+=head1 SEE ALSO
+
+L<perldoc>
+
+=head1 COPYRIGHT AND DISCLAIMERS
+
+Copyright (c) 2002-2007 Sean M. Burke.
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+This program is distributed in the hope that it will be useful, but
+without any warranty; without even the implied warranty of
+merchantability or fitness for a particular purpose.
+
+=head1 AUTHOR
+
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
+
+Past contributions from:
+brian d foy C<< <bdfoy@cpan.org> >>
+Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
+Sean M. Burke C<< <sburke@cpan.org> >>
+
+=cut