Login
Missed RegularExpressions::ProhibitCaptureWithoutTest in earlier bugs
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / RegularExpressions / ProhibitCaptureWithoutTest.pm
CommitLineData
6036a254 1##############################################################################
876c81c6
CD
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6036a254 6##############################################################################
876c81c6
CD
7
8package Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest;
9
df6dee2b 10use 5.006001;
876c81c6
CD
11use strict;
12use warnings;
c680a9c9
ES
13use Readonly;
14
bbf4108c 15use Perl::Critic::Utils qw{ :severities };
876c81c6
CD
16use base 'Perl::Critic::Policy';
17
173667ce 18our $VERSION = '1.093_01';
876c81c6 19
6036a254 20#-----------------------------------------------------------------------------
876c81c6 21
c680a9c9
ES
22Readonly::Scalar my $DESC => q{Capture variable used outside conditional};
23Readonly::Scalar my $EXPL => [ 253 ];
876c81c6 24
6036a254 25#-----------------------------------------------------------------------------
876c81c6 26
c680a9c9
ES
27sub supported_parameters { return () }
28sub default_severity { return $SEVERITY_MEDIUM }
29sub default_themes { return qw(core pbp maintenance) }
30sub applies_to { return 'PPI::Token::Magic' }
876c81c6 31
6036a254 32#-----------------------------------------------------------------------------
876c81c6
CD
33
34sub violates {
35 my ($self, $elem, $doc) = @_;
a0dcf06f 36 return if $elem !~ m/\A \$[1-9] \z/xms;
c01e66ae 37 return if _is_in_conditional_expression($elem);
8ba78a18 38 return if _is_in_conditional_structure($elem);
c680a9c9 39 return $self->violation( $DESC, $EXPL, $elem );
876c81c6
CD
40}
41
c01e66ae
CD
42sub _is_in_conditional_expression {
43 my $elem = shift;
876c81c6 44
c01e66ae 45 # simplistic check: is there one of qw(&& || ?) between a match and the capture var?
876c81c6
CD
46 my $psib = $elem->sprevious_sibling;
47 while ($psib) {
c01e66ae
CD
48 if ($psib->isa('PPI::Token::Operator')) {
49 my $op = $psib->content;
50 if ($op eq q{&&} || $op eq q{||} || $op eq q{?}) {
51 $psib = $psib->sprevious_sibling;
52 while ($psib) {
53 return 1 if ($psib->isa('PPI::Token::Regexp::Match'));
54 return 1 if ($psib->isa('PPI::Token::Regexp::Substitute'));
55 $psib = $psib->sprevious_sibling;
56 }
57 return; # false
58 }
59 }
60 $psib = $psib->sprevious_sibling;
61 }
62
63 return; # false
64}
65
66sub _is_in_conditional_structure {
8ba78a18
CD
67 my $elem = shift;
68
69 my $stmt = $elem->statement();
70 while ($stmt && $elem->isa('PPI::Statement::Expression')) {
73260b2a 71 #return if _is_in_conditional_expression($stmt);
8ba78a18
CD
72 $stmt = $stmt->statement();
73 }
74 return if !$stmt;
c01e66ae
CD
75
76 # Check if any previous statements in the same scope have regexp matches
77 my $psib = $stmt->sprevious_sibling;
78 while ($psib) {
876c81c6
CD
79 if ($psib->isa('PPI::Node')) { # skip tokens
80 return if $psib->find_any('PPI::Token::Regexp::Match'); # fail
81 return if $psib->find_any('PPI::Token::Regexp::Substitute'); # fail
82 }
83 $psib = $psib->sprevious_sibling;
84 }
85
86 # Check for an enclosing 'if', 'unless', 'endif', or 'else'
c01e66ae 87 my $parent = $stmt->parent;
73260b2a 88 while ($parent) { # never false as long as we're inside a PPI::Document
eeb3524d 89 if ($parent->isa('PPI::Statement::Compound')) {
876c81c6
CD
90 return 1;
91 }
73260b2a
CD
92 elsif ($parent->isa('PPI::Structure')) {
93 return 1 if _is_in_conditional_expression($parent);
94 return 1 if _is_in_conditional_structure($parent);
95 $parent = $parent->parent;
96 }
97 else {
98 last;
99 }
876c81c6
CD
100 }
101
102 return; # fail
103}
104
1051;
106
6036a254 107#-----------------------------------------------------------------------------
876c81c6
CD
108
109__END__
110
111=pod
112
113=head1 NAME
114
2bd06403 115Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest - Capture variable used outside conditional.
876c81c6 116
11f53956 117
af93c316
ES
118=head1 AFFILIATION
119
11f53956
ES
120This Policy is part of the core L<Perl::Critic|Perl::Critic>
121distribution.
af93c316
ES
122
123
876c81c6
CD
124=head1 DESCRIPTION
125
126If a regexp match fails, then any capture variables (C<$1>, C<$2>,
127...) will be undefined. Therefore it's important to check the return
128value of a match before using those variables.
129
11f53956
ES
130This policy checks that capture variables are inside a conditional and
131do not follow an regexps.
876c81c6
CD
132
133This policy does not check whether that conditional is actually
134testing a regexp result, nor does it check whether a regexp actually
135has a capture in it. Those checks are too hard.
136
0cb729f0
ES
137
138=head1 CONFIGURATION
139
49860482 140This Policy is not configurable except for the standard options.
0cb729f0
ES
141
142
256264a0
ES
143=head1 BUGS
144
145Needs to allow this construct:
146
147 for ( ... ) {
148 next unless /(....)/;
149 if ( $1 ) {
150 ....
151 }
152 }
153
154Right now, Perl::Critic thinks that the C<$1> isn't legal to use
155because it's "outside" of the match. The thing is, we can only get to
156the C<if> if the regex matched.
157
158 while ( $str =~ /(expression)/ )
159
160
876c81c6
CD
161=head1 AUTHOR
162
163Chris Dolan <cdolan@cpan.org>
164
11f53956 165
876c81c6
CD
166=head1 COPYRIGHT
167
168Copyright (C) 2006 Chris Dolan. All rights reserved.
169
170This program is free software; you can redistribute it and/or modify
171it under the same terms as Perl itself.
172
173=cut
737d3b65
CD
174
175# Local Variables:
176# mode: cperl
177# cperl-indent-level: 4
178# fill-column: 78
179# indent-tabs-mode: nil
180# c-indentation-style: bsd
181# End:
96fed375 182# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :