Another use for
qr// is to break up unmanageably complex regular expressions into simpler, named, self-contained pieces. (There's a direct parallel here with subs, which do the same for 'ordinary' Perl code. In fact, you can consider a named regex to be just a function written with a funny-looking syntax: its input is a string and its output is either a Boolean value or one or more strings, depending on whether it captures anything.)
Here's an example from a code-filtering assertions module (yes, another one) that's not yet tested thoroughly enough to submit to CPAN:
# A set of regexen to match balanced text in round, square or
# curly brackets:
sub makerx();
my $rxround = qr/
\(
(?:
(?> [^()] + )
|
(??{ makerx })
) *
\)
/ox;
my $rxsquare = qr/
\[
(?:
(?> [^\[\]] + )
|
(??{ makerx })
) *
\]
/ox;
my $rxcurly = qr/
\{
(?:
(?> [^{}] + )
|
(??{ makerx })
) *
\}
/ox;
my $rxbalanced = qr/ $rxround | $rxsquare | $rxcurly /ox;
sub makerx() {
$rxbalanced;
}
# A regex to match a term in an 'assert' statement:
# balanced text in some kind of bracket, or any text other than a comm
+a or semicolon:
my $rxterm = qr/
(?:
$rxbalanced
|
(?>
[^,;\(\{\x5B] +? # \x5B is a synonym for '[', w
+hich confuses Kate's syntax-colouring :-(
)
|
0 # Special case for 0 -- why is
+ this needed?
) +?
/ox;
# A regex to match one of the tokens that mark the end of an 'assert'
+statement:
my $rxend = qr/
; | } | \b (?: if | unless | while | until | for ) \b
/x;
# A regex to match an entire 'assert' statement and its arguments
# and to collect the arguments at the same time.
# Unfortunately, constructs like /($foo)+/ match all instances of $foo
+ but only
# capture the last one, and so we have to to devious things with embed
+ded Perl
# in order to both match and capture all arguments to the assertion in
+ a single
# regex.
my ($group, @args, $end);
my $rxassert = qr/
(?{ $group = '', @args = () }) # Wipe our state so that, if t
+he regex gives up
# half-way through, the next a
+ttempt doesn't
# inherit a lot of spurious to
+sh.
(?>
\b assert \b \s* # Match the 'assert' keyword.
)
(?:
(?>
: \s* (\w+) \b \s* # Look for ':SOMEGROUP'
(?{ $group = $^N }) # and save it if found.
)
) ?
(?:
( $rxterm ) # Look for an argument to the
+assertion,
(?= \s* , ) # ensure that it's followed by
+ a comma before we save it,
(?{ push @args, $^N }) # now save it,
\s* , \s* # and then skip the comma that
+ we already know to be there.
) * # There can be zero or more te
+rms that are followed by commas.
( $rxterm ) # Look for the final argument,
(?= \s* $rxend ) # ensure that it's followed by
+ a terminator before we save it,
(?{ push @args, $^N }) # and save it.
\s* ( $rxend ) # Finally, save the terminator
+.
(?{ $end = $^N })
/sox;