X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPerl%2FCritic%2FPolicy%2FDynamicMoose.pm;h=49b725097ef530df2a3274f2d20dc0a2467f7411;hb=528d0b4b14394c73d5405d1fcae46a3261aebc1b;hp=5d5aad31fadc4cf56ed10a7d8806d28fb05d5048;hpb=3e18b7f4bdd89800ae37510b2d0b97432f03fb7b;p=gitmo%2FPerl-Critic-Dynamic-Moose.git

diff --git a/lib/Perl/Critic/Policy/DynamicMoose.pm b/lib/Perl/Critic/Policy/DynamicMoose.pm
index 5d5aad3..49b7250 100644
--- a/lib/Perl/Critic/Policy/DynamicMoose.pm
+++ b/lib/Perl/Critic/Policy/DynamicMoose.pm
@@ -1,24 +1,37 @@
-package Perl::Critic::Policy::Dynamic::Moose;
+package Perl::Critic::Policy::DynamicMoose;
 use Moose;
 use MooseX::NonMoose;
 extends 'Perl::Critic::DynamicPolicy';
 
 has document => (
-    is  => 'rw',
-    isa => 'PPI::Document',
+    is      => 'rw',
+    isa     => 'PPI::Document',
+    handles => [qw/ppi_document/],
 );
 
 sub applies_to { 'PPI::Document' }
-sub applies_to_metaclass { 'Class::MOP::Class' }
+sub applies_to_metaclass { 'Class::MOP::Class', inner() }
+sub default_themes { qw(moose dynamic dynamicmoose), inner() }
 
 around violation => sub {
-    my $orig = shift;
-    my $self = shift;
-    my $desc = shift;
-    my $expl = shift;
-    my $doc  = shift || $self->document;
+    my $orig    = shift;
+    my $self    = shift;
+    my $desc    = shift;
+    my $expl    = shift;
+    my $element = shift;
+
+    if (!$element) {
+        my $doc = $self->ppi_document;
+
+        # Without this hack, Storable complains of being unable to reconstruct
+        # overloading for an unknown package (perhaps PPI::Document?). For some
+        # reason it works for PPI::Element. Anyway, this should hopefully be
+        # replaced with a more useful location, something like
+        # ( class:MyClass / attr:foo / builder:build_foo )
+        $element = $doc->find('PPI::Element')->[0];
+    }
 
-    return $self->$orig($desc, $expl, $doc, @_);
+    return $self->$orig($desc, $expl, $element, @_);
 };
 
 sub violates_dynamic {
@@ -26,12 +39,13 @@ sub violates_dynamic {
     my $doc  = shift;
 
     $self->document($doc);
-    $self->compile_document;
 
-    my @packages = $self->find_packages;
+    my $old_packages = $self->find_packages;
+    $self->compile_document;
+    my @new_packages = $self->new_packages($old_packages);
 
     my @violations;
-    for my $package (@packages) {
+    for my $package (@new_packages) {
         my $meta = Class::MOP::class_of($package)
             or next;
 
@@ -57,10 +71,22 @@ sub compile_document {
 
 sub find_packages {
     my $self = shift;
-    my $doc = $self->document;
+    return [ Class::MOP::get_all_metaclass_names ];
+}
+
+sub new_packages {
+    my $self = shift;
+    my $old  = shift;
+    my @new;
+    my %seen;
+
+    $seen{$_} = 1 for @$old;
+
+    for (@{ $self->find_packages }) {
+        push @new, $_ if !$seen{$_}++;
+    }
 
-    return map { $_->namespace }
-           @{ $doc->find('PPI::Statement::Package') || [] };
+    return @new;
 }
 
 no Moose;