Avoid applying to every element in the tree, we just apply to the doc
[gitmo/Perl-Critic-Dynamic-Moose.git] / lib / Perl / Critic / Policy / Dynamic / Moose.pm
CommitLineData
a3c86d00 1package Perl::Critic::Policy::Dynamic::Moose;
2use Moose;
8f31d0d0 3use MooseX::NonMoose;
a3c86d00 4extends 'Perl::Critic::DynamicPolicy';
5
8f31d0d0 6has document => (
7 is => 'rw',
8 isa => 'PPI::Document',
9);
10
cc784ef4 11sub applies_to { 'PPI::Document' }
8f31d0d0 12sub applies_to_metaclass { 'Class::MOP::Class' }
13
14around violation => sub {
15 my $orig = shift;
16 my $self = shift;
17 my $desc = shift;
18 my $expl = shift;
19 my $doc = shift || $self->document;
20
21 return $self->$orig($desc, $expl, $doc, @_);
22};
23
a3c86d00 24sub violates_dynamic {
25 my $self = shift;
26 my $doc = shift;
27
8f31d0d0 28 $self->document($doc);
29 $self->compile_document;
30
31 my @packages = $self->find_packages;
32
33 my @violations;
34 for my $package (@packages) {
35 my $meta = Class::MOP::class_of($package);
36 next unless grep { $meta->isa($_) } $self->applies_to_metaclass;
37
38 push @violations, $self->violates_metaclass($meta, $doc);
39 }
40
41 return @violations;
42}
43
44sub compile_document {
45 my $self = shift;
46 my $doc = $self->document;
47
48 eval "$doc";
49}
50
51sub find_packages {
52 my $self = shift;
53 my $doc = $self->document;
a3c86d00 54
8f31d0d0 55 return map { $_->namespace }
56 @{ $doc->find('PPI::Statement::Package') || [] };
a3c86d00 57}
58
59__PACKAGE__->meta->make_immutable;
60no Moose;
61
621;
63