Commit | Line | Data |
a3c86d00 |
1 | package Perl::Critic::Policy::Dynamic::Moose; |
2 | use Moose; |
8f31d0d0 |
3 | use MooseX::NonMoose; |
a3c86d00 |
4 | extends 'Perl::Critic::DynamicPolicy'; |
5 | |
8f31d0d0 |
6 | has document => ( |
7 | is => 'rw', |
8 | isa => 'PPI::Document', |
9 | ); |
10 | |
cc784ef4 |
11 | sub applies_to { 'PPI::Document' } |
8f31d0d0 |
12 | sub applies_to_metaclass { 'Class::MOP::Class' } |
13 | |
14 | around 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 |
24 | sub 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 | |
47 | sub compile_document { |
48 | my $self = shift; |
49 | my $doc = $self->document; |
50 | |
51 | eval "$doc"; |
c140dc59 |
52 | die "Unable to execute " . $doc->file . ": $@"; |
8f31d0d0 |
53 | } |
54 | |
55 | sub 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; |
64 | no Moose; |
65 | |
66 | 1; |
67 | |