From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 26 Apr 2009 00:31:13 +0000 (-0400)
Subject: Basic implementation of much of Perl::Critic::Policy::Dynamic::Moose
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FPerl-Critic-Dynamic-Moose.git;a=commitdiff_plain;h=8f31d0d020bc45ff793ea4b35d39573d8494255c

Basic implementation of much of Perl::Critic::Policy::Dynamic::Moose
---

diff --git a/lib/Perl/Critic/Policy/Dynamic/Moose.pm b/lib/Perl/Critic/Policy/Dynamic/Moose.pm
index e6773ae..2e9dcf1 100644
--- a/lib/Perl/Critic/Policy/Dynamic/Moose.pm
+++ b/lib/Perl/Critic/Policy/Dynamic/Moose.pm
@@ -1,12 +1,58 @@
 package Perl::Critic::Policy::Dynamic::Moose;
 use Moose;
+use MooseX::NonMoose;
 extends 'Perl::Critic::DynamicPolicy';
 
+has document => (
+    is  => 'rw',
+    isa => 'PPI::Document',
+);
+
+sub applies_to_metaclass { 'Class::MOP::Class' }
+
+around violation => sub {
+    my $orig = shift;
+    my $self = shift;
+    my $desc = shift;
+    my $expl = shift;
+    my $doc  = shift || $self->document;
+
+    return $self->$orig($desc, $expl, $doc, @_);
+};
+
 sub violates_dynamic {
     my $self = shift;
     my $doc  = shift;
 
+    $self->document($doc);
+    $self->compile_document;
+
+    my @packages = $self->find_packages;
+
+    my @violations;
+    for my $package (@packages) {
+        my $meta = Class::MOP::class_of($package);
+        next unless grep { $meta->isa($_) } $self->applies_to_metaclass;
+
+        push @violations, $self->violates_metaclass($meta, $doc);
+    }
+
+    return @violations;
+}
+
+sub compile_document {
+    my $self = shift;
+    my $doc = $self->document;
+
+    eval "$doc";
+}
+
+sub find_packages {
+    my $self = shift;
+    my $doc = $self->document;
 
+    return map { $_->namespace }
+           @{ $doc->find('PPI::Statement::Package') || [] };
 }
 
 __PACKAGE__->meta->make_immutable;