From aa7a2c99bff2a8d02d75f6b9f7155483cc94318c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= 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) 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ř --- 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 /^Xopt_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!) { - $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, - # 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