Skip Menu |
 

This queue is for tickets about the Pod-Perldoc CPAN distribution.

Report information
The Basics
Id: 33624
Status: resolved
Priority: 0/
Queue: Pod-Perldoc

People
Owner: ferreira [...] shoo.cpan.org
Requestors: ovid [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: [patch]: let perldoc search built-in variables
Download (untitled) / with headers
text/plain 257b
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.
This patch found its way into the dist at release 3.14_05.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.