File Coverage

blib/lib/Perl/Critic/Policy/Modules/RequireExplicitPackage/ObjectPad.pm
Criterion Covered Total %
statement 30 30 100.0
branch 9 10 90.0
condition 12 16 75.0
subroutine 8 8 100.0
pod n/a
total 59 64 92.1


line stmt bran cond sub pod time code
1             use strict;
2 1     1   151105 use warnings;
  1         8  
  1         33  
3 1     1   6 use parent qw(Perl::Critic::Policy::Modules::RequireExplicitPackage);
  1         2  
  1         31  
4 1     1   6 use Class::Method::Modifiers;
  1         1  
  1         7  
5 1     1   96329 our $VERSION = "0.001";
  1         1313  
  1         402  
6              
7             =head1 NAME
8              
9             Perl::Critic::Policy::Modules::RequireExplicitPackage::ObjectPad - Always make the package/Object::Pad class explicit.
10              
11             =cut
12              
13             =head1 METHOLDS
14              
15             =head2 violates
16              
17             Please see L<Perl::Critic::Policy::Modules::RequireExplicitPackage::violates>
18              
19             =cut
20              
21             # PODNAME: Perl::Critic::Policy::Modules::RequireExplicitPackage
22              
23             around violates => sub {
24             my $orig = shift;
25             my ($self, $elem, $doc) = @_;
26             $doc = _replace_class($doc);
27             return $orig->($self, $elem, $doc);
28             };
29              
30             =head2 _replace_class
31              
32             replace 'use Object::Pad' and 'class XXXX' with `package XXX` in L<PPI::Document> object, to make it be processable by L<Perl::Critic::Policy::Modules::RequireExplicitPackage::violates>
33              
34             Argument: PPI::Document object
35             Return: cloned PPI::document object
36              
37             =cut
38              
39             my $doc = shift;
40             my $cloned_doc = $doc->clone();
41 7     7   25698 my $object_pad = $cloned_doc->find_first(
42 7         22 sub {
43             $_[1]->parent == $_[0]
44             and $_[1]->isa('PPI::Statement::Include')
45 33 100 50 33   629 and ($_[1]->type // '') eq 'use'
      100        
      50        
      66        
46             and ($_[1]->module // '') eq 'Object::Pad';
47             });
48             return $cloned_doc unless $object_pad;
49 7         1169 my $class = $cloned_doc->find_first(
50 7 100       634 sub {
51             $_[1]->parent == $_[0]
52             and $_[1]->isa('PPI::Statement')
53 45 100 100 45   713 and $_[1]->child(0)->isa('PPI::Token::Word')
      66        
54             and $_[1]->child(0)->literal eq 'class';
55             });
56             return $cloned_doc unless $class;
57 5         21 return $cloned_doc unless "$class" =~ /class\s+(\w+)/;
58 5 100       148 my $class_name = $1;
59 4 50       11 $cloned_doc->remove_child($object_pad);
60 4         252 my $package_code = "package $class_name;";
61 4         14 my $package_doc = PPI::Document->new(\$package_code);
62 4         104 my $package_statement = $package_doc->find_first(sub { $_[1]->isa('PPI::Statement::Package') });
63 4         13 $package_doc->remove_child($package_statement);
64 4     4   2997 $class->insert_before($package_statement);
  4         69  
65 4         43 return $cloned_doc;
66 4         90 }
67 4         144 1;
68