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_metaclass { 'Class::MOP::Class' }
  12
  13 around violation => sub {
  14     my $orig = shift;
  15     my $self = shift;
  16     my $desc = shift;
  17     my $expl = shift;
  18     my $doc  = shift || $self->document;
  19
  20     return $self->$orig($desc, $expl, $doc, @_);
  21 };
  22
  23 sub violates_dynamic {
  24     my $self = shift;
  25     my $doc  = shift;
  26
  27     $self->document($doc);
  28     $self->compile_document;
  29
  30     my @packages = $self->find_packages;
  31
  32     my @violations;
  33     for my $package (@packages) {
  34         my $meta = Class::MOP::class_of($package);
  35         next unless grep { $meta->isa($_) } $self->applies_to_metaclass;
  36
  37         push @violations, $self->violates_metaclass($meta, $doc);
  38     }
  39
  40     return @violations;
  41 }
  42
  43 sub compile_document {
  44     my $self = shift;
  45     my $doc = $self->document;
  46
  47     eval "$doc";
  48 }
  49
  50 sub find_packages {
  51     my $self = shift;
  52     my $doc = $self->document;
  53
  54     return map { $_->namespace }
  55            @{ $doc->find('PPI::Statement::Package') || [] };
  56 }
  57
  58 __PACKAGE__->meta->make_immutable;
  59 no Moose;
  60
  61 1;
  62