lib/Perl/Critic/Policy/DynamicMoose.pm

   1 package Perl::Critic::Policy::DynamicMoose;
   2 use Moose;
   3 use MooseX::NonMoose;
   4 extends 'Perl::Critic::DynamicPolicy';
   5
   6 has document => (
   7     is      => 'rw',
   8     isa     => 'PPI::Document',
   9     handles => [qw/ppi_document/],
  10 );
  11
  12 sub applies_to { 'PPI::Document' }
  13 sub applies_to_metaclass { 'Class::MOP::Class', inner() }
  14 sub default_themes { qw(moose dynamic), inner() }
  15
  16 around violation => sub {
  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;
  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 )
  31         $element = $doc->find('PPI::Element')->[0];
  32     }
  33
  34     return $self->$orig($desc, $expl, $element, @_);
  35 };
  36
  37 sub violates_dynamic {
  38     my $self = shift;
  39     my $doc  = shift;
  40
  41     $self->document($doc);
  42
  43     my $old_packages = $self->_find_packages;
  44     $self->_compile_document;
  45     my @new_packages = $self->_new_packages($old_packages);
  46
  47     my @violations;
  48     for my $package (@new_packages) {
  49         my $meta = Class::MOP::class_of($package)
  50             or next;
  51
  52         grep { $meta->isa($_) } $self->applies_to_metaclass
  53             or next;
  54
  55         push @violations, $self->violates_metaclass($meta, $doc);
  56     }
  57
  58     return @violations;
  59 }
  60
  61 sub violates_metaclass { die "Your policy (" . blessed($_[0]) . ") needs to implement violates_metaclass" }
  62
  63 sub _compile_document {
  64     my $self = shift;
  65     my $doc = $self->document;
  66
  67     my $source_code = $doc->content;
  68
  69     eval $source_code;
  70
  71     die "Unable to execute " . $doc->filename . ": $@" if $@;
  72 }
  73
  74 sub _find_packages {
  75     my $self = shift;
  76     return [ Class::MOP::get_all_metaclass_names ];
  77 }
  78
  79 sub _new_packages {
  80     my $self = shift;
  81     my $old  = shift;
  82     my @new;
  83     my %seen;
  84
  85     $seen{$_} = 1 for @$old;
  86
  87     for (@{ $self->_find_packages }) {
  88         push @new, $_ if !$seen{$_}++;
  89     }
  90
  91     return @new;
  92 }
  93
  94 no Moose;
  95
  96 1;
  97
  98 __END__
  99
 100 =head1 NAME
 101
 102 Perl::Critic::Policy::DynamicMoose
 103
 104 =head1 DESCRIPTION
 105
 106 This class is a base class for dynamic Moose policies. This class facilitates
 107 critiquing metaclasses (instead of the usual PPI documents). For example, the
 108 L<Perl::Critic::Policy::DynamicMoose::ProhibitPublicBuilders> policy critiques
 109 metaclasses by checking whether any of their attributes' builders do not start
 110 with an underscore. Due to the very dynamic nature of Moose and
 111 metaprogramming, such policies will be much more effective than static analysis
 112 at critiquing classes.
 113
 114 =head1 PUBLIC METHODS
 115
 116 =over 4
 117
 118 =item C<applies_to_metaclass>
 119
 120 Returns a list of metaclass names that this policy can critique. By default,
 121 the list is L<Class::MOP::Class>. You may use the augment modifier to add
 122 other kinds of metaclasses, such as L<Moose::Meta::Role> without having to
 123 repeat the L<Class::MOP::Class>:
 124
 125     augment applies_to_metaclass => sub { 'Moose::Meta::Role' };
 126
 127 Note that only the top-level metaclass is given to you. If you want to critique
 128 only attributes, then you must do the Visiting yourself.
 129
 130 =item C<applies_to_themes>
 131
 132 Returns a list of themes for Perl::Critic so that users can run a particular
 133 subset of themes on their code. By default, the list contains C<moose> and
 134 C<dynamic>. You should use the augment modifier to add more themes instead
 135 of overriding the method:
 136
 137     augment themes => sub { 'role' };
 138
 139 =item C<violation>
 140
 141 This extends the regular L<Perl::Critic::Policy/violation> method by providing
 142 a (rather useless) default value for the C<element> parameter. For nearly all
 143 cases, there's no easy way to find where a metaclass violation occurred. You
 144 may still pass such an element if you have one. However, since you probably do
 145 not, you should be exact in your violation's description.
 146
 147 =item C<violates_metaclass>
 148
 149 This method is required to be overridden by subclasses. It takes a metaclass
 150 object and the L<Perl::Critic::Document> representing the entire compilation
 151 unit. It is expected to return a list of L<Perl::Critic::Violation> objects.
 152
 153 =over
 154
 155 =head1 POLICIES
 156
 157 The included policies are:
 158
 159 =over 4
 160
 161 =item L<Perl::Critic::Policy::DynamicMoose::ProhibitPublicBuilders>
 162
 163 Prohibit public builder methods for attributes. [Severity: 3]
 164
 165 =back
 166
 167 =head1 WARNING
 168
 169 B<VERY IMPORTANT:> Most L<Perl::Critic> Policies (including all the ones that
 170 ship with Perl::Critic> use pure static analysis -- they never compile nor
 171 execute any of the code that they analyze.  However, this policy is very
 172 different.  It actually attempts to compile your code and then compares the
 173 subroutines mentioned in your code to those found in the symbol table.
 174 Therefore you should B<not> use this Policy on any code that you do not trust,
 175 or may have undesirable side-effects at compile-time (such as connecting to the
 176 network or mutating files).
 177
 178 For this Policy to work, all the modules included in your code must be
 179 installed locally, and must compile without error.
 180
 181 =head1 AUTHOR
 182
 183 Shawn M Moore, C<sartak@bestpractical.com>
 184
 185 =cut
 186