Commit | Line | Data |
84a1bb62 |
1 | package Perl::Critic::Policy::DynamicMoose; |
a3c86d00 |
2 | use Moose; |
8f31d0d0 |
3 | use MooseX::NonMoose; |
a3c86d00 |
4 | extends 'Perl::Critic::DynamicPolicy'; |
5 | |
8f31d0d0 |
6 | has document => ( |
1e6decf8 |
7 | is => 'rw', |
8 | isa => 'PPI::Document', |
9 | handles => [qw/ppi_document/], |
8f31d0d0 |
10 | ); |
11 | |
cc784ef4 |
12 | sub applies_to { 'PPI::Document' } |
914f300c |
13 | sub applies_to_metaclass { 'Class::MOP::Class', inner() } |
244fe3b5 |
14 | sub default_themes { qw(moose dynamic), inner() } |
8f31d0d0 |
15 | |
16 | around violation => sub { |
1e6decf8 |
17 | my $orig = shift; |
18 | my $self = shift; |
19 | my $desc = shift; |
20 | my $expl = shift; |
21 | my $element = shift; |
22 | |
23 | if (!$element) { |
24 | my $doc = $self->ppi_document; |
0004d229 |
25 | |
26 | # Without this hack, Storable complains of being unable to reconstruct |
27 | # overloading for an unknown package (perhaps PPI::Document?). For some |
28 | # reason it works for PPI::Element. Anyway, this should hopefully be |
29 | # replaced with a more useful location, something like |
30 | # ( class:MyClass / attr:foo / builder:build_foo ) |
1e6decf8 |
31 | $element = $doc->find('PPI::Element')->[0]; |
32 | } |
8f31d0d0 |
33 | |
1e6decf8 |
34 | return $self->$orig($desc, $expl, $element, @_); |
8f31d0d0 |
35 | }; |
36 | |
a3c86d00 |
37 | sub violates_dynamic { |
38 | my $self = shift; |
39 | my $doc = shift; |
40 | |
8f31d0d0 |
41 | $self->document($doc); |
8f31d0d0 |
42 | |
91827b04 |
43 | my $old_packages = $self->_find_packages; |
44 | $self->_compile_document; |
45 | my @new_packages = $self->_new_packages($old_packages); |
8f31d0d0 |
46 | |
47 | my @violations; |
34502164 |
48 | for my $package (@new_packages) { |
c140dc59 |
49 | my $meta = Class::MOP::class_of($package) |
50 | or next; |
51 | |
52 | grep { $meta->isa($_) } $self->applies_to_metaclass |
53 | or next; |
8f31d0d0 |
54 | |
55 | push @violations, $self->violates_metaclass($meta, $doc); |
56 | } |
57 | |
58 | return @violations; |
59 | } |
60 | |
b971d8fa |
61 | sub violates_metaclass { die "Your policy (" . blessed($_[0]) . ") needs to implement violates_metaclass" } |
62 | |
91827b04 |
63 | sub _compile_document { |
8f31d0d0 |
64 | my $self = shift; |
65 | my $doc = $self->document; |
66 | |
1ad52929 |
67 | my $source_code = $doc->content; |
68 | |
69 | eval $source_code; |
70 | |
71 | die "Unable to execute " . $doc->filename . ": $@" if $@; |
8f31d0d0 |
72 | } |
73 | |
91827b04 |
74 | sub _find_packages { |
8f31d0d0 |
75 | my $self = shift; |
34502164 |
76 | return [ Class::MOP::get_all_metaclass_names ]; |
77 | } |
78 | |
91827b04 |
79 | sub _new_packages { |
34502164 |
80 | my $self = shift; |
81 | my $old = shift; |
82 | my @new; |
83 | my %seen; |
84 | |
85 | $seen{$_} = 1 for @$old; |
86 | |
91827b04 |
87 | for (@{ $self->_find_packages }) { |
34502164 |
88 | push @new, $_ if !$seen{$_}++; |
89 | } |
a3c86d00 |
90 | |
34502164 |
91 | return @new; |
a3c86d00 |
92 | } |
93 | |
a3c86d00 |
94 | no Moose; |
95 | |
96 | 1; |
97 | |
e556eafb |
98 | __END__ |
99 | |
100 | =head1 NAME |
101 | |
102 | Perl::Critic::Policy::DynamicMoose |
103 | |
104 | =head1 DESCRIPTION |
105 | |
106 | The included policies are: |
107 | |
108 | =over 4 |
109 | |
110 | =item L<Perl::Critic::Policy::DynamicMoose::ProhibitPublicBuilders> |
111 | |
112 | Prohibit public builder methods for attributes. [Severity: 3] |
113 | |
114 | =back |
115 | |
ea5503e8 |
116 | =head1 WARNING |
117 | |
118 | B<VERY IMPORTANT:> Most L<Perl::Critic> Policies (including all the ones that |
119 | ship with Perl::Critic> use pure static analysis -- they never compile nor |
120 | execute any of the code that they analyze. However, this policy is very |
121 | different. It actually attempts to compile your code and then compares the |
122 | subroutines mentioned in your code to those found in the symbol table. |
123 | Therefore you should B<not> use this Policy on any code that you do not trust, |
124 | or may have undesirable side-effects at compile-time (such as connecting to the |
125 | network or mutating files). |
126 | |
127 | For this Policy to work, all the modules included in your code must be |
128 | installed locally, and must compile without error. |
129 | |
e556eafb |
130 | =head1 AUTHOR |
131 | |
132 | Shawn M Moore, C<sartak@bestpractical.com> |
133 | |
134 | =cut |
135 | |