"Tom Wyant via RT" <bug-Perl-Critic@rt.cpan.org> writes:
Show quoted text>
> I can see behaving as
> though allow_all_brackets were on if the regexp contains both '/' and
> '{'.
I got as far as the few lines below. I think the concept is sound
enough. Think of it either as don't (implicitly) recommend usual
delimiters when they'd be worse than the unusual. Or conversely think
of it as don't prohibit something which is actually fairly reasonable in
the particular usage. Precisely when and by how much may have to worked
through.
Index: lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm
===================================================================
--- lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm (revision 4076)
+++ lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm (working copy)
@@ -68,6 +68,18 @@
my ( $self, $elem, undef ) = @_;
my $allowed_delimiters = $self->{_allowed_delimiters};
+
+ # If the regexp contains / and also either { or } then those "usual"
+ # delimiter choices are not very good. In this case automatically relax
+ # to allow_all_brackets, if that's not already enabled.
+ if (! $self->{_allow_all_brackets} ) {
+ my $body = $elem->get_match_string;
+ if ($body =~ m</> && $body =~ m<[{}]>) {
+ $allowed_delimiters = { %$allowed_delimiters,
+ map {$_=>1} @EXTRA_BRACKETS };
+ }
+ }
+
foreach my $delimiter ($elem->get_delimiters()) {
next if $allowed_delimiters->{$delimiter};
return $self->violation( $DESC, $EXPL, $elem );
@@ -106,14 +118,45 @@
s;foo;bar;; # worse
s|\|\||\||; # eye-gouging bad
+=head2 Regexps with / and {}
+If the regexp contains C</> and also C<{> or C<}> then neither C<//> nor C<{}>
+are particularly good choices for delimiters. In this case the policy
+automatically relaxes to C<allow_all_brackets> described below.
+
+ if ($str =~ m</foo/bar\{.*>) # ok, / and { in the pattern
+
+This automatic relaxing is experimental. It's intended not to implicitly
+recommend C<//> or C<{}> when they'd be poor choices. Maybe it could go
+further and if the C<allow_all_brackets> forms are poor too (any escaped,
+commented or unbalanced occurrences of those brackets) then don't report
+anything at all.
+
=head1 CONFIGURATION
-There is one option for this policy, C<allow_all_brackets>. If this
-is true, then, in addition to allowing C<//> and C<{}>, the other
-matched pairs of C<()>, C<[]>, and C<< <> >> are allowed.
+There is one option for this policy, C<allow_all_brackets>.
+=over
+=item C<allow_all_brackets> (boolean, default false)
+
+If true then allow matched pairs C<()>, C<[]>, and C<< <> >> as delimiters
+too, in addition to C<//> and C<{}>.
+
+ if ($sheep =~ m<baa*>) # ok, under allow_all_brackets
+ $str =~ s[some.*thing][repl];
+ my $re = qr(some.*[xyz]-thing);
+
+=back
+
+For reference, when C<()> or C<[]> are the delimiters you can still use C<()>
+groups or C<[]> or char classes. Likewise C<{}> repetition counts. Whether
+doing so looks good in another matter, but this policy doesn't prohibit it.
+
+ s/ab{2,5}cc/repl/; # ok, always
+ if ($fruit =~ m(ban(an)*a)) # ok, under allow_all_brackets
+ my $re = qr[ba[rz]-var]; # ok, under allow_all_brackets
+
=head1 CREDITS
Initial development of this policy was supported by a grant from the
Index: t/RegularExpressions/ProhibitUnusualDelimiters.run
===================================================================
--- t/RegularExpressions/ProhibitUnusualDelimiters.run (revision 4076)
+++ t/RegularExpressions/ProhibitUnusualDelimiters.run (working copy)
@@ -16,6 +16,7 @@
qr/foo/;
qr{foo};
+#-----------------------------------------------------------------------------
## name basic failures
## failures 25
## cut
@@ -78,7 +79,46 @@
s[foo]<>;
s<foo><>;
+# POD examples cut and paste
+ if ($sheep =~ m<baa*>) { } # ok, under allow_all_brackets
+ $str =~ s[some.*thing][repl];
+ my $re = qr(some.*[xyz]-thing);
+ if ($fruit =~ m(ban(an)*a)) # ok, under allow_all_brackets
+ my $re = qr[ba[rz]-var]; # ok, under allow_all_brackets
+
+
#-----------------------------------------------------------------------------
+## name passes of "both / and { or }" automatic allow_all_brackets
+## failures 0
+## cut
+
+# / and either { or } in the pattern, automatic allow_all_brackets
+# so these are ok
+m</foo/bar\{.*>;
+m(/foo/bar\}.*);
+m[foo/bar{2,5}];
+
+# / and either { or } in the pattern, automatic allow_all_brackets
+# POD examples cut and paste
+ if ($str =~ m</foo/bar\{.*>) {} # ok, / and { in the pattern
+ s/ab{2,5}cc/repl/; # ok, always
+
+# Kevin's rss2leafnode pattern which motivated this relaxation
+ # RFC2822 "atext" characters, with "-" last
+ if ($str =~ m<[^[:alnum:][:space:]!#\$%&'*+/=?^_`{|}~-]>) { }
+
+#-----------------------------------------------------------------------------
+## name failures of not "both / and { or }"
+## failures 3
+## cut
+
+# not both / and either { or } in the pattern, no automatic allow_all_brackets
+# so these are bad
+m<foobar\{.*>;
+m(foobar\}.*);
+m[foo/bar];
+
+#-----------------------------------------------------------------------------
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
