Login
#65569: Documentation::RequirePodLinksIncludeText gives false-positive
authorTom Wyant <harryfmudd@comcast.net>
Wed, 16 Feb 2011 00:51:40 +0000 (00:51 +0000)
committerTom Wyant <harryfmudd@comcast.net>
Wed, 16 Feb 2011 00:51:40 +0000 (00:51 +0000)
on nested POD formatting

Converted the module to use Pod::Parser to do the heavy lifting. This
introduces a nominal new dependency on Pod::Parser, but since we already
have a dependency on Pod::PlainText, and Pod::PlainText needs
Pod::Parser, I hope this is a non-issue.

Changes
inc/Perl/Critic/BuildUtilities.pm
lib/Perl/Critic/Policy/Documentation/RequirePodLinksIncludeText.pm
lib/Perl/Critic/Utils/POD/ParseInteriorSequence.pm [new file with mode: 0644]
t/Documentation/RequirePodLinksIncludeText.run

diff --git a/Changes b/Changes
index 5c6e854..9f94122 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+A future release
+
+    Policy Changes:
+    * Documentation::RequirePodLinksIncludeText now handles nested POD
+      formatting. RT #65569
+
 [1.113] Released on 2011-02-14
 
     New Policies:
index ab10aff..1160e2e 100644 (file)
@@ -62,6 +62,7 @@ sub required_module_versions {
         'PPIx::Utilities::Node'         => '1.001',
         'PPIx::Utilities::Statement'    => '1.001',
         'Perl::Tidy'                    => 0,
+        'Pod::Parser'                   => 0,
         'Pod::PlainText'                => 0,
         'Pod::Select'                   => 0,
         'Pod::Spell'                    => 1,
index fb1f5b2..de0b29c 100644 (file)
@@ -14,9 +14,11 @@ use warnings;
 
 use Readonly;
 use English qw{ -no_match_vars };
-use Perl::Critic::Utils qw{ :booleans :severities };
+use Perl::Critic::Utils qw{ :booleans :characters :severities };
 use base 'Perl::Critic::Policy';
 
+use Perl::Critic::Utils::POD::ParseInteriorSequence;
+
 #-----------------------------------------------------------------------------
 
 our $VERSION = '1.113';
@@ -49,11 +51,20 @@ sub applies_to       { return 'PPI::Token::Pod'        }
 
 #-----------------------------------------------------------------------------
 
+Readonly::Scalar my $INCREMENT_NESTING => 1;
+Readonly::Scalar my $DECREMENT_NESTING => -1;
+Readonly::Hash my %ESCAPE_NESTING => (
+    '<' => $INCREMENT_NESTING,
+    '>' => $DECREMENT_NESTING,
+);
+
 sub violates {
     my ( $self, $elem, $doc ) = @_;
 
-    my @finish_re;
     my @violations;
+
+=begin comment
+
     my $pod = $elem->content();
 
     # We look for _any_ POD escape, not just L<>. This way we can avoid false
@@ -61,6 +72,7 @@ sub violates {
     # upward compatible (and at a slight (I hope!) risk of false negatives),
     # we accept any upper case letter as beginning a formatting sequence, not
     # just [IBCLEFSXZ].
+    SCAN_POD:
     while ( $pod =~ m/ ( [[:upper:]] ) ( <+ )   /smxg ) {
 
         # Collect the results of the match.
@@ -69,17 +81,31 @@ sub violates {
         my $content_start = $LAST_MATCH_END[0];
         my $num_brkt = length $2;
 
-        # Find the end, now that we know how many brackets we are looking for.
-        my $finish = $finish_re[$num_brkt] ||= qr/ >{$num_brkt} /smx;
-        $pod =~ m/ $finish /smxg or last;
+        # The only way to handle arbitrarily-nested brackets before Perl
+        # 5.10 is the (??{}) construction, which is _still_ marked
+        # 'experimental' as of 5.12.3 and 5.13.9. Taking them at their
+        # word, I'm going to find the end of the POD escape the hard
+        # way.
+        my $link_end = $link_start + 1;
+        my $nest = 0;
+        while ( 1 ) {
+            $nest += $ESCAPE_NESTING{ substr $pod, $link_end++, 1 } || 0;
+            $nest or last;
+            $link_end < length $pod
+                or last SCAN_POD;
+        }
+
+        # Manually advance past the end of the link so the regular
+        # expression does not find any possible nested formatting.
+        pos $pod = $link_end;
 
         # If it's not an 'L' formatter, we are not interested.
         'L' eq $formatter or next;
 
         # Save both the link itself and its contents for further analysis.
-        my $link = substr $pod, $link_start, $LAST_MATCH_END[0] - $link_start;
+        my $link = substr $pod, $link_start, $link_end - $link_start;
         my $content = substr $pod, $content_start,
-            $LAST_MATCH_START[0] - $content_start;
+            $link_end - $num_brkt - $content_start;
 
         # If the link is allowed, pass on to the next one.
         $self->_allowed_link( $content ) and next;
@@ -93,12 +119,53 @@ sub violates {
 
     }
 
+=enc comment
+
+=cut
+
+    my $parser = Perl::Critic::Utils::POD::ParseInteriorSequence->new();
+    $parser->errorsub( sub { return 1 } );  # Suppress error messages.
+
+    foreach my $seq ( $parser->get_interior_sequences( $elem->content() ) ) {
+
+        # Not interested in nested thing like C<< L<Foo> >>. I think.
+        $seq->nested() and next;
+
+        # Not interested in anything but L<...>.
+        'L' eq $seq->cmd_name() or next;
+
+        # If the link is allowed, pass on to the next one.
+        $self->_allowed_link( $seq ) and next;
+
+        # A-Hah! Gotcha!
+        my $line_number = $elem->line_number() + ( $seq->file_line() )[1] - 1;
+        push @violations, $self->violation(
+            join( $SPACE, 'Link', $seq->raw_text(),
+                "on line $line_number does not specify text" ),
+            $EXPL, $elem );
+    }
+
     return @violations;
 }
 
 sub _allowed_link {
+
+=begin comment
+
     my ( $self, $content ) = @_;
 
+=end comment
+
+=cut
+
+    my ( $self, $pod_seq ) = @_;
+
+    # Extract the content of the sequence.
+    my $content = $pod_seq->raw_text();
+    $content = substr $content, 0, - length $pod_seq->right_delimiter();
+    $content = substr $content, length( $pod_seq->cmd_name() ) + length(
+        $pod_seq->left_delimiter() );
+
     # Not interested in hyperlinks.
     $content =~ m{ \A \w+ : (?! : ) }smx
         and return $TRUE;
diff --git a/lib/Perl/Critic/Utils/POD/ParseInteriorSequence.pm b/lib/Perl/Critic/Utils/POD/ParseInteriorSequence.pm
new file mode 100644 (file)
index 0000000..efa14a5
--- /dev/null
@@ -0,0 +1,119 @@
+##############################################################################
+#      $URL$
+#     $Date$
+#   $Author$
+# $Revision$
+##############################################################################
+
+package Perl::Critic::Utils::POD::ParseInteriorSequence;
+
+use 5.006001;
+use strict;
+use warnings;
+
+use base qw{ Pod::Parser };
+
+use IO::String;
+
+our $VERSION = '1.113';
+
+#-----------------------------------------------------------------------------
+
+sub interior_sequence {
+    my ( $self, $seq_cmd, $seq_arg, $pod_seq ) = @_;
+    push @{ $self->{+__PACKAGE__}{interior_sequence} ||= [] }, $pod_seq;
+    return $self->SUPER::interior_sequence( $seq_cmd, $seq_arg, $pod_seq );
+}
+
+#-----------------------------------------------------------------------------
+
+sub get_interior_sequences {
+    my ( $self, $pod ) = @_;
+    $self->{+__PACKAGE__}{interior_sequence} = [];
+    my $result;
+    $self->parse_from_filehandle(
+        IO::String->new( \$pod ),
+        IO::String->new( \$result )
+    );
+    return @{ $self->{+__PACKAGE__}{interior_sequence} };
+}
+
+#-----------------------------------------------------------------------------
+
+1;
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=for stopwords
+
+=head1 NAME
+
+Perl::Critic::Utils::POD::ParseInteriorSequence - Pod::Parser subclass to find all interior sequences.
+
+
+=head1 SYNOPSIS
+
+    use Perl::Critic::Utils::POD::ParseInteriorSequence;
+
+    my $parser = Perl::Critic::Utils::POD::ParseInteriorSequence->new();
+    my @sequences = $parser->parse_interior_sequences(
+        $pod->content() );
+
+
+=head1 DESCRIPTION
+
+Provides a means to extract interior sequences from POD text.
+
+
+=head1 INTERFACE SUPPORT
+
+This module is considered to be private to Perl::Critic. It can be
+changed or removed without notice.
+
+
+=head1 METHODS
+
+=over
+
+=item C<get_interior_sequences( $pod_text )>
+
+Returns an array of all the interior sequences from a given chunk of POD
+text, represented as L<Pod::InteriorSequence|Pod::InputObjects> objects.
+The POD text is assumed to begin with a POD command (e.g.  C<=pod>).
+
+=item C<interior_sequence( $seq_cmd, $seq_arg, $pod_seq )>
+
+Overrides the parent's method of the same name. Stashes the $pod_seq
+argument, which is a C<Pod::InteriorSequence> object, so that
+C<get_interior_sequences()> has access to it.
+
+=back
+
+
+=head1 AUTHOR
+
+Thomas R. Wyant, III F<wyant at cpan dot org>
+
+
+=head1 COPYRIGHT
+
+Copyright (c) 2011 Thomas R. Wyant, III
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.  The full text of this license
+can be found in the LICENSE file included with this module.
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
index b6fc140..b332ac2 100644 (file)
@@ -128,6 +128,20 @@ L<critique()/critique> critiques a file, returning any violations found.
 
 =cut
 
+#-----------------------------------------------------------------------------
+
+## name Handle nested format codes RT 65569.
+## failures 0
+## cut
+
+=pod
+
+See L<C<perldiag>|perldiag> for the gory details.
+
+=cut
+
+#-----------------------------------------------------------------------------
+
 ##############################################################################
 #      $URL$
 #     $Date$