lib/Perl/Critic/Policy/Dynamic/Moose.pm

   1 package Perl::Critic::Policy::Dynamic::Moose;
   2 use Moose;
   3 use MooseX::NonMoose;
   4 extends 'Perl::Critic::DynamicPolicy';
   5
   6 has document => (
   7     is  => 'rw',
   8     isa => 'PPI::Document',
   9 );
  10
  11 sub applies_to { 'PPI::Document' }
  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
  24 sub violates_dynamic {
  25     my $self = shift;
  26     my $doc  = shift;
  27
  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             or next;
  37
  38         grep { $meta->isa($_) } $self->applies_to_metaclass
  39             or next;
  40
  41         push @violations, $self->violates_metaclass($meta, $doc);
  42     }
  43
  44     return @violations;
  45 }
  46
  47 sub compile_document {
  48     my $self = shift;
  49     my $doc = $self->document;
  50
  51     eval "$doc";
  52     die "Unable to execute " . $doc->file . ": $@";
  53 }
  54
  55 sub find_packages {
  56     my $self = shift;
  57     my $doc = $self->document;
  58
  59     return map { $_->namespace }
  60            @{ $doc->find('PPI::Statement::Package') || [] };
  61 }
  62
  63 __PACKAGE__->meta->make_immutable;
  64 no Moose;
  65
  66 1;
  67