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
  15 around violation => sub {
  16     my $orig    = shift;
  17     my $self    = shift;
  18     my $desc    = shift;
  19     my $expl    = shift;
  20     my $element = shift;
  21
  22     if (!$element) {
  23         my $doc = $self->ppi_document;
  24         $element = $doc->find('PPI::Element')->[0];
  25     }
  26
  27     return $self->$orig($desc, $expl, $element, @_);
  28 };
  29
  30 sub violates_dynamic {
  31     my $self = shift;
  32     my $doc  = shift;
  33
  34     $self->document($doc);
  35     $self->compile_document;
  36
  37     my @packages = $self->find_packages;
  38
  39     my @violations;
  40     for my $package (@packages) {
  41         my $meta = Class::MOP::class_of($package)
  42             or next;
  43
  44         grep { $meta->isa($_) } $self->applies_to_metaclass
  45             or next;
  46
  47         push @violations, $self->violates_metaclass($meta, $doc);
  48     }
  49
  50     return @violations;
  51 }
  52
  53 sub compile_document {
  54     my $self = shift;
  55     my $doc = $self->document;
  56
  57     my $source_code = $doc->content;
  58
  59     eval $source_code;
  60
  61     die "Unable to execute " . $doc->filename . ": $@" if $@;
  62 }
  63
  64 sub find_packages {
  65     my $self = shift;
  66     my $doc = $self->document;
  67
  68     return map { $_->namespace }
  69            @{ $doc->find('PPI::Statement::Package') || [] };
  70 }
  71
  72 no Moose;
  73
  74 1;
  75