Make the policy aware of blocks reported by indirect 0.16

[perl/modules/Perl-Critic-Policy-Dynamic-NoIndirect.git] / lib / Perl / Critic / Policy / Dynamic / NoIndirect.pm

diff --git a/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm b/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
index 5b0ac623c72b1a6f34b2beeccf073b97f4179db6..cb88e6bae8fd68bd26e97a566374bbbd34778a71 100644 (file)
--- a/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
+++ b/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
@@ -11,11 +11,11 @@ Perl::Critic::Policy::Dynamic::NoIndirect - Perl::Critic policy against indirect
 
 =head1 VERSION
 
-Version 0.01
+Version 0.03
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.03';
 
 =head1 DESCRIPTION
 
@@ -34,6 +34,12 @@ sub default_severity { $SEVERITY_HIGH }
 sub default_themes   { qw/dynamic maintenance/ }
 sub applies_to       { 'PPI::Document' }
 
+my $tag_obj = sub {
+ my $obj = '' . $_[0];
+ $obj = '{' if $obj =~ /^\s*\{/;
+ $obj;
+};
+
 sub violates_dynamic {
  my ($self, undef, $doc) = @_;
 
@@ -74,23 +80,24 @@ sub violates_dynamic {
  my @violations;
 
  if (@errs) {
-  my ($err, $obj, $meth, $line);
+  my %errs_tags;
+  for (@errs) {
+   my ($obj, $meth, $line) = @$_[0, 1, 3];
+   $line -= $offset;
+   my $tag = join "\0", $line, $meth, $tag_obj->($obj);
+   push @{$errs_tags{$tag}}, [ $obj, $meth ];
+  }
 
   $doc->find(sub {
-   unless ($err) {
-    return 1 unless @errs;
-    $err = shift @errs;
-    ($obj, $meth, $line) = @$err[0, 1, 3];
-    $line -= $offset;
-   }
-
    my $elt = $_[1];
    my $pos = $elt->location;
+   return 0 unless $pos;
 
-   if ($pos and $pos->[0] == $line and $elt eq $meth
-                                   and $elt->snext_sibling eq $obj) {
-    push @violations, [ $obj, $meth, $elt ];
-    undef $err;
+   my $tag = join "\0", $pos->[0], $elt, $tag_obj->($elt->snext_sibling);
+   if (my $errs = $errs_tags{$tag}) {
+    push @violations, do { my $e = pop @$errs; push @$e, $elt; $e };
+    delete $errs_tags{$tag} unless @$errs;
+    return 1 unless %errs_tags;
    }
 
    return 0;
@@ -99,8 +106,9 @@ sub violates_dynamic {
 
  return map {
   my ($obj, $meth, $elt) = @$_;
+  $obj = ($obj =~ /^\s*\{/) ? "a block" : "object \"$obj\"";
   $self->violation(
-   "Indirect call of method \"$meth\" on object \"$obj\"",
+   "Indirect call of method \"$meth\" on $obj",
    "You really wanted $obj\->$meth",
    $elt,
   );