File Coverage

blib/lib/Perl/Critic/Policy/Moose/ProhibitMultipleWiths.pm
Criterion Covered Total %
statement 47 48 97.9
branch 13 16 81.2
condition n/a
subroutine 13 14 92.8
pod 5 6 83.3
total 78 84 92.8


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Moose::ProhibitMultipleWiths;
2              
3 1     1   857 use strict;
  1         2  
  1         40  
4 1     1   4 use warnings;
  1         1  
  1         42  
5              
6             our $VERSION = '1.03';
7              
8 1     1   4 use Readonly ();
  1         1  
  1         22  
9              
10 1     1   5 use Perl::Critic::Utils qw< :booleans :severities $EMPTY >;
  1         1  
  1         88  
11 1     1   243 use Perl::Critic::Utils::PPI qw< is_ppi_generic_statement >;
  1         2  
  1         73  
12              
13 1     1   6 use base 'Perl::Critic::Policy';
  1         2  
  1         634  
14              
15             Readonly::Scalar my $DESCRIPTION => 'Multiple calls to with() were made.';
16             Readonly::Scalar my $EXPLANATION =>
17             q<Roles cannot protect against name conflicts if they are not composed.>;
18              
19             sub supported_parameters {
20             return (
21             {
22 13     13 0 42581 name => 'equivalent_modules',
23             description =>
24             q<The additional modules to treat as equivalent to "Moose", "Moose::Role", or "MooseX::Role::Parameterized".>,
25             default_string => 'Moose Moose::Role MooseX::Role::Parameterized',
26             behavior => 'string list',
27             list_always_present_values => [qw< Moose Moose::Role MooseX::Role::Parameterized >],
28             },
29             );
30             }
31              
32 5     5 1 59 sub default_severity { return $SEVERITY_HIGH; }
33 0     0 1 0 sub default_themes { return qw( bugs moose roles ); }
34 12     12 1 828 sub applies_to { return 'PPI::Document' }
35              
36             sub prepare_to_scan_document {
37 13     13 1 79975 my ( $self, $document ) = @_;
38              
39 13         58 return $self->_is_interesting_document($document);
40             }
41              
42             sub _is_interesting_document {
43 28     28   42 my ( $self, $document ) = @_;
44              
45 28         47 foreach my $module ( keys %{ $self->{_equivalent_modules} } ) {
  28         122  
46 43 100       5905 return $TRUE if $document->uses_module($module);
47             }
48              
49 2         23 return $FALSE;
50             }
51              
52             sub violates {
53 12     12 1 126 my ( $self, undef, $document ) = @_;
54              
55 12         19 my @violations;
56 12         51 foreach my $namespace ( $document->namespaces() ) {
57             SUBDOCUMENT:
58 15         20201 foreach my $subdocument (
59             $document->subdocuments_for_namespace($namespace) ) {
60             next SUBDOCUMENT
61 15 100       179 if not $self->_is_interesting_document($subdocument);
62              
63 14         5283 my $with_statements = $subdocument->find( \&_is_with_statement );
64              
65 14 100       261 next SUBDOCUMENT if not $with_statements;
66 13 100       15 next SUBDOCUMENT if @{$with_statements} < 2;
  13         67  
67              
68 5         11 my $second_with = $with_statements->[1];
69 5         32 push
70             @violations,
71             $self->violation( $DESCRIPTION, $EXPLANATION, $second_with );
72             }
73             }
74              
75 12         775 return @violations;
76             }
77              
78             sub _is_with_statement {
79 305     305   4539 my ( undef, $element ) = @_;
80              
81 305 100       782 return $FALSE if not is_ppi_generic_statement($element);
82              
83 18         161 my $current_token = $element->schild(0);
84 18 50       208 return $FALSE if not $current_token;
85 18 50       65 return $FALSE if not $current_token->isa('PPI::Token::Word');
86 18 50       52 return $FALSE if $current_token->content() ne 'with';
87              
88 18         105 return $TRUE;
89             }
90              
91             1;
92              
93             # ABSTRACT: Require role composition
94              
95             __END__
96              
97             =pod
98              
99             =head1 NAME
100              
101             Perl::Critic::Policy::Moose::ProhibitMultipleWiths - Require role composition
102              
103             =head1 VERSION
104              
105             version 1.03
106              
107             =head1 DESCRIPTION
108              
109             L<Moose::Role>s are, among other things, the answer to name conflicts plaguing
110             multiple inheritance and mix-ins. However, to enjoy this protection, you must
111             compose your roles together. Roles do not generate conflicts if they are
112             consumed individually.
113              
114             Pass all of your roles to a single L<with|Moose/with> statement.
115              
116             # ok
117             package Foo;
118              
119             use Moose::Role;
120              
121             with qw< Bar Baz >;
122              
123             # not ok
124             package Foo;
125              
126             use Moose::Role;
127              
128             with 'Bar';
129             with 'Baz';
130              
131             =head1 AFFILIATION
132              
133             This policy is part of L<Perl::Critic::Moose>.
134              
135             =head1 CONFIGURATION
136              
137             There is a single option, C<equivalent_modules>. This allows you to specify
138             modules that should be treated the same as L<Moose> and L<Moose::Role>, if,
139             say, you were doing something with L<Moose::Exporter>. For example, if you
140             were to have this in your F<.perlcriticrc> file:
141              
142             [Moose::ProhibitMultipleWiths]
143             equivalent_modules = MyCompany::Moose MooseX::NewThing
144              
145             then the following code would result in a violation:
146              
147             package Baz;
148              
149             use MyCompany::Moose;
150              
151             with 'Bing';
152             with 'Bong';
153              
154             =head1 AUTHORS
155              
156             =over 4
157              
158             =item *
159              
160             Elliot Shank <perl@galumph.com>
161              
162             =item *
163              
164             Dave Rolsky <autarch@urth.org>
165              
166             =back
167              
168             =head1 COPYRIGHT AND LICENSE
169              
170             This software is copyright (c) 2008 - 2015 by Elliot Shank.
171              
172             This is free software; you can redistribute it and/or modify it under
173             the same terms as the Perl 5 programming language system itself.
174              
175             =cut