| Subject: | [patch]: let perldoc search built-in variables |
Per requests on use.perl (http://use.perl.org/~Ovid/journal/35771), I've
attached the patch to the RT queue.
For those who don't know about this, it allows you to do stuff like:
perldoc -A $.
perldoc -A $1
perldoc -A $^H
And so on ...
Cheers,
Ovid
| Subject: | pod_perldoc.patch |
diff -u -r Pod-Perldoc-3.14.orig/ChangeLog Pod-Perldoc-3.14/ChangeLog
--- Pod-Perldoc-3.14.orig/ChangeLog 2004-11-30 22:27:01.000000000 +0000
+++ Pod-Perldoc-3.14/ChangeLog 2008-02-26 19:08:49.000000000 +0000
@@ -1,6 +1,10 @@
Revision history for Perl module group Pod::Perldoc
Time-stamp: "2004-11-30 13:27:01 AST"
+2008-02-26
+ * Release 3.15 -- Search perlvar
+ * Applied patch to allow -A for searching perlvar.
+
2004-11-30 Sean M. Burke sburke@cpan.org
* Release 3.14 -- bugfix for Cygwin
diff -u -r Pod-Perldoc-3.14.orig/lib/Pod/Perldoc.pm Pod-Perldoc-3.14/lib/Pod/Perldoc.pm
--- Pod-Perldoc-3.14.orig/lib/Pod/Perldoc.pm 2004-11-30 22:27:31.000000000 +0000
+++ Pod-Perldoc-3.14/lib/Pod/Perldoc.pm 2008-02-26 19:07:19.000000000 +0000
@@ -12,7 +12,7 @@
use vars qw($VERSION @Pagers $Bindir $Pod2man
$Temp_Files_Created $Temp_File_Lifetime
);
-$VERSION = '3.14';
+$VERSION = '3.15';
#..........................................................................
BEGIN { # Make a DEBUG constant very first thing...
@@ -62,7 +62,7 @@
#
# Option accessors...
-foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdU}) {
+foreach my $subname (map "opt_$_", split '', q{AmhlvriFfXqnTdU}) {
no strict 'refs';
*$subname = do{ use strict 'refs'; sub () { shift->_elem($subname, @_) } };
}
@@ -71,6 +71,7 @@
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_A_with { shift->_elem('opt_A', @_) }
sub opt_w_with { # Specify an option for the formatter subclass
my($self, $value) = @_;
@@ -294,6 +295,7 @@
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 -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]
@@ -410,6 +412,7 @@
$self->{'pages'} = \@pages;
if( $self->opt_f) { @pages = ("perlfunc") }
elsif( $self->opt_q) { @pages = ("perlfaq1" .. "perlfaq9") }
+ elsif( $self->opt_A) { @pages = ("perlvar") }
else { @pages = @{$self->{'args'}};
# @pages = __FILE__
# if @pages == 1 and $pages[0] eq 'perldoc';
@@ -754,10 +757,12 @@
my @dynamic_pod;
$self->search_perlfunc($found_things, \@dynamic_pod) if $self->opt_f;
+
+ $self->search_perlvar($found_things, \@dynamic_pod) if $self->opt_A;
$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_A ) {
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");
@@ -802,6 +807,119 @@
#..........................................................................
+sub _get_prev_perlvar {
+ my ( $self, $var ) = @_;
+ my %prev = qw(
+ $b $a
+ $_ $ARG
+ $& $MATCH
+ $` $PREMATCH
+ $' $POSTMATCH
+ $+ $LAST_PAREN_MATCH
+ @+ @LAST_MATCH_END
+ $. HANDLE->input_line_number(EXPR)
+ $/ IO::Handle->input_record_separator(EXPR)
+ $| HANDLE->autoflush(EXPR)
+ $\ IO::Handle->output_record_separator
+ $" $LIST_SEPARATOR
+ $; $SUBSCRIPT_SEPARATOR
+ $% HANDLE->format_page_number(EXPR)
+ $= HANDLE->format_lines_per_page(EXPR)
+ $- HANDLE->format_lines_left(EXPR)
+ @- @LAST_MATCH_START
+ $~ HANDLE->format_name(EXPR)
+ $^ HANDLE->format_top_name(EXPR)
+ $: IO::Handle->format_line_break_characters
+ $^L IO::Handle->format_formfeed
+ $^A $ACCUMULATOR
+ $? $CHILD_ERROR
+ $! $OS_ERROR
+ $^E $EXTENDED_OS_ERROR
+ $@ $EVAL_ERROR
+ $$ $PROCESS_ID
+ $< $REAL_USER_ID
+ $> $EFFECTIVE_USER_ID
+ $( $REAL_GROUP_ID
+ $) $EFFECTIVE_GROUP_ID
+ $0 $PROGRAM_NAME
+ $^C $COMPILING
+ $^D $DEBUGGING
+ $^F $SYSTEM_FD_MAX
+ $^I $INPLACE_EDIT
+ $^O $OSNAME
+ $^P $PERLDB
+ $^R $LAST_REGEXP_CODE_RESULT
+ $^S $EXCEPTIONS_BEING_CAUGHT
+ $^T $BASETIME
+ $^V $PERL_VERSION
+ $^W $WARNING
+ $^X $EXECUTABLE_NAME
+ );
+ $prev{'$,'} = 'IO::Handle->format_formfeed';
+ return $prev{$var} || '';
+}
+
+sub search_perlvar {
+ my($self, $found_things, $pod) = @_;
+
+ 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: $!");
+
+ my $opt = $self->opt_A;
+ if ( $opt =~ /^\$\d+$/ ) {
+ $opt = '$<I<digits>>';
+ }
+ if ( my $prev = $self->_get_prev_perlvar($opt) ) {
+ $opt = $prev;
+ }
+
+ # don't pick up the 0x$digits variables for $^P
+ my $search_re = $opt !~ /^0x/ ? quotemeta($opt) : 'no_such_variable';
+
+ DEBUG > 2 and
+ print "Going to pervar-scan for $search_re in $perlvar\n";
+
+ # Skip introduction
+ local $_;
+ while (<PVAR>) {
+ last if /^=over 8/;
+ }
+
+ # Look for our variable
+ my $found = 0;
+ 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 > 1 and not $inlist;
+ }
+ next unless $found;
+ if (/^=over/) {
+ ++$inlist;
+ }
+ elsif (/^=back/) {
+ --$inlist;
+ }
+ push @$pod, $_;
+ ++$found if /^\w/; # found descriptive text
+ }
+ if (!@$pod) {
+ die "No documentation for perl variable '$opt' found\n";
+ }
+ close PVAR or die "Can't open $perlvar: $!";
+
+ return;
+}
+
+#..........................................................................
+
sub search_perlfunc {
my($self, $found_things, $pod) = @_;
diff -u -r Pod-Perldoc-3.14.orig/lib/perldoc.pod Pod-Perldoc-3.14/lib/perldoc.pod
--- Pod-Perldoc-3.14.orig/lib/perldoc.pod 2003-09-11 23:19:39.000000000 +0100
+++ Pod-Perldoc-3.14/lib/perldoc.pod 2008-02-26 19:06:42.000000000 +0000
@@ -5,7 +5,7 @@
=head1 SYNOPSIS
-B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]
+B<perldoc> [B<-A>] [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]
[B<-i>] [B<-V>] [B<-T>] [B<-r>]
[B<-dI<destination_file>>]
[B<-oI<formatname>>]
@@ -19,6 +19,8 @@
B<perldoc> B<-q> FAQ Keyword
+B<perldoc> B<-A> Builtin variable
+
See below for more description of the switches.
=head1 DESCRIPTION
@@ -39,6 +41,11 @@
=over 5
+=item B<-A> I<perlvar>
+
+The B<-A> option followed by the name of a perl built in variable will
+extract the documentation of this variable from L<perlvar>.
+
=item B<-h>
Prints out a brief B<h>elp message.