File Coverage

blib/lib/Perl/Critic/Policy/Plicease/ProhibitUnicodeDigitInRegexp.pm
Criterion Covered Total %
statement 36 37 97.3
branch 6 6 100.0
condition n/a
subroutine 12 13 92.3
pod 4 5 80.0
total 58 61 95.0


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Plicease::ProhibitUnicodeDigitInRegexp;
2              
3 3     3   2152 use strict;
  3         7  
  3         106  
4 3     3   18 use warnings;
  3         7  
  3         70  
5 3     3   51 use 5.008001;
  3         11  
6 3     3   17 use Perl::Critic::Utils qw( $SEVERITY_LOW );
  3         7  
  3         275  
7 3     3   1124 use PPIx::Regexp;
  3         274111  
  3         124  
8 3     3   25 use base qw( Perl::Critic::Policy );
  3         8  
  3         350  
9              
10             # ABSTRACT: Prohibit non-ASCII \d in regular expressions
11             our $VERSION = '0.02'; # VERSION
12              
13              
14 3     3   22 use constant DESC => 'Using non-ASCII \d';
  3         7  
  3         213  
15 3         685 use constant EXPL => 'The character class \d matches non-ASCI unicode digits. ' .
16 3     3   31 'Use [0-9] or the /a modifier (Perl 5.14+) instead.';
  3         7  
17              
18 10     10 0 47918 sub supported_parameters { () }
19 8     8 1 95 sub default_severity { $SEVERITY_LOW }
20 0     0 1 0 sub default_themes { () }
21 10     10 1 57056 sub applies_to { return ('PPI::Token::Regexp::Match',
22             'PPI::Token::Regexp::Substitute',
23             'PPI::Token::QuoteLike::Regexp') }
24              
25             sub violates
26             {
27 11     11 1 906 my($self, $elem) = @_;
28              
29 11         50 my %mods = $elem->get_modifiers();
30              
31             # if the whole expression uses /a then we are in the clear.
32 11 100       168 return if $mods{'a'};
33              
34 10         31 my $re = PPIx::Regexp->new($elem->content);
35 10         22544 my $ccs = $re->find('PPIx::Regexp::Token::CharClass');
36 10 100       1820 return unless $ccs;
37 9         29 foreach my $cc (@$ccs)
38             {
39 9 100       30 next if $cc->content ne '\\d';
40 8         66 return $self->violation( DESC, EXPL, $elem );
41             }
42              
43 1         10 return;
44             }
45              
46             1;
47              
48             __END__
49              
50             =pod
51              
52             =encoding UTF-8
53              
54             =head1 NAME
55              
56             Perl::Critic::Policy::Plicease::ProhibitUnicodeDigitInRegexp - Prohibit non-ASCII \d in regular expressions
57              
58             =head1 VERSION
59              
60             version 0.02
61              
62             =head1 DESCRIPTION
63              
64             The character class C<\d> in a regular expression matches all unicode digit character, which
65             might not be what you expect if you are testing if a string can be used as a number in Perl.
66             Instead use either C<[0-9]>, or if you are on Perl 5.14 or better you can use the C</a>
67             modifier.
68              
69             /\d/; # not ok
70             /\d/a; # ok
71              
72             =head1 AFFILIATION
73              
74             None.
75              
76             =head1 CONFIGURATION
77              
78             This policy is not configurable except for the standard options.
79              
80             =head1 CAVEATS
81              
82             This is a policy that should not be applied toward all applications without some thought.
83             This is generally true for all L<Perl::Critic> policies, but especially so for this policy.
84              
85             In the general the ability to match against unicode digits is a useful ability, and doesn't
86             constitute bad code. Some applications don't ever need to match non-ASCII digit characters,
87             and incorrectly rely on C<\d> to validate as a number.
88              
89             This policy doesn't take into account using the L<re> pragma.
90              
91             use re '/a';
92              
93             /\d/; # (still) not ok
94              
95             =head1 AUTHOR
96              
97             Graham Ollis <plicease@cpan.org>
98              
99             =head1 COPYRIGHT AND LICENSE
100              
101             This software is copyright (c) 2019 by Graham Ollis.
102              
103             This is free software; you can redistribute it and/or modify it under
104             the same terms as the Perl 5 programming language system itself.
105              
106             =cut