File Coverage

blib/lib/Perl/Critic/Policy/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.pm
Criterion Covered Total %
statement 60 60 100.0
branch 17 24 70.8
condition 8 9 88.8
subroutine 16 16 100.0
pod 4 5 80.0
total 105 114 92.1


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions;
2              
3 40     40   28310 use 5.010001;
  40         211  
4 40     40   246 use strict;
  40         133  
  40         850  
5 40     40   227 use warnings;
  40         118  
  40         1148  
6 40     40   295 use English qw(-no_match_vars);
  40         121  
  40         425  
7 40     40   17254 use Readonly;
  40         128  
  40         2088  
8              
9 40     40   305 use Perl::Critic::Utils qw< :characters :severities :classification hashify >;
  40         134  
  40         1976  
10              
11 40     40   20705 use parent 'Perl::Critic::Policy';
  40         174  
  40         290  
12              
13             our $VERSION = '1.146';
14              
15             #-----------------------------------------------------------------------------
16              
17             Readonly::Scalar my $EXPL => [99];
18              
19             #-----------------------------------------------------------------------------
20              
21 149     149 0 1945 sub supported_parameters { return qw< > }
22 134     134 1 564 sub default_severity { return $SEVERITY_MEDIUM }
23 86     86 1 367 sub default_themes { return qw( core maintenance pbp ) }
24 90     90 1 345 sub applies_to { return 'PPI::Token::Word' }
25              
26             #-----------------------------------------------------------------------------
27              
28             sub violates {
29 824     824 1 1851 my ( $self, $token, undef ) = @_;
30              
31 824 100 100     1895 return if $token->content() ne 'until' && $token->content() ne 'unless';
32              
33 78 50       711 return if is_hash_key($token);
34 78 50       245 return if is_subroutine_name($token);
35 78 50       264 return if is_method_call($token);
36 78 50       633 return if is_included_module_name($token);
37              
38             return
39             map
40 78         262 { $self->_violation_for_operator( $_, $token ) }
  60         177  
41             _get_negative_operators( $token );
42             }
43              
44             #-----------------------------------------------------------------------------
45              
46             sub _get_negative_operators {
47 78     78   189 my ($token) = @_;
48              
49 78         172 my @operators;
50 78         223 foreach my $element ( _get_condition_elements($token) ) {
51 164 100       768 if ( $element->isa('PPI::Node') ) {
52 32         147 my $operators = $element->find( \&_is_negative_operator );
53 32 100       464 if ($operators) {
54 30         71 push @operators, @{$operators};
  30         103  
55             }
56             }
57             else {
58 132 100       335 if ( _is_negative_operator( undef, $element ) ) {
59 30         570 push @operators, $element;
60             }
61             }
62             }
63              
64 78         254 return @operators;
65             }
66              
67             #-----------------------------------------------------------------------------
68              
69             sub _get_condition_elements {
70 78     78   172 my ($token) = @_;
71              
72 78         225 my $statement = $token->statement();
73 78 50       1145 return if not $statement;
74              
75 78 100       330 if ($statement->isa('PPI::Statement::Compound')) {
76 32         97 my $condition = $token->snext_sibling();
77              
78 32 50       726 return if not $condition;
79 32 50       136 return if not $condition->isa('PPI::Structure::Condition');
80              
81 32         108 return ( $condition );
82             }
83              
84 46         94 my @condition_elements;
85 46         128 my $element = $token;
86 46   100     149 while (
87             $element = $element->snext_sibling()
88             and $element->content() ne $SCOLON
89             ) {
90 132         4169 push @condition_elements, $element;
91             }
92              
93 46         1472 return @condition_elements;
94             }
95              
96             #-----------------------------------------------------------------------------
97              
98             Readonly::Hash my %NEGATIVE_OPERATORS => hashify(
99             qw/
100             ! not
101             !~ ne !=
102             < > <= >= <=>
103             lt gt le ge cmp
104             /
105             );
106              
107             sub _is_negative_operator {
108 322     322   4428 my (undef, $element) = @_;
109              
110             return
111             $element->isa('PPI::Token::Operator')
112 322   66     1492 && $NEGATIVE_OPERATORS{$element};
113             }
114              
115             #-----------------------------------------------------------------------------
116              
117             sub _violation_for_operator {
118 60     60   156 my ($self, $operator, $control_structure) = @_;
119              
120             return
121 60         219 $self->violation(
122             qq<Found "$operator" in condition for an "$control_structure">,
123             $EXPL,
124             $control_structure,
125             );
126             }
127              
128             1;
129              
130             #-----------------------------------------------------------------------------
131              
132             __END__
133              
134             =pod
135              
136             =for stopwords
137              
138             =head1 NAME
139              
140             Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions - Don't use operators like C<not>, C<!~>, and C<le> within C<until> and C<unless>.
141              
142             =head1 AFFILIATION
143              
144             This Policy is part of the core L<Perl::Critic|Perl::Critic>
145             distribution.
146              
147              
148             =head1 DESCRIPTION
149              
150             until ($foo ne 'blah') { #not ok
151             ...
152             }
153              
154             while ($foo eq 'blah') { #ok
155             ...
156             }
157              
158             A number of people have problems figuring out the meaning of doubly
159             negated expressions. C<unless> and C<until> are both negative
160             constructs, so any negative (e.g. C<!~>) or reversible operators (e.g.
161             C<le>) included in their conditional expressions are double negations.
162             Conway considers the following operators to be difficult to understand
163             within C<unless> and C<until>:
164              
165             ! not
166             !~ ne !=
167             < > <= >= <=>
168             lt gt le ge cmp
169              
170              
171              
172             =head1 CONFIGURATION
173              
174             This Policy is not configurable except for the standard options.
175              
176              
177             =head1 SEE ALSO
178              
179             L<Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks|Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks>
180              
181             =head1 AUTHOR
182              
183             Elliot Shank C<< <perl@galumph.com> >>
184              
185             =head1 COPYRIGHT
186              
187             Copyright (c) 2007-2011 Elliot Shank.
188              
189             This program is free software; you can redistribute it and/or modify
190             it under the same terms as Perl itself. The full text of this license
191             can be found in the LICENSE file included with this module.
192              
193             =cut
194              
195             # Local Variables:
196             # mode: cperl
197             # cperl-indent-level: 4
198             # fill-column: 78
199             # indent-tabs-mode: nil
200             # c-indentation-style: bsd
201             # End:
202             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :