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