File Coverage

blib/lib/Perl/Critic/Policy/Moose/RequireMakeImmutable.pm
Criterion Covered Total %
statement 57 59 96.6
branch 25 40 62.5
condition n/a
subroutine 13 14 92.8
pod 5 6 83.3
total 100 119 84.0


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Moose::RequireMakeImmutable;
2              
3 1     1   878 use strict;
  1         2  
  1         41  
4 1     1   6 use warnings;
  1         1  
  1         48  
5              
6             our $VERSION = '1.03';
7              
8 1     1   7 use Readonly ();
  1         2  
  1         30  
9              
10 1     1   9 use Perl::Critic::Utils qw< :booleans :severities >;
  1         1  
  1         88  
11 1     1   203 use Perl::Critic::Utils::PPI qw< is_ppi_generic_statement >;
  1         2  
  1         53  
12              
13 1     1   7 use base 'Perl::Critic::Policy';
  1         2  
  1         879  
14              
15             Readonly::Scalar my $DESCRIPTION => 'No call was made to make_immutable().';
16             Readonly::Scalar my $EXPLANATION =>
17             q<Moose can't optimize itself if classes remain mutable.>;
18              
19             sub supported_parameters {
20             return (
21             {
22 4     4 0 19263 name => 'equivalent_modules',
23             description =>
24             q<The additional modules to treat as equivalent to "Moose".>,
25             default_string => 'Moose',
26             behavior => 'string list',
27             list_always_present_values => [qw< Moose >],
28             },
29             );
30             }
31              
32 2     2 1 27 sub default_severity { return $SEVERITY_MEDIUM; }
33 0     0 1 0 sub default_themes { return qw( moose performance ); }
34 4     4 1 377 sub applies_to { return 'PPI::Document' }
35              
36             sub prepare_to_scan_document {
37 4     4 1 47529 my ( $self, $document ) = @_;
38              
39 4         19 return $self->_is_interesting_document($document);
40             }
41              
42             sub _is_interesting_document {
43 4     4   13 my ( $self, $document ) = @_;
44              
45 4         6 foreach my $module ( keys %{ $self->{_equivalent_modules} } ) {
  4         26  
46 5 100       111 return $TRUE if $document->uses_module($module);
47             }
48              
49 0         0 return $FALSE;
50             }
51              
52             sub violates {
53 4     4 1 50 my ( $self, undef, $document ) = @_;
54              
55             my $makes_immutable = $document->find_any(
56             sub {
57 155     155   3360 my ( undef, $element ) = @_;
58              
59 155 100       366 return $FALSE if not is_ppi_generic_statement($element);
60              
61 6         75 my $current_token = $element->schild(0);
62 6 50       97 return $FALSE if not $current_token;
63 6 50       28 return $FALSE if not $current_token->isa('PPI::Token::Word');
64 6 100       23 return $FALSE if $current_token->content() ne '__PACKAGE__';
65              
66 2         19 $current_token = $current_token->snext_sibling();
67 2 50       66 return $FALSE if not $current_token;
68 2 50       12 return $FALSE if not $current_token->isa('PPI::Token::Operator');
69 2 50       7 return $FALSE if $current_token->content() ne '->';
70              
71 2         25 $current_token = $current_token->snext_sibling();
72 2 50       46 return $FALSE if not $current_token;
73 2 50       14 return $FALSE if not $current_token->isa('PPI::Token::Word');
74 2 50       7 return $FALSE if $current_token->content() ne 'meta';
75              
76 2         20 $current_token = $current_token->snext_sibling();
77 2 50       57 return $FALSE if not $current_token;
78 2 100       13 if ( $current_token->isa('PPI::Structure::List') ) {
79 1         18 $current_token = $current_token->snext_sibling();
80 1 50       24 return $FALSE if not $current_token;
81             }
82              
83 2 50       13 return $FALSE if not $current_token->isa('PPI::Token::Operator');
84 2 50       8 return $FALSE if $current_token->content() ne '->';
85              
86 2         19 $current_token = $current_token->snext_sibling();
87 2 50       47 return $FALSE if not $current_token;
88 2 50       12 return $FALSE if not $current_token->isa('PPI::Token::Word');
89 2 50       7 return $FALSE if $current_token->content() ne 'make_immutable';
90              
91 2         16 return $TRUE;
92             }
93 4         45 );
94              
95 4 100       131 return if $makes_immutable;
96 2         20 return $self->violation( $DESCRIPTION, $EXPLANATION, $document );
97             }
98              
99             1;
100              
101             # ABSTRACT: Ensure that you've made your Moose code fast
102              
103             __END__
104              
105             =pod
106              
107             =head1 NAME
108              
109             Perl::Critic::Policy::Moose::RequireMakeImmutable - Ensure that you've made your Moose code fast
110              
111             =head1 VERSION
112              
113             version 1.03
114              
115             =head1 DESCRIPTION
116              
117             L<Moose> is very flexible. That flexibility comes at a performance cost. You
118             can ameliorate some of that cost by telling Moose when you are done putting
119             your classes together.
120              
121             Thus, if you C<use Moose>, this policy requires that you do
122             C<< __PACKAGE__->meta()->make_immutable() >>.
123              
124             =head1 AFFILIATION
125              
126             This policy is part of L<Perl::Critic::Moose>.
127              
128             =head1 CONFIGURATION
129              
130             There is a single option, C<equivalent_modules>. This allows you to specify
131             modules that should be treated the same as L<Moose> and L<Moose::Role>, if,
132             say, you were doing something with L<Moose::Exporter>. For example, if you
133             were to have this in your F<.perlcriticrc> file:
134              
135             [Moose::RequireMakeImmutable]
136             equivalent_modules = MyCompany::Moose MooseX::NewThing
137              
138             then the following code would result in a violation:
139              
140             package Baz;
141              
142             use MyCompany::Moose;
143              
144             sub new {
145             ...
146             }
147              
148             # no make_immutable call
149              
150             =head1 AUTHORS
151              
152             =over 4
153              
154             =item *
155              
156             Elliot Shank <perl@galumph.com>
157              
158             =item *
159              
160             Dave Rolsky <autarch@urth.org>
161              
162             =back
163              
164             =head1 COPYRIGHT AND LICENSE
165              
166             This software is copyright (c) 2008 - 2015 by Elliot Shank.
167              
168             This is free software; you can redistribute it and/or modify it under
169             the same terms as the Perl 5 programming language system itself.
170              
171             =cut