lib/Perl/Critic/DynamicMoosePolicy.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 __PACKAGE__->meta->make_immutable;
  96
  97 1;
  98
  99 __END__
 100
 101 =head1 NAME
 102
 103 Perl::Critic::Policy::DynamicMoose
 104
 105 =head1 DESCRIPTION
 106
 107 This documentation is written for policy authors. You may instead want
 108 L<Perl::Critic::Dynamic::Moose>.
 109
 110 This class is a base class for dynamic Moose policies. This class facilitates
 111 critiquing metaclasses (instead of the usual PPI documents). For example,
 112 L<Perl::Critic::Policy::DynamicMoose::ProhibitPublicBuilders> critiques
 113 metaclasses by checking whether any of their attributes' builders do not start
 114 with an underscore. Due to the very dynamic nature of Moose and
 115 metaprogramming, such policies will be much more effective than static analysis
 116 at critiquing classes.
 117
 118 =head1 PUBLIC METHODS
 119
 120 =over 4
 121
 122 =item C<applies_to_metaclass>
 123
 124 Returns a list of metaclass names that this policy can critique. By default,
 125 the list is L<Class::MOP::Class>. You may use the augment modifier to add
 126 other kinds of metaclasses, such as L<Moose::Meta::Role> without having to
 127 repeat the L<Class::MOP::Class>:
 128
 129     augment applies_to_metaclass => sub { 'Moose::Meta::Role' };
 130
 131 Note that only the top-level metaclass is given to you. If you want to critique
 132 only attributes, then you must do the Visiting yourself.
 133
 134 =item C<applies_to_themes>
 135
 136 Returns a list of themes for Perl::Critic so that users can run a particular
 137 subset of themes on their code. By default, the list contains C<moose> and
 138 C<dynamic>. You should use the augment modifier to add more themes instead
 139 of overriding the method:
 140
 141     augment themes => sub { 'role' };
 142
 143 =item C<violation>
 144
 145 This extends the regular L<Perl::Critic::Policy/violation> method by providing
 146 a (rather useless) default value for the C<element> parameter. For nearly all
 147 cases, there's no easy way to find where a metaclass violation occurred. You
 148 may still pass such an element if you have one. However, since you probably do
 149 not, you should be exact in your violation's description.
 150
 151 =item C<violates_metaclass>
 152
 153 This method is required to be overridden by subclasses. It takes a metaclass
 154 object and the L<Perl::Critic::Document> representing the entire compilation
 155 unit. It is expected to return a list of L<Perl::Critic::Violation> objects.
 156
 157 =over
 158
 159 =head1 POLICIES
 160
 161 The included policies are:
 162
 163 =over 4
 164
 165 =item L<Perl::Critic::Policy::DynamicMoose::ProhibitPublicBuilders>
 166
 167 Prohibit public builder methods for attributes. [Severity: 3]
 168
 169 =back
 170
 171 =head1 WARNING
 172
 173 B<VERY IMPORTANT:> Most L<Perl::Critic> Policies (including all the ones that
 174 ship with Perl::Critic> use pure static analysis -- they never compile nor
 175 execute any of the code that they analyze.  However, this policy is very
 176 different.  It actually attempts to compile your code and then compares the
 177 subroutines mentioned in your code to those found in the symbol table.
 178 Therefore you should B<not> use this Policy on any code that you do not trust,
 179 or may have undesirable side-effects at compile-time (such as connecting to the
 180 network or mutating files).
 181
 182 For this Policy to work, all the modules included in your code must be
 183 installed locally, and must compile without error.
 184
 185 =head1 AUTHOR
 186
 187 Shawn M Moore, C<sartak@bestpractical.com>
 188
 189 =cut
 190