File Coverage

blib/lib/Perl/Critic/Policy/Moo/ProhibitMakeImmutable.pm
Criterion Covered Total %
statement 43 44 97.7
branch 14 20 70.0
condition 18 36 50.0
subroutine 11 12 91.6
pod 4 5 80.0
total 90 117 76.9


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Moo::ProhibitMakeImmutable;
2              
3             $Perl::Critic::Policy::Moo::ProhibitMakeImmutable::VERSION = '0.04';
4              
5 1     1   324841 use strict;
  1         2  
  1         26  
6 1     1   5 use warnings;
  1         2  
  1         21  
7              
8 1     1   4 use Readonly;
  1         3  
  1         46  
9 1     1   4 use Perl::Critic::Utils qw{ :severities :classification :ppi };
  1         2  
  1         63  
10              
11 1     1   337 use base 'Perl::Critic::Policy';
  1         2  
  1         479  
12              
13             Readonly::Scalar my $DESC => q{Moo class should not call ->make_immutable};
14             Readonly::Scalar my $EXPL => q{When migrating from Moose to Moo it is easy to leave in __PACKAGE__->meta->make_immutable; statements which will cause Moose to be loaded and a metaclass created};
15              
16 6     6 0 971387 sub supported_parameters { return() }
17 2     2 1 28 sub default_severity { return $SEVERITY_MEDIUM }
18 0     0 1 0 sub default_themes { return qw( performance ) }
19 6     6 1 994366 sub applies_to { return 'PPI::Token::Word' }
20              
21             sub violates {
22 59     59 1 877 my ($self, $start_word, $doc) = @_;
23              
24 59 100       132 return unless $start_word->content() eq '__PACKAGE__';
25 6         27 my $element = $start_word;
26              
27 6         27 $element = $element->snext_sibling();
28 6 50 33     171 return unless $element
      33        
29             and $element->isa('PPI::Token::Operator')
30             and $element->content() eq '->';
31              
32 6         41 $element = $element->snext_sibling();
33 6 50 33     121 return unless $element
      33        
34             and $element->isa('PPI::Token::Word')
35             and $element->content() eq 'meta';
36              
37 6         34 $element = $element->snext_sibling();
38 6 50 33     130 return unless $element
      33        
39             and $element->isa('PPI::Token::Operator')
40             and $element->content() eq '->';
41              
42 6         34 $element = $element->snext_sibling();
43 6 50 33     122 return unless $element
      33        
44             and $element->isa('PPI::Token::Word')
45             and $element->content() eq 'make_immutable';
46              
47 6         36 my $package = _find_package( $start_word );
48              
49             my $included = $doc->find_any(sub{
50 277 100 66 277   3199 $_[1]->isa('PPI::Statement::Include')
      100        
      66        
51             and
52             defined( $_[1]->module() )
53             and
54             $_[1]->module() eq 'Moo'
55             and
56             $_[1]->type() eq 'use'
57             and
58             _find_package( $_[1] ) eq $package
59 6         126 });
60              
61 6 100       115 return if !$included;
62              
63 2         12 return $self->violation( $DESC, $EXPL, $start_word );
64             }
65              
66             sub _find_package {
67 14     14   461 my ($element) = @_;
68              
69 14         28 my $original = $element;
70              
71 14         36 while ($element) {
72 43 100       764 if ($element->isa('PPI::Statement::Package')) {
73             # If this package statements is a block package, meaning: package { # stuff in package }
74             # then if we're a descendant of it its our package.
75 11 50       28 return $element->namespace() if $element->ancestor_of( $original );
76              
77             # If we've hit a non-block package then thats our package.
78 11         162 my $blocks = $element->find_any('PPI::Structure::Block');
79 11 50       2398 return $element->namespace() if !$blocks;
80             }
81              
82             # Keep walking backwards until we match the above logic or we get to
83             # the document root (main).
84 32   100     83 $element = $element->sprevious_sibling() || $element->parent();
85             }
86              
87 3         30 return 'main';
88             }
89              
90             1;
91             __END__
92              
93             =head1 NAME
94              
95             Perl::Critic::Policy::Moo::ProhibitMakeImmutable - Makes sure that Moo classes
96             do not contain calls to make_immutable.
97              
98             =head1 DESCRIPTION
99              
100             When migrating from L<Moose> to L<Moo> it can be a common issue to accidentally
101             leave in:
102              
103             __PACKAGE__->meta->make_immutable;
104              
105             This policy complains if this exists in a Moo class as it triggers Moose to be
106             loaded and metaclass created, which defeats some of the benefits you get using
107             Moo instead of Moose.
108              
109             =head1 AUTHOR
110              
111             Aran Clary Deltac <bluefeetE<64>gmail.com>
112              
113             =head2 CONTRIBUTORS
114              
115             =over
116              
117             =item *
118              
119             Kivanc Yazan <kyznE<64>users.noreply.github.com>
120              
121             =item *
122              
123             Graham TerMarsch <grahamE<64>howlingfrog.com>
124              
125             =back
126              
127             =head1 ACKNOWLEDGEMENTS
128              
129             Thanks to L<ZipRecruiter|https://www.ziprecruiter.com/>
130             for encouraging their employees to contribute back to the open
131             source ecosystem. Without their dedication to quality software
132             development this distribution would not exist.
133              
134             =head1 LICENSE
135              
136             This library is free software; you can redistribute it and/or modify
137             it under the same terms as Perl itself.
138