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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.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::ValuesAndExpressions::ProhibitMismatchedOperators;
   9 use 5.006001;
  10 use strict;
  11 use warnings;
  12 use Readonly;
  13
  14 use Perl::Critic::Utils qw{ :severities };
  15 use base 'Perl::Critic::Policy';
  16
  17 our $VERSION = '1.088';
  18
  19 #-----------------------------------------------------------------------------
  20
  21 Readonly::Scalar my $DESC => q{Mismatched operator};
  22 Readonly::Scalar my $EXPL => q{Numeric/string operators and operands should match};
  23
  24 # operator types
  25
  26 Readonly::Hash my %OP_TYPES => (
  27     # numeric
  28     (map { $_ => 0 } qw( == != > >= < <= + - * / += -= *= /= )),
  29     # string
  30     (map { $_ => 1 } qw( eq ne lt gt le ge . .= )),
  31 );
  32
  33 # token compatibility [ numeric, string ]
  34
  35 Readonly::Hash my %TOKEN_COMPAT => (
  36     'PPI::Token::Number' => [ 1, 0 ],
  37     'PPI::Token::Symbol' => [ 1, 1 ],
  38     'PPI::Token::Quote'  => [ 0, 1 ],
  39 );
  40
  41 #-----------------------------------------------------------------------------
  42
  43 sub supported_parameters { return ()                     }
  44 sub default_severity     { return $SEVERITY_MEDIUM       }
  45 sub default_themes       { return qw( core bugs )        }
  46 sub applies_to           { return 'PPI::Token::Operator' }
  47
  48 #-----------------------------------------------------------------------------
  49
  50 sub violates {
  51     my ( $self, $elem ) = @_;
  52
  53     my $elem_text = $elem->content;
  54
  55     return if !exists $OP_TYPES{$elem_text};
  56
  57     my $prev_elem = $elem->sprevious_sibling();
  58     return if not $prev_elem;
  59
  60     my $next_elem = $elem->snext_sibling();
  61     return if not $next_elem;
  62
  63     if ( $next_elem->isa('PPI::Token::Operator') ) {
  64         $elem_text .= $next_elem;
  65         $next_elem = $next_elem->snext_sibling();
  66     }
  67
  68     return if !exists $OP_TYPES{$elem_text};
  69     my $op_type = $OP_TYPES{$elem_text};
  70
  71     my $prev_compat = $self->_get_token_compat( $prev_elem );
  72     my $next_compat = $self->_get_token_compat( $next_elem );
  73
  74     return if ( !defined $prev_compat || $prev_compat->[$op_type] )
  75         && ( !defined $next_compat || $next_compat->[$op_type] );
  76
  77     return $self->violation( $DESC, $EXPL, $elem );
  78 }
  79
  80 #-----------------------------------------------------------------------------
  81
  82 # get token value compatibility
  83
  84 sub _get_token_compat {
  85     my ( $self, $elem ) = @_;
  86     for my $class ( keys %TOKEN_COMPAT ) {
  87         return $TOKEN_COMPAT{$class} if $elem->isa($class);
  88     }
  89     return;
  90 }
  91
  92 1;
  93
  94 __END__
  95
  96 #-----------------------------------------------------------------------------
  97
  98 =pod
  99
 100 =head1 NAME
 101
 102 Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators - Don't mix numeric operators with string operands, or vice-versa.
 103
 104 =head1 AFFILIATION
 105
 106 This Policy is part of the core L<Perl::Critic> distribution.
 107
 108
 109 =head1 DESCRIPTION
 110
 111 Using the wrong operator type for a value can obscure coding intent
 112 and possibly lead to subtle errors.  An example of this is mixing a
 113 string equality operator with a numeric value, or vice-versa.
 114
 115   if ($foo == 'bar') {}     #not ok
 116   if ($foo eq 'bar') {}     #ok
 117   if ($foo eq 123) {}       #not ok
 118   if ($foo == 123) {}       #ok
 119
 120
 121 =head1 CONFIGURATION
 122
 123 This Policy is not configurable except for the standard options.
 124
 125
 126 =head1 NOTES
 127
 128 If L<warnings> are enabled, the Perl interpreter usually warns you
 129 about using mismatched operators at run-time.  This Policy does
 130 essentially the same thing, but at author-time.  That way, you can
 131 find our about them sooner.
 132
 133 =head1 AUTHOR
 134
 135 Peter Guzis <pguzis@cpan.org>
 136
 137 =head1 COPYRIGHT
 138
 139 Copyright (c) 2006-2008 Peter Guzis.  All rights reserved.
 140
 141 This program is free software; you can redistribute it and/or modify
 142 it under the same terms as Perl itself.  The full text of this license
 143 can be found in the LICENSE file included with this module.
 144
 145 =cut
 146
 147 # Local Variables:
 148 #   mode: cperl
 149 #   cperl-indent-level: 4
 150 #   fill-column: 78
 151 #   indent-tabs-mode: nil
 152 #   c-indentation-style: bsd
 153 # End:
 154 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :