require 5;
use 5.006; # we use some open(X, "<", $y) syntax
use strict;
use warnings;
use Config '%Config';
use Fcntl; # for sysopen
);
$VERSION = '3.12';
#..........................................................................
BEGIN { # Make a DEBUG constant very first thing...
unless(defined &DEBUG) {
eval("sub DEBUG () {$1}");
die "WHAT? Couldn't eval-up a DEBUG constant!? $@" if $@;
} else {
*DEBUG = sub () {0};
}
}
}
#..........................................................................
sub FALSE () {return}
BEGIN {
}
# 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)
#..........................................................................
}
# End of class-init stuff
#
###########################################################################
#
# Option accessors...
no strict 'refs';
}
# And these are so that GetOptsOO knows they take options:
my $option = $1;
$option =~ tr/\-/_/s; # tolerate "foo-bar" for "foo_bar"
} else {
warn "\"$value\" isn't a good formatter option name. I'm ignoring it!\n";
}
return;
}
my @classes_to_add;
next unless $classname =~ m/\S/;
if( $classname =~ m/^(\w+(::\w+)+)$/s ) {
# A mildly restrictive concept of what modulenames are valid.
} else {
warn "\"$classname\" isn't a valid classname. Ignoring.\n";
}
}
DEBUG > 3 and print(
"Adding @classes_to_add to the list of formatter classes, "
. "making them @{ $self->{'formatter_classes'} }.\n"
);
return;
}
print join '',
"Perldoc v$VERSION, under perl v$] for $^O",
(chr(65) eq 'A') ? () : " (non-ASCII)",
"\n",
;
exit;
}
my $self = shift;
}
my $self = shift;
}
sub opt_n_with {
# choose man as the output format, and specify the proggy to run
my $self = shift;
}
if($rest =~ m/^(\w+)$/s) {
} else {
warn "\"$rest\" isn't a valid output format. Skipping.\n";
return;
}
# Figure out what class(es) that could actually mean...
my @classes;
# 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
) {
#print "Considering $prefix$stem\n";
}
# Tidier, but misses too much:
#push @classes, $prefix . ucfirst(lc($rest));
}
return;
}
###########################################################################
# % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
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";
}
}
# % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
###########################################################################
sub new { # yeah, nothing fancy
my $class = shift;
$new;
}
#..........................................................................
my $self = shift;
my $out = join( '',
DEBUG ? do {
# the o is justified, as $package really won't change.
$callsub . ": ";
} : '',
@_,
);
}
return;
}
#..........................................................................
sub usage {
my $self = shift;
warn "@_\n" if @_;
# Erase evidence of previous errors (if any), so exit status is simple.
$! = 0;
die <<EOF;
`perlfunc'.
}
#..........................................................................
sub usage_brief {
$me =~ s,.*[/\\],,; # get basename
die <<"EOUSAGE";
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] [-F] [-X] PageName|ModuleName|ProgramName
$me -q FAQKeywords
}
#..........................................................................
#..........................................................................
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->{'found'} ||= [];
$self->{'temp_file_list'} ||= [];
$self->{'target'} = undef;
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.
);
return;
}
#..........................................................................
my $self = shift;
$self->{'formatter_classes'} ||= [];
# Remember, no switches have been read yet, when
# we've started this routine.
));
return;
}
#..........................................................................
sub process {
# if this ever returns, its retval will be used for exit(RETVAL)
my $self = shift;
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".
# 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
my @pages;
# @pages = __FILE__
# if @pages == 1 and $pages[0] eq 'perldoc';
}
$self->maybe_diddle_INC();
# for when we're apparently in a module or extension directory
DEBUG and print "We're in -l mode, so byebye after this:\n";
return;
}
}
#..........................................................................
{
my( %class_seen, %class_loaded );
my $self = $_[0];
die "WHAT? Nothing in the formatter class list!?" unless @class_list;
my $good_class_found;
foreach my $c (@class_list) {
if($class_loaded{$c}) {
$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(
# the alway case-insensitive fs's
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 {
local $^W = $^W;
# feh, let 'em see it
} else {
$^W = 0;
# The average user just has no reason to be seeing
# $^W-suppressable warnings from the the require!
}
eval "require $c";
if($@) {
next;
}
}
if( $c->can('parse_from_file') ) {
my $v = $c->VERSION;
$v = ( defined $v and length $v ) ? " version $v" : '';
$good_class_found = $c;
last;
} else {
}
}
die "Can't find any loadable formatter class in @class_list?!\nAborting"
unless $good_class_found;
return;
}
}
#..........................................................................
sub formatter_sanity_check {
my $self = shift;
|| die "NO FORMATTER CLASS YET!?";
and !$formatter_class->is_pageable
) {
my $ext =
) || '';
die
"When using Perldoc to format with $formatter_class, you have to\n"
. "specify -T or -dsomefile$ext\n"
. "See `perldoc perldoc' for more information on those switches.\n"
;
}
}
#..........................................................................
sub render_and_page {
my($self, $found_list) = @_;
printf "Perldoc (%s) output saved to %s\n",
$out;
print "But notice that it's 0 bytes long!\n" unless -s $out;
} elsif( # Allow the formatter to "page" itself, if it wants.
and do {
1;
} else {
'';
}
}
) {
# Do nothing, since the formatter has "paged" it for itself.
} else {
# Page it normally (internally)
if( -s $out ) { # Usual case:
} else {
# Odd case:
. "via $$self{'formatter_class'}) as it is 0-length.\n");
}
}
return;
}
#..........................................................................
sub options_reading {
my $self = shift;
require Text::ParseWords;
# Yes, appends to the beginning
unshift @{ $self->{'args'} },
;
} else {
}
DEBUG > 1
and print " Args right before switch processing: @{$self->{'args'}}\n";
DEBUG > 1
and print " Args after switch processing: @{$self->{'args'}}\n";
return;
}
#..........................................................................
sub options_processing {
my $self = shift;
my $podidx = "$Config{'archlib'}/pod.idx";
}
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?
return;
}
#..........................................................................
sub grand_search_init {
foreach (@$pages) {
local $_;
while (<PODIDX>) {
chomp;
}
close(PODIDX) or die "Can't close $$self{'podidx'}: $!";
next;
}
next unless -r;
next;
}
# We must look both in @INC for library modules and in $bindir
# for executables, like h2xs or perldoc itself.
if (IS_VMS) {
my($i,$trn);
push(@searchdirs,$trn);
}
}
else {
$ENV{'PATH'})));
}
}
if (@files) {
}
else {
# no match, try recursive search
@searchdirs = grep(!/^\.\z/s,@INC);
if (@files) {
}
else {
print STDERR "No " .
if ( @{ $self->{'found'} } ) {
print STDERR "However, try\n";
next if ($file =~ /^\./s);
print STDERR "\tperldoc $_\::$file\n";
}
closedir(DIR) or die "closedir $dir: $!";
}
}
}
}
}
return @found;
}
#..........................................................................
my($self, $found_things) = @_;
my @dynamic_pod;
} elsif ( @dynamic_pod ) {
# I.e., it MIGHT be deleted at the end.
close $buffd or 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
} else {
@$found_things = ();
}
return;
}
#..........................................................................
my $self = shift;
push @{ $self->{'formatter_switches'} }, [ @_ ] if @_;
return;
}
#..........................................................................
sub search_perlfunc {
my $perlfunc = shift @$found_things;
or die("Can't open $perlfunc: $!");
# Functions like -r, -e, etc. are listed under `-X'.
DEBUG > 2 and
print "Going to perlfunc-scan for $search_re in $perlfunc\n";
# Skip introduction
local $_;
while (<PFUNC>) {
}
# Look for our function
my $found = 0;
my $inlist = 0;
while (<PFUNC>) { # "The Mothership Connection is here!"
$found = 1;
}
elsif (/^=item/) {
}
next unless $found;
if (/^=over/) {
++$inlist;
}
elsif (/^=back/) {
--$inlist;
}
push @$pod, $_;
++$found if /^\w/; # found descriptive text
}
if (!@$pod) {
die sprintf
"No documentation for perl function `%s' found\n",
;
}
close PFUNC or die "Can't open $perlfunc: $!";
return;
}
#..........................................................................
sub search_perlfaqs {
my $found = 0;
my %found_in;
my $rx = eval { qr/$search_key/ }
or die <<EOD;
$@
local $_;
foreach my $file (@$found_things) {
die "invalid file spec: $!" if $file =~ /[<>|]/;
or die "Can't read-open $file: $!\nAborting";
while (<INFAQ>) {
if ( m/^=head2\s+.*(?:$search_key)/i ) {
$found = 1;
}
elsif (/^=head[12]/) {
$found = 0;
}
next unless $found;
push @$pod, $_;
}
close(INFAQ);
}
die("No documentation for perl FAQ keyword `$search_key' found\n")
unless @$pod;
return;
}
#..........................................................................
sub render_findings {
# Return the filename to open
my($self, $found_things) = @_;
|| die "No formatter class set!?";
? $formatter_class->new
;
if(! @$found_things) {
die "Nothing found?!";
# should have been caught before here
} elsif(@$found_things > 1) {
warn join '',
"Perldoc is only really meant for reading one document at a time.\n",
"So these parameters are being ignored: ",
"\n"
}
# Set formatter options:
if( ref $formatter ) {
foreach my $f (@{ $self->{'formatter_switches'} || [] }) {
warn "Got an error when setting $formatter_class\->$switch:\n$@\n"
if $@;
} else {
} else {
warn "$formatter_class doesn't recognize the $switch switch.\n";
}
}
}
}
$self->{'output_is_binary'} =
|| undef,
);
# Now, finally, do the formatting!
{
local $^W = $^W;
# feh, let 'em see it
} else {
$^W = 0;
# The average user just has no reason to be seeing
# $^W-suppressable warnings from the formatting!
}
}
warn "Error while formatting with $formatter_class:\n $@\n" if $@;
close $out_fh
or 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.
unless( -s $out ) {
# 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?
} else {
warn "Got a 0-length file from $$found_things[0] via $formatter_class!?\n"
}
}
DEBUG and print "Finished writing to $out.\n";
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.
#
if(grep $_ eq $file, @$temp_file_list) {
unlink($file) or warn "Odd, couldn't unlink $file: $!";
} else {
}
return;
}
#..........................................................................
sub MSWin_temp_cleanup {
# Nothing particularly MSWin-specific in here, but I don't know if any
# other OS needs its temp dir policed like MSWin does!
my $self = shift;
and -e $tempdir and -d _ and -w _;
"Considering whether any old files of mine in $tempdir need unlinking.\n"
);
my @to_unlink;
my $limit = time() - $Temp_File_Lifetime;
($limit) x 2;
my $filespec;
if(
) {
if( hex($1) < $limit ) {
push @to_unlink, "$tempdir/$filespec";
} else {
DEBUG > 5 and
printf " $tempdir/$filespec is too recent (after %x)\n", $limit;
}
} else {
DEBUG > 5 and
print " $tempdir/$filespec doesn't look like a perldoc temp file.\n";
}
}
closedir(TMPDIR);
scalar(unlink(@to_unlink)),
);
return;
}
# . . . . . . . . . . . . . . . . . . . . . . . . .
sub MSWin_perldoc_tempfile {
and -e $tempdir and -d _ and -w _;
my $spec;
do {
# Yes, we embed the create-time in the filename!
$tempdir,
$infix || 'x',
time(),
$$,
defined( &Win32::GetTickCount )
: int(rand 256)
# Under MSWin, $$ values get reused quickly! So if we ran
# perldoc foo and then perldoc bar before there was time for
# time() to increment time."_$$" would likely be the same
# for each process! So we tack on the tick count's lower
# bits (or, in a pinch, rand)
,
$suffix || 'txt';
;
} while( -e $spec );
my $counter = 0;
while($counter < 50) {
my $fh;
# If we are running before perl5.6.0, we can't autovivify
if ($] < 5.006) {
require Symbol;
}
}
die "Can't make a tempfile!?";
}
#..........................................................................
sub after_rendering {
my $self = $_[0];
return;
}
sub after_rendering_VMS { return }
sub after_rendering_Dos { return }
sub after_rendering_OS2 { return }
sub after_rendering_MSWin32 {
shift->MSWin_temp_cleanup() if $Temp_Files_Created;
}
#..........................................................................
# : : : : : : : : :
#..........................................................................
or IS_VMS or IS_MSWin32
) {
# On a case-forgiving file system, or if case is important,
# that is it, all we can do.
warn "Ignored $path: unreadable\n" if -f _;
return '';
}
local *DIR;
my @p = ($dir);
my($p,$cip);
stat $try;
if (-d _) {
push @p, $p;
if ( $p eq $self->{'target'} ) {
my $path_f = 0;
for (@{ $self->{'found'} }) {
}
}
}
elsif (-f _ && -r _) {
return $try;
}
elsif (-f _) {
warn "Ignored $try: unreadable\n";
}
elsif (-d catdir(@p)) { # at least we see the containing directory!
my $found = 0;
my $lcp = lc $p;
$found++;
last; # XXX stop at the first? what if there's others?
}
}
closedir DIR or die "closedir $p_dirspec: $!";
return "" unless $found;
push @p, $cip;
my $p_filespec = catfile(@p);
return $p_filespec if -f $p_filespec and -r _;
warn "Ignored $p_filespec: unreadable\n" if -f _;
}
}
return "";
}
#..........................................................................
sub pagers_guessing {
my $self = shift;
my @pagers;
if (IS_MSWin32) {
}
elsif (IS_VMS) {
}
elsif (IS_Dos) {
}
else {
if (IS_OS2) {
}
}
return;
}
#..........................................................................
sub page_module_file {
# 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
# 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 ($self->{'output_to_stdout'}) {
local $_;
my $any_error = 0;
warn("Can't open $output: $!");
$any_error = 1;
next;
}
while (<TMP>) {
print or die "Can't print to stdout: $!";
}
close TMP or die "Can't close while $output: $!";
}
return $any_error; # successful
}
return 0;
}
# Odd -- when it fails, under Win32, this seems to neither
# return with a fail nor return with a success!!
# That's discouraging!
}
sprintf "Can't manage to find a way to page [%s] via pagers [%s]\n",
join(' ', @found),
);
if (IS_VMS) {
eval q{
exit $?;
1;
} or die;
}
return 1;
# i.e., an UNSUCCESSFUL return value!
}
#..........................................................................
sub check_file {
unless( ref $self ) {
# Should never get called:
Carp::croak join '',
"check_file must be an object_method!\n",
"Aborting"
}
return "";
}
}
else {
DEBUG > 3 and print
" The file $path indeed looks promising!\n";
return $path;
}
}
return "";
}
#..........................................................................
sub containspod {
# you cannot open a file with that name. It must be spelled
#
# The following if-case under cygwin prevents error
#
# $ perldoc perl
#
# This would work though
#
# $ perldoc perl.pod
{
return 0;
}
local($_);
while (<TEST>) {
if (/^=head/) {
close(TEST) or die "Can't close $file: $!";
return 1;
}
}
close(TEST) or 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") {
# Add "." and "lib" to @INC (if they exist)
eval q{ use lib qw(. lib); 1; } or die;
# don't add if superuser
if ($< && $> && -f "blib") { # don't be looking too hard now!
eval q{ use blib; 1 };
}
}
return;
}
#..........................................................................
sub new_output_file {
my $self = shift;
# So don't call this twice per format-job!
# Otherwise open a write-handle on opt_d!f
my $fh;
# If we are running before perl5.6.0, we can't autovivify
if ($] < 5.006) {
require Symbol;
}
die "Can't write-open $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;
return undef unless @$pages;
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;
}
return $chunk;
}
#..........................................................................
my $self = shift;
if( IS_MSWin32 ) {
# otherwise fall thru to the normal stuff below...
}
}
#..........................................................................
if ($output_to_stdout) {
local $_;
while (<TMP>) {
print or die "Can't print to stdout: $!";
}
close TMP or die "Can't close while $output: $!";
} else {
# On VMS, quoting prevents logical expansion, and temp files with no
# extension get the wrong default extension (such as .LIS for TYPE)
if (IS_VMS) {
last if system("$pager $output") == 0;
} else {
last if system("$pager \"$output\"") == 0;
}
}
}
return;
}
#..........................................................................
sub searchfor {
$s =~ s!::!/!g;
return $s if -f $s && $self->containspod($s);
my $ret;
my $i;
my $dir;
for ($i=0; $i<@dirs; $i++) {
or ( IS_VMS and
or ( IS_OS2 and
) {
return $ret;
}
if ($recurse) {
opendir(D,$dir) or die "Can't opendir $dir: $!";
not /^\.\.?\z/s and
not /^auto\z/s and # save time! don't search auto dirs
} readdir D;
closedir(D) or die "Can't closedir $dir: $!";
next unless @newdirs;
# what a wicked map!
}
}
return ();
}
#..........................................................................
{
my $already_asserted;
sub assert_closing_stdout {
my $self = shift;
return if $already_asserted;
eval q~ END { close(STDOUT) || die "Can't close STDOUT: $!" } ~;
# What for? to let the pager know that nothing more will come?
die $@ if $@;
$already_asserted = 1;
return;
}
}
#..........................................................................
sub tweak_found_pathnames {
if (IS_MSWin32) {
foreach (@$found) { s,/,\\,g }
}
return;
}
#..........................................................................
# : : : : : : : : :
#..........................................................................
sub am_taint_checking {
my $self = shift;
my($k,$v) = each %ENV;
return is_tainted($v);
}
#..........................................................................
my $arg = shift;
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
|| IS_OS2
)
&& ($> == 0 || $< == 0)
&& !$self->am_taint_checking()
) {
my $id = eval { getpwnam("nobody") };
#
# 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";
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;
# See "perldoc perldoc" for basic details.
#
# Perldoc -- look up a piece of documentation in .pod format that
# is embedded in the perl installation tree.
#
#~~~~~~
#
# See ChangeLog in CPAN dist for Pod::Perldoc for later notes.
#
# Version 3.01: Sun Nov 10 21:38:09 MST 2002
# Sean M. Burke <sburke@cpan.org>
# Massive refactoring and code-tidying.
# Now it's a module(-family)!
# Formatter-specific stuff pulled out into Pod::Perldoc::To(Whatever).pm
# Added -T, -d, -o, -M, -w.
# Added some improved MSWin funk.
#
#~~~~~~
#
# Version 2.05: Sat Oct 12 16:09:00 CEST 2002
# Hugo van der Sanden <hv@crypt.org>
# Made -U the default, based on patch from Simon Cozens
# Version 2.04: Sun Aug 18 13:27:12 BST 2002
# Randy W. Sims <RandyS@ThePierianSpring.org>
# allow -n to enable nroff under Win32
# Version 2.03: Sun Apr 23 16:56:34 BST 2000
# Hugo van der Sanden <hv@crypt.org>
# don't die when 'use blib' fails
# Version 2.02: Mon Mar 13 18:03:04 MST 2000
# Tom Christiansen <tchrist@perl.com>
# Added -U insecurity option
# Version 2.01: Sat Mar 11 15:22:33 MST 2000
# Tom Christiansen <tchrist@perl.com>, querulously.
# Security and correctness patches.
# What a twisted bit of distasteful spaghetti code.
# Version 2.0: ????
#
#~~~~~~
#
# Version 1.15: Tue Aug 24 01:50:20 EST 1999
# Charles Wilson <cwilson@ece.gatech.edu>
# changed /pod/ directory to /pods/ for cygwin
# Version 1.14: Wed Jul 15 01:50:20 EST 1998
# Robin Barker <rmb1@cise.npl.co.uk>
# -strict, -w cleanups
# Version 1.13: Fri Feb 27 16:20:50 EST 1997
# Gurusamy Sarathy <gsar@activestate.com>
# -doc tweaks for -F and -X options
# Version 1.12: Sat Apr 12 22:41:09 EST 1997
# Gurusamy Sarathy <gsar@activestate.com>
# -various fixes for win32
# Version 1.11: Tue Dec 26 09:54:33 EST 1995
# Kenneth Albanowski <kjahds@kjahds.com>
# -added Charles Bailey's further VMS patches, and -u switch
# -added -t switch, with pod2text support
#
# Version 1.10: Thu Nov 9 07:23:47 EST 1995
# Kenneth Albanowski <kjahds@kjahds.com>
# -added VMS support
# -added better error recognition (on no found pages, just exit. On
# -added recursive/case-insensitive matching (thanks, Andreas). This
# slows things down a bit, unfortunately. Give a precise name, and
# it'll run faster.
#
# Version 1.01: Tue May 30 14:47:34 EDT 1995
# Andy Dougherty <doughera@lafcol.lafayette.edu>
# -added pod documentation.
# -added PATH searching.
# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
# and friends.
#
#~~~~~~~
#
# TODO:
#
# Cache the directories read during sloppy match
# (To disk, or just in-memory?)
#
# Backport this to perl 5.005?
#
# Implement at least part of the "perlman" interface described
# in Programming Perl 3e?