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   27665 use 5.010001;
  40         192  
4 40     40   278 use strict;
  40         136  
  40         874  
5 40     40   231 use warnings;
  40         127  
  40         1352  
6 40     40   286 use English qw(-no_match_vars);
  40         135  
  40         446  
7 40     40   16946 use Readonly;
  40         123  
  40         2106  
8              
9 40     40   345 use Perl::Critic::Utils qw< :characters :severities :classification hashify >;
  40         126  
  40         2235  
10              
11 40     40   20910 use parent 'Perl::Critic::Policy';
  40         131  
  40         311  
12              
13             our $VERSION = '1.148';
14              
15             #-----------------------------------------------------------------------------
16              
17             Readonly::Scalar my $EXPL => [99];
18              
19             #-----------------------------------------------------------------------------
20              
21 149     149 0 2083 sub supported_parameters { return qw< > }
22 134     134 1 623 sub default_severity { return $SEVERITY_MEDIUM }
23 86     86 1 446 sub default_themes { return qw( core maintenance pbp ) }
24 90     90 1 314 sub applies_to { return 'PPI::Token::Word' }
25              
26             #-----------------------------------------------------------------------------
27              
28             sub violates {
29 824     824 1 1699 my ( $self, $token, undef ) = @_;
30              
31 824 100 100     1787 return if $token->content() ne 'until' && $token->content() ne 'unless';
32              
33 78 50       736 return if is_hash_key($token);
34 78 50       257 return if is_subroutine_name($token);
35 78 50       264 return if is_method_call($token);
36 78 50       617 return if is_included_module_name($token);
37              
38             return
39             map
40 78         270 { $self->_violation_for_operator( $_, $token ) }
  60         186  
41             _get_negative_operators( $token );
42             }
43              
44             #-----------------------------------------------------------------------------
45              
46             sub _get_negative_operators {
47 78     78   189 my ($token) = @_;
48              
49 78         167 my @operators;
50 78         251 foreach my $element ( _get_condition_elements($token) ) {
51 164 100       811 if ( $element->isa('PPI::Node') ) {
52 32         149 my $operators = $element->find( \&_is_negative_operator );
53 32 100       486 if ($operators) {
54 30         58 push @operators, @{$operators};
  30         103  
55             }
56             }
57             else {
58 132 100       315 if ( _is_negative_operator( undef, $element ) ) {
59 30         524 push @operators, $element;
60             }
61             }
62             }
63              
64 78         260 return @operators;
65             }
66              
67             #-----------------------------------------------------------------------------
68              
69             sub _get_condition_elements {
70 78     78   184 my ($token) = @_;
71              
72 78         220 my $statement = $token->statement();
73 78 50       1131 return if not $statement;
74              
75 78 100       322 if ($statement->isa('PPI::Statement::Compound')) {
76 32         110 my $condition = $token->snext_sibling();
77              
78 32 50       713 return if not $condition;
79 32 50       156 return if not $condition->isa('PPI::Structure::Condition');
80              
81 32         114 return ( $condition );
82             }
83              
84 46         148 my @condition_elements;
85 46         109 my $element = $token;
86 46   100     158 while (
87             $element = $element->snext_sibling()
88             and $element->content() ne $SCOLON
89             ) {
90 132         4184 push @condition_elements, $element;
91             }
92              
93 46         1575 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   3058 my (undef, $element) = @_;
109              
110             return
111             $element->isa('PPI::Token::Operator')
112 322   66     1646 && $NEGATIVE_OPERATORS{$element};
113             }
114              
115             #-----------------------------------------------------------------------------
116              
117             sub _violation_for_operator {
118 60     60   153 my ($self, $operator, $control_structure) = @_;
119              
120             return
121 60         209 $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 :