filename not file
[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) {
c140dc59 35 my $meta = Class::MOP::class_of($package)
36 or next;
37
38 grep { $meta->isa($_) } $self->applies_to_metaclass
39 or next;
8f31d0d0 40
41 push @violations, $self->violates_metaclass($meta, $doc);
42 }
43
44 return @violations;
45}
46
47sub compile_document {
48 my $self = shift;
49 my $doc = $self->document;
50
51 eval "$doc";
93f19e61 52 die "Unable to execute " . $doc->filename . ": $@";
8f31d0d0 53}
54
55sub find_packages {
56 my $self = shift;
57 my $doc = $self->document;
a3c86d00 58
8f31d0d0 59 return map { $_->namespace }
60 @{ $doc->find('PPI::Statement::Package') || [] };
a3c86d00 61}
62
63__PACKAGE__->meta->make_immutable;
64no Moose;
65
661;
67