File Coverage

blib/lib/Perl/Critic/Policy/Lax/RequireConstantOnLeftSideOfEquality/ExceptEq.pm
Criterion Covered Total %
statement 34 35 97.1
branch 7 10 70.0
condition 4 7 57.1
subroutine 11 12 91.6
pod 4 5 80.0
total 60 69 86.9


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Lax::RequireConstantOnLeftSideOfEquality::ExceptEq 0.014;
2              
3 7     7   7640 use utf8;
  7         91  
  7         32  
4 7     7   332 use strict;
  7         19  
  7         148  
5 7     7   31 use warnings;
  7         45  
  7         171  
6              
7 7     7   31 use Readonly;
  7         14  
  7         285  
8              
9 7     7   35 use Perl::Critic::Utils qw{ :severities };
  7         14  
  7         304  
10 7     7   685 use parent qw(Perl::Critic::Policy);
  7         14  
  7         31  
11              
12             Readonly::Scalar my $DESC => q{Constant value on right side of equality};
13             Readonly::Scalar my $EXPL =>
14             q{Putting the constant on the left exposes typos};
15              
16             #-----------------------------------------------------------------------------
17              
18 6     6 0 25952 sub supported_parameters { return () }
19 3     3 1 36 sub default_severity { return $SEVERITY_LOW }
20 0     0 1 0 sub default_themes { return qw(more) }
21 6     6 1 36886 sub applies_to { return qw(PPI::Token::Operator) }
22              
23             #-----------------------------------------------------------------------------
24              
25             sub violates {
26 6     6 1 119 my ( $self, $elem, undef ) = @_;
27 6 50       23 return if !( q<==> eq $elem );
28              
29 6   50     107 my $right_sib = $elem->snext_sibling() || return;
30 6   50     166 my $left_sib = $elem->sprevious_sibling() || return;
31              
32 6 100 66     139 if ( !_is_constant_like($left_sib) && _is_constant_like($right_sib) ) {
33 3         14 return $self->violation( $DESC, $EXPL, $right_sib );
34             }
35              
36 3 50       10 if($left_sib ne '1') {
37 3         51 1;
38             }
39              
40 3         9 return; # ok!
41             }
42              
43             #-----------------------------------------------------------------------------
44              
45             sub _is_constant_like {
46 9     9   14 my $elem = shift;
47 9 100       39 return 1 if $elem->isa('PPI::Token::Number');
48 3 50       13 return 1 if $elem->isa('PPI::Token::Quote');
49 3         11 return 0;
50             }
51              
52             1;
53              
54             =pod
55              
56             =encoding UTF-8
57              
58             =head1 NAME
59              
60             Perl::Critic::Policy::Lax::RequireConstantOnLeftSideOfEquality::ExceptEq - constant value on the right side is ok with 'eq'
61              
62             =head1 VERSION
63              
64             version 0.014
65              
66             =head1 DESCRIPTION
67              
68             This policy behaves like Perl::Critic::Policy::ValuesAndExpressions::RequireConstantOnLeftSideOfEquality,
69             but allows constant value on the right side of an equality with the operator 'eq'.
70              
71             =head1 PERL VERSION
72              
73             This library should run on perls released even a long time ago. It should work
74             on any version of perl released in the last five years.
75              
76             Although it may work on older versions of perl, no guarantee is made that the
77             minimum required version will not be increased. The version may be increased
78             for any reason, and there is no promise that patches will be accepted to lower
79             the minimum required perl.
80              
81             =head1 NAME
82              
83             Perl::Critic::Policy::Lax::RequireConstantOnLeftSideOfEquality::ExceptEq - constant value on the right side is ok with 'eq'
84              
85             =head1 AUTHOR
86              
87             Ricardo Signes <cpan@semiotic.systems>
88              
89             =head1 COPYRIGHT AND LICENSE
90              
91             This software is copyright (c) 2022 by Ricardo Signes <cpan@semiotic.systems>.
92              
93             This is free software; you can redistribute it and/or modify it under
94             the same terms as the Perl 5 programming language system itself.
95              
96             =cut
97              
98             __END__
99              
100             # ABSTRACT: constant value on the right side is ok with 'eq'
101              
102             #pod =pod
103             #pod
104             #pod =encoding UTF-8
105             #pod
106             #pod =head1 NAME
107             #pod
108             #pod Perl::Critic::Policy::Lax::RequireConstantOnLeftSideOfEquality::ExceptEq - constant value on the right side is ok with 'eq'
109             #pod
110             #pod =head1 DESCRIPTION
111             #pod
112             #pod This policy behaves like Perl::Critic::Policy::ValuesAndExpressions::RequireConstantOnLeftSideOfEquality,
113             #pod but allows constant value on the right side of an equality with the operator 'eq'.
114             #pod
115             #pod =cut