use vars qw($VERSION @Pagers $Bindir $Pod2man
$Temp_Files_Created $Temp_File_Lifetime
);
-$VERSION = '3.14_01';
+$VERSION = '3.15';
#..........................................................................
BEGIN { # Make a DEBUG constant very first thing...
sub TRUE () {1}
sub FALSE () {return}
+sub BE_LENIENT () {1}
BEGIN {
*IS_VMS = $^O eq 'VMS' ? \&TRUE : \&FALSE unless defined &IS_VMS;
#
# Option accessors...
-foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdUL}) {
+foreach my $subname (map "opt_$_", split '', q{mhlDriFfXqnTdULv}) {
no strict 'refs';
*$subname = do{ use strict 'refs'; sub () { shift->_elem($subname, @_) } };
}
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) = @_;
#..........................................................................
-sub aside { # If we're in -v or DEBUG mode, say this.
+sub aside { # If we're in -D or DEBUG mode, say this.
my $self = shift;
- if( DEBUG or $self->opt_v ) {
+ if( DEBUG or $self->opt_D ) {
my $out = join( '',
DEBUG ? do {
my $callsub = (caller(1))[3];
perldoc [options] PageName|ModuleName|ProgramName...
perldoc [options] -f BuiltinFunction
perldoc [options] -q FAQRegex
+perldoc [options] -v PerlVariable
Options:
-h Display this help message
-n Specify replacement for nroff
-l Display the module's file name
-F Arguments are file names, not modules
- -v Verbosely describe what's going on
+ -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
-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...
is the name of a piece of documentation that you want to look at. You
$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] [-L translation_code] [-F] [-X] PageName|ModuleName|ProgramName
+Usage: $me [-h] [-V] [-r] [-i] [-D] [-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
$me -f PerlFunc
$me -q FAQKeywords
+ $me -A PerlVar
The -h option prints more help. Also try "perldoc perldoc" to get
acquainted with the system. [Perldoc v$VERSION]
DEBUG > 3 and printf "Formatter switches now: [%s]\n",
join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
+ $self->{'translators'} = [];
+ $self->{'extra_search_dirs'} = [];
+
return;
}
$self->{'pages'} = \@pages;
if( $self->opt_f) { @pages = ("perlfunc") }
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;
- # Adjusts pages for translation packages
- if ( $self->opt_L ) {
- eval "require POD2::" . uc($self->opt_L);
- @pages = map { 'POD2::' . uc($self->opt_L) . '::' . $_ } @pages if ! $@;
- }
-
$self->find_good_formatter_class();
$self->formatter_sanity_check();
DEBUG > 4 and print "Trying to eval 'require $c'...\n";
local $^W = $^W;
- if(DEBUG() or $self->opt_v) {
+ if(DEBUG() or $self->opt_D) {
# feh, let 'em see it
} else {
$^W = 0;
$self->opt_n("nroff") unless $self->opt_n;
$self->add_formatter_option( '__nroffer' => $self->opt_n );
+ # Adjust for using translation packages
+ $self->add_translator($self->opt_L) if $self->opt_L;
+
return;
}
# 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;
+ 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;
}
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.
-
- my @searchdirs = ($self->{'bindir'}, @INC);
+ push @searchdirs, ($self->{'bindir'}, @INC);
unless ($self->opt_m) {
if (IS_VMS) {
my($i,$trn);
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);
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 ) {
+ 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");
push @{ $self->{'temp_file_list'} }, $buffer;
# I.e., it MIGHT be deleted at the end.
- my $in_list = $self->opt_f;
+ my $in_list = $self->opt_f || $self->opt_v;
print $buffd "=over 8\n\n" if $in_list;
print $buffd @dynamic_pod or die "Can't print $buffer: $!";
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
+ 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 ) {
+ 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 die("Can't open $perlvar: $!");
+
+ if ( $opt =~ /^\$\d+$/ ) { # handle $1, $2, ..., $9
+ $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/) {
+ --$inlist;
+ }
+ push @$pod, $_;
+# ++$found if /^\w/; # found descriptive text
+ }
+ @$pod = () unless $found;
+ if (!@$pod) {
+ die "No documentation for perl variable '$opt' found\n";
+ }
+ close PVAR or die "Can't open $perlvar: $!";
+
+ return;
+}
+
#..........................................................................
sub search_perlfunc {
my $re = 'Alphabetical Listing of Perl Functions';
if ( $self->opt_L ) {
- my $code = 'POD2::' . uc($self->opt_L);
- $re = $code->search_perlfunc_re if $code->can('search_perlfunc_re');
+ my $tr = $self->{'translators'}->[0];
+ $re = $tr->search_perlfunc_re if $tr->can('search_perlfunc_re');
}
# Skip introduction
die "Nothing found?!";
# should have been caught before here
} elsif(@$found_things > 1) {
- warn join '',
+ 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] ),
# Now, finally, do the formatting!
{
local $^W = $^W;
- if(DEBUG() or $self->opt_v) {
+ if(DEBUG() or $self->opt_D) {
# feh, let 'em see it
} else {
$^W = 0;
if ( IS_Cygwin and -x $file and -f "$file.exe" )
{
- warn "Cygwin $file.exe search skipped\n" if DEBUG or $self->opt_v;
+ warn "Cygwin $file.exe search skipped\n" if DEBUG or $self->opt_D;
return 0;
}
# Does this look like a module or extension directory?
- if (-f "Makefile.PL") {
+ if (-f "Makefile.PL" || -f "Build.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!
+ if ($< && $> && -d "blib") { # don't be looking too hard now!
eval q{ use blib; 1 };
- warn $@ if $@ && $self->opt_v;
+ warn $@ if $@ && $self->opt_D;
}
}
$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 IS_VMS;
if ( (! $self->opt_m && ( $ret = $self->check_file($dir,"$s.pod")))
or ( $ret = $self->check_file($dir,"$s.pm"))
__END__
-# See "perldoc perldoc" for basic details.
+=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: Adriano R. Ferreira <ferreira@cpan.org>
+
+Past contributions from:
+Sean M. Burke <sburke@cpan.org>
+
+=cut
+
+#
#
# Perldoc -- look up a piece of documentation in .pod format that
# is embedded in the perl installation tree.
https://perl5.git.perl.org / perl5.git / blobdiff