From aa7a2c99bff2a8d02d75f6b9f7155483cc94318c Mon Sep 17 00:00:00 2001

From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>

Date: Tue, 13 Aug 2019 16:49:21 +0200

Subject: [PATCH 2/2] Search for X<> in the whole perlop document

MIME-Version: 1.0

Content-Type: text/plain; charset=UTF-8

Content-Transfer-Encoding: 8bit

perlop documents many operators before "Regexp Quote-Like Operators"

(X<operator, regexp>) section. A change introduced with "Refactor

search_perlop RT#86506" (d8b23dcb1a) commit started to ignore those

operators. E.g. A search for '==' did not found anything. A search for

'<>' returned too many text and broke POD syntax.

This patch searches for X<> index entries in all sections and

considers =head keywords in addition to =item as section delimeters.

Because some X<> entries exists on more places, this patch implements

this strategy: First =item section that contains the X<> entry is

returned. If there is no =item sections, last =head section is

returned. If the =item entry is empty (like for 'tr'), the the output

continues up to and including a next non-empty =item. This strategy is

implemented in one pass.

Signed-off-by: Petr Písař <ppisar@redhat.com>

---

 lib/Pod/Perldoc.pm        | 116 ++++++++++++++++++++++++++------------

 t/03_builtin_pod_output.t |   8 +++

 2 files changed, 89 insertions(+), 35 deletions(-)

diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm

index cd52aa2..b54cc23 100644

--- a/lib/Pod/Perldoc.pm

+++ b/lib/Pod/Perldoc.pm

