File Coverage

blib/lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm
Criterion Covered Total %
statement 31 33 93.9
branch 2 4 50.0
condition n/a
subroutine 12 12 100.0
pod 5 6 83.3
total 50 55 90.9


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::RegularExpressions::ProhibitUnusualDelimiters;
2              
3 40     40   24903 use 5.010001;
  40         148  
4 40     40   198 use strict;
  40         108  
  40         760  
5 40     40   163 use warnings;
  40         65  
  40         1569  
6 40     40   159 use Readonly;
  40         71  
  40         2389  
7              
8 40     40   182 use Perl::Critic::Utils qw{ :booleans :severities hashify };
  40         96  
  40         2100  
9              
10 40     40   5714 use parent 'Perl::Critic::Policy';
  40         80  
  40         251  
11              
12             our $VERSION = '1.156';
13              
14             #-----------------------------------------------------------------------------
15              
16             Readonly::Scalar my $DESC => q<Use only '//' or '{}' to delimit regexps>;
17             Readonly::Scalar my $EXPL => [246];
18              
19             Readonly::Array my @EXTRA_BRACKETS => qw{ () [] <> };
20              
21             #-----------------------------------------------------------------------------
22              
23             sub supported_parameters {
24             return (
25             {
26 91     91 0 997 name => 'allow_all_brackets',
27             description =>
28             q[In addition to allowing '{}', allow '()', '[]', and '{}'.],
29             behavior => 'boolean',
30             },
31             );
32             }
33              
34 75     75 1 230 sub default_severity { return $SEVERITY_LOWEST }
35 84     84 1 267 sub default_themes { return qw( core pbp cosmetic ) }
36 31     31 1 118 sub applies_to { return qw(PPI::Token::Regexp::Match
37             PPI::Token::Regexp::Substitute
38             PPI::Token::QuoteLike::Regexp) }
39              
40             #-----------------------------------------------------------------------------
41              
42             sub initialize_if_enabled {
43 48     48 1 122 my ( $self, undef ) = @_;
44              
45 48         171 my %delimiters = hashify( qw< // {} > );
46 48 50       182 if ( $self->{_allow_all_brackets} ) {
47 0         0 @delimiters{ @EXTRA_BRACKETS } = (1) x @EXTRA_BRACKETS;
48             }
49              
50 48         172 $self->{_allowed_delimiters} = \%delimiters;
51              
52 48         144 return $TRUE;
53             }
54              
55             #-----------------------------------------------------------------------------
56              
57             sub violates {
58 1     1 1 3 my ( $self, $elem, undef ) = @_;
59              
60 1         3 my $allowed_delimiters = $self->{_allowed_delimiters};
61 1         7 foreach my $delimiter ($elem->get_delimiters()) {
62 1 50       25 next if $allowed_delimiters->{$delimiter};
63 0         0 return $self->violation( $DESC, $EXPL, $elem );
64             }
65              
66 1         3 return; # OK
67             }
68              
69             1;
70              
71             __END__
72              
73             #-----------------------------------------------------------------------------
74              
75             =pod
76              
77             =head1 NAME
78              
79             Perl::Critic::Policy::RegularExpressions::ProhibitUnusualDelimiters - Use only C<//> or C<{}> to delimit regexps.
80              
81              
82             =head1 AFFILIATION
83              
84             This Policy is part of the core L<Perl::Critic|Perl::Critic>
85             distribution.
86              
87              
88             =head1 DESCRIPTION
89              
90             Perl lets you delimit regular expressions with almost any character,
91             but most choices are illegible. Compare these equivalent expressions:
92              
93             s/foo/bar/; # good
94             s{foo}{bar}; # good
95             s#foo#bar#; # bad
96             s;foo;bar;; # worse
97             s|\|\||\||; # eye-gouging bad
98              
99              
100             =head1 CONFIGURATION
101              
102             There is one option for this policy, C<allow_all_brackets>. If this
103             is true, then, in addition to allowing C<//> and C<{}>, the other
104             matched pairs of C<()>, C<[]>, and C<< <> >> are allowed.
105              
106              
107             =head1 CREDITS
108              
109             Initial development of this policy was supported by a grant from the
110             Perl Foundation.
111              
112              
113             =head1 AUTHOR
114              
115             Chris Dolan <cdolan@cpan.org>
116              
117              
118             =head1 COPYRIGHT
119              
120             Copyright (c) 2007-2023 Chris Dolan
121              
122             This program is free software; you can redistribute it and/or modify
123             it under the same terms as Perl itself. The full text of this license
124             can be found in the LICENSE file included with this module
125              
126             =cut
127              
128             # Local Variables:
129             # mode: cperl
130             # cperl-indent-level: 4
131             # fill-column: 78
132             # indent-tabs-mode: nil
133             # c-indentation-style: bsd
134             # End:
135             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :