vcs.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.pm

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