File Coverage

blib/lib/Perl/Critic/Policy/Moose/ProhibitNewMethod.pm
Criterion Covered Total %
statement 39 40 97.5
branch 8 8 100.0
condition n/a
subroutine 13 14 92.8
pod 5 6 83.3
total 65 68 95.5


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Moose::ProhibitNewMethod;
2              
3 1     1   919 use strict;
  1         2  
  1         50  
4 1     1   8 use warnings;
  1         2  
  1         64  
5              
6             our $VERSION = '1.03';
7              
8 1     1   8 use Readonly ();
  1         1  
  1         41  
9              
10 1     1   7 use Perl::Critic::Utils qw< :booleans :severities >;
  1         2  
  1         103  
11 1     1   257 use Perl::Critic::Utils::PPI qw< is_ppi_generic_statement >;
  1         2  
  1         80  
12              
13 1     1   7 use base 'Perl::Critic::Policy';
  1         3  
  1         671  
14              
15             Readonly::Scalar my $DESCRIPTION =>
16             q<"new" method/subroutine declared in a Moose class.>;
17             Readonly::Scalar my $EXPLANATION =>
18             q<Use BUILDARGS and BUILD instead of writing your own constructor.>;
19              
20             sub supported_parameters {
21             return (
22             {
23 6     6 0 21832 name => 'equivalent_modules',
24             description =>
25             q<The additional modules to treat as equivalent to "Moose", "Moose::Role", or "MooseX::Role::Parameterized".>,
26             default_string => 'Moose Moose::Role MooseX::Role::Parameterized',
27             behavior => 'string list',
28             list_always_present_values => [qw< Moose Moose::Role MooseX::Role::Parameterized >],
29             },
30             );
31             }
32              
33 3     3 1 31 sub default_severity { return $SEVERITY_HIGH; }
34 0     0 1 0 sub default_themes { return qw< moose bugs >; }
35 6     6 1 282 sub applies_to { return 'PPI::Document' }
36              
37             sub prepare_to_scan_document {
38 6     6 1 35031 my ( $self, $document ) = @_;
39              
40 6         21 return $self->_is_interesting_document($document);
41             }
42              
43             sub _is_interesting_document {
44 13     13   15 my ( $self, $document ) = @_;
45              
46 13         19 foreach my $module ( keys %{ $self->{_equivalent_modules} } ) {
  13         40  
47 27 100       1815 return $TRUE if $document->uses_module($module);
48             }
49              
50 1         9 return $FALSE;
51             }
52              
53             sub violates {
54 6     6 1 59 my ( $self, undef, $document ) = @_;
55              
56 6         9 my @violations;
57 6         22 foreach my $namespace ( $document->namespaces() ) {
58             SUBDOCUMENT:
59 7         8870 foreach my $subdocument (
60             $document->subdocuments_for_namespace($namespace) ) {
61             next SUBDOCUMENT
62 7 100       79 if not $self->_is_interesting_document($subdocument);
63              
64 6 100       2353 if ( my $destructor
65             = $subdocument->find_first( \&_is_constructor ) ) {
66 3         94 push
67             @violations,
68             $self->violation(
69             $DESCRIPTION, $EXPLANATION,
70             $destructor
71             );
72             }
73             }
74             }
75              
76 6         498 return @violations;
77             }
78              
79             sub _is_constructor {
80 131     131   930 my ( undef, $element ) = @_;
81              
82 131 100       476 return $FALSE if not $element->isa('PPI::Statement::Sub');
83              
84 4         15 return $element->name() eq 'new';
85             }
86              
87             1;
88              
89             # ABSTRACT: Don't override Moose's standard constructors.
90              
91             __END__
92              
93             =pod
94              
95             =head1 NAME
96              
97             Perl::Critic::Policy::Moose::ProhibitNewMethod - Don't override Moose's standard constructors.
98              
99             =head1 VERSION
100              
101             version 1.03
102              
103             =head1 DESCRIPTION
104              
105             Overriding C<new()> on a L<Moose> class causes a number of problems, including
106             speed issues and problems with order of invocation of constructors when
107             multiple inheritance is involved. Use C<BUILDARGS()> and C<BUILD()> instead.
108              
109             =head1 AFFILIATION
110              
111             This policy is part of L<Perl::Critic::Moose>.
112              
113             =head1 CONFIGURATION
114              
115             There is a single option, C<equivalent_modules>. This allows you to specify
116             modules that should be treated the same as L<Moose> and L<Moose::Role>, if,
117             say, you were doing something with L<Moose::Exporter>. For example, if you
118             were to have this in your F<.perlcriticrc> file:
119              
120             [Moose::ProhibitNewMethod]
121             equivalent_modules = MyCompany::Moose MooseX::NewThing
122              
123             then the following code would result in a violation:
124              
125             package Baz;
126              
127             use MyCompany::Moose;
128              
129             sub new {
130             ...
131             }
132              
133             =head1 SEE ALSO
134              
135             =over 4
136              
137             =item * L<Moose::Manual::Construction>
138              
139             =item * L<Moose::Manual::BestPractices>
140              
141             =back
142              
143             =head1 AUTHORS
144              
145             =over 4
146              
147             =item *
148              
149             Elliot Shank <perl@galumph.com>
150              
151             =item *
152              
153             Dave Rolsky <autarch@urth.org>
154              
155             =back
156              
157             =head1 COPYRIGHT AND LICENSE
158              
159             This software is copyright (c) 2008 - 2015 by Elliot Shank.
160              
161             This is free software; you can redistribute it and/or modify it under
162             the same terms as the Perl 5 programming language system itself.
163              
164             =cut