More boilerplate doc

[gitmo/Perl-Critic-Dynamic-Moose.git] / lib / Perl / Critic / Policy / DynamicMoose.pm

diff --git a/lib/Perl/Critic/Policy/DynamicMoose.pm b/lib/Perl/Critic/Policy/DynamicMoose.pm
index c0c9036..147bef4 100644 (file)
--- a/lib/Perl/Critic/Policy/DynamicMoose.pm
+++ b/lib/Perl/Critic/Policy/DynamicMoose.pm
@@ -10,7 +10,8 @@ has 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;
@@ -21,6 +22,12 @@ around violation => sub {
 
     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];
     }
 
@@ -32,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;
 
@@ -63,13 +71,49 @@ sub compile_document {
 
 sub find_packages {
     my $self = shift;
-    my $doc = $self->document;
+    return [ Class::MOP::get_all_metaclass_names ];
+}
 
-    return map { $_->namespace }
-           @{ $doc->find('PPI::Statement::Package') || [] };
+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 @new;
 }
 
 no Moose;
 
 1;
 
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::DynamicMoose
+
+=head1 DESCRIPTION
+
+The included policies are:
+
+=over 4
+
+=item L<Perl::Critic::Policy::DynamicMoose::ProhibitPublicBuilders>
+
+Prohibit public builder methods for attributes. [Severity: 3]
+
+=back
+
+=head1 AUTHOR
+
+Shawn M Moore, C<sartak@bestpractical.com>
+
+=cut
+