[perl #27886][PATCH] for any perl thing, perldoc -f should coughup some tip

[Renée Bäcker <renee.baecker@smart-websolutions.de>]

Attached is a patch that makes perldoc display parts of perlop.pod when 
you want perldoc -f qr etc. Suggestions are welcome.
Maybe we should add another option (e.g. "-o") instead of using -f...

To get reasonable results for things like "tr" I'm going to add more 
X<...> entries in perlop.pod.

-- 
Renée Bäcker
renee.baecker@smart-websolutions.de

XING: http://www.xing.com/profile/Renee_Baecker
Foo-Magazin: http://foo-magazin.de

--- Perldoc.pm	2008-06-26 13:20:19.000000000 +0200
+++ /opt/perl510/lib/5.10.0/Pod/Perldoc.pm	2008-06-26 13:10:12.000000000 +0200
@@ -413,7 +413,7 @@
 
     my @pages;
     $self->{'pages'} = \@pages;
-    if(    $self->opt_f) { @pages = ("perlfunc")               }
+    if(    $self->opt_f) { @pages = ("perlfunc", "perlop")     }
     elsif( $self->opt_q) { @pages = ("perlfaq1" .. "perlfaq9") }
     else                 { @pages = @{$self->{'args'}};
                            # @pages = __FILE__
@@ -788,7 +788,7 @@
         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->not_dynamic && $self->opt_f;
 
         print $buffd "=over 8\n\n" if $in_list;
         print $buffd @dynamic_pod  or die "Can't print $buffer: $!";
@@ -812,6 +812,14 @@
 
 #..........................................................................
 
+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 @_;
@@ -885,10 +893,13 @@
         last if /^=head2 $re/;
     }
 
+    my @perlops = qw(m q qq qr qx qw s tr y);
+
     # Look for our function
     my $found = 0;
     my $inlist = 0;
     while (<PFUNC>) {  # "The Mothership Connection is here!"
+        last if( grep{ $self->opt_f eq $_ }@perlops );
         if ( m/^=item\s+$search_re\b/ )  {
             $found = 1;
         }
@@ -905,6 +916,11 @@
         push @$pod, $_;
         ++$found if /^\w/;        # found descriptive text
     }
+
+    if( !@$pod ){
+        $self->search_perlop( $found_things, $pod );
+    }
+
     if (!@$pod) {
         die sprintf
           "No documentation for perl function `%s' found\n",
@@ -918,6 +934,61 @@
 
 #..........................................................................
 
+sub search_perlop {
+    my ($self,$found_things,$pod) = @_;
+
+    $self->not_dynamic( 1 );
+
+    my $perlop = shift @$found_things;
+    open( PERLOP, '<', $perlop ) or 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_perlfaqs {
     my( $self, $found_things, $pod) = @_;

---

[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

---