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) { |
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 | |
44 | sub compile_document { |
45 | my $self = shift; |
46 | my $doc = $self->document; |
47 | |
48 | eval "$doc"; |
49 | } |
50 | |
51 | sub 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; |
60 | no Moose; |
61 | |
62 | 1; |
63 | |