@@ -1153,6 +1153,20 @@ sub search_perlvar {

 #..........................................................................

+# Check whether an item POD section contains any documentation text. The POD

+# section is passed as refernce to list of lines.

+# If there is no text, return true; otherwise false.

+sub item_has_no_text {

+    for (@{$_[0]}) {

+        next if /^=over\s/;

+        next if /^=item\s/;

+        next if /^X</;

+        next if /^\s*$/;

+        return 0;

+    }

+    return 1;

+}

+

 sub search_perlop {

   my ($self,$found_things,$pod) = @_;

@@ -1166,60 +1180,92 @@ sub search_perlop {

   my $thing = $self->opt_f;

-  my $previous_line;

+  my @previous_lines;

+  my $stop_line;

+  my $wrap_into_over;

   my $push = 0;

-  my $seen_item = 0;

-  my $skip = 1;

+  my $pod_candidate = [];

   while( my $line = <$fh> ) {

     $line =~ /^=encoding\s+(\S+)/ && $self->set_encoding($fh, $1);

-    # only start search after we hit the operator section

-    if ($line =~ m!^X<operator, regexp>!) {

-        $skip = 0;

-    }

-    next if $skip;

-

-    # strategy is to capture the previous line until we get a match on X<$thingy>

-    # if the current line contains X<$thingy>, then we push "=over", the previous line, 

-    # the current line and keep pushing current line until we see a ^X<some-other-thing>, 

-    # then we chop off final line from @$pod and add =back

+    # A strategy is to capture the previous lines from =head or =item until we

+    # get a match on X<$thing>.  If the current line contains X<$thing>, then

+    # we push "=over" (in case of =item), the previous lines, the current line

+    # and keep pushing current line until we see a terminating POD keyworkd

+    # (=head, =item, =over, corrsponding to the starting POD keyword). Then we

+    # append =back (in case of =item).

     #

-    # At that point, Bob's your uncle.

-

-    if ( $line =~ m!X<+\s*\Q$thing\E\s*>+!) {

-        if ( $previous_line ) {

-            push @$pod, "=over 8\n\n", $previous_line;

-            $previous_line = "";

+    # If this was =item, we are done. If the =item was empty (like two

+    # consequtive =item-s documented at once) we continue gathering other

+    # =item-s until we get some content. Then we are done.

+    #

+    # If this was a =head, we stash the POD section and do another search in

+    # hope we will found =item section. (=item sections tends to be more

+    # focused on =X<$thing> than =head sections.) If did not found any =item

+    # section, we will return the last found =head section.

+

+    if ( $line =~ m!X<+\s*\Q$thing\E\s*>+! ) {

+        if ( @previous_lines ) {

+            push @$pod_candidate, "=over 8\n\n" if $wrap_into_over;

+            push @$pod_candidate, @previous_lines;

+            @previous_lines = ();

         }

-        push @$pod, $line;

+        push @$pod_candidate, $line;

         $push = 1;

     }

-    elsif ( $push and $line =~ m!^=item\s*.*$! ) {

-        $seen_item = 1;

-    }

-    elsif ( $push and $seen_item and $line =~ m!^X<+\s*[ a-z,?-]+\s*>+!) {

+    elsif ( $push and $line =~ m/$stop_line/ ) {

         $push = 0;

-        $seen_item = 0;

-        last;

+

+        # X exists twice in perlop. Prefer =item location over =head

+        # location. We assume =item is more specific.

+        if ($wrap_into_over) {

+            # However, the X =item section is empty (except of bunch of

+            # X<> kewords) and documented in the next =item section. Thus

+            # continue until the so far gathered text looks empty.

+            if ($line =~ /^=item\s/ && item_has_no_text($pod_candidate)) {

+                $push = 1;

+                push @$pod_candidate, $line;

+                # and continue appending following =item section

+            } else {

+                # We have an =item with a content.

+                push @$pod_candidate, "\n\n=back\n";

+                # Replace pod with the candidate

+                @$pod = @$pod_candidate;

+                last;

+            }

+        } else {

+            # Copy the candidate to pod

+            push @$pod, @$pod_candidate;

+            $pod_candidate = [];

+            # And search for another occurance of the X<> reference with the

+            # prospect it will be an =item.

+        }

     }

     elsif ( $push ) {

-        push @$pod, $line;

-    }

-

-    else {

-        $previous_line = $line;

+        push @$pod_candidate, $line;

+    }

+

+    if ( !$push ) {

+        # Gather a smallest block starting with "=head" or "=item"

+        if ($line =~ /^=head([1234])\s/) {

+            $stop_line = join('', 1..$1);

+            $stop_line = qr/^=head[$stop_line]\s/;

+            $wrap_into_over = 0;

+            @previous_lines = ();

+        } elsif ($line =~ /^=item\s/) {

+            $stop_line = qr/^=(?:item\s|back\b)/;

+            $wrap_into_over = 1;

+            @previous_lines = ();

+        }

+        push @previous_lines, $line;

     }

   } #end while

   # we overfilled by 1 line, so pop off final array element if we have any

   if ( scalar @$pod ) {

-    pop @$pod;

-

-    # and add the =back

-    push @$pod, "\n\n=back\n";

     DEBUG > 8 and print "PERLOP POD --->" . (join "", @$pod) . "<---\n";

   }

   else {

diff --git a/t/03_builtin_pod_output.t b/t/03_builtin_pod_output.t

index 70f8549..d42a242 100644

--- a/t/03_builtin_pod_output.t

+++ b/t/03_builtin_pod_output.t

@@ -24,6 +24,14 @@ my %builtins = (

         qr/\A\s+"tr\/\*SEARCHLIST\*\/\*REPLACEMENTLIST\*\/cdsr"\n/,

         qr/\n\s+eval "tr\/\$oldlist\/\$newlist\/, 1" or die \$\@;\n\n\z/

     ],

+    '==' => [ # CPAN RT#126015

+        qr/\A\s+Equality Operators\n/,

+        qr/\n\s+if \( fc\(\$x\) eq fc\(\$y\) \) \{ \.\.\. \}\n\n\z/

+    ],

+    '<>' => [ # CPAN RT#126015

+        qr/\A\s+I\/O Operators\n/,

+        qr/\n\s+for its regular truth value\.\n\n\z/

+    ]

 );

 plan tests => 5 * scalar keys %builtins;

-- 

2.21.0