How do I append to a compiled regex in Perl?

Question

I'm writing functions to generate regular expressions to match various error messages. For example...

sub more_than_one_slurpy_error {
    return qr{^Cannot have more than one slurpy parameter }ms;
}

Then I can use them for testing to make it easier to deal with small changes in error messages.

eval q[ method two_array_params ($a, @b, @c) {} ];
like $@, more_than_one_slurpy_error;

I would like to optionally allow the user to pass in the file and line number they expect the error to come from.

eval q[ method two_array_params ($a, @b, @c) {} ];
like $@, more_than_one_slurpy_error(__FILE__, __LINE__-1);

I would write something like...

sub more_than_one_slurpy_error {
    my($file, $line) = @_;
    return _add_context(
        qr{^Cannot have more than one slurpy parameter }ms,
        $file, $line
    );
}

The end result would be qr{^Cannot have more than one slurpy parameter at \\Q$file\\E line \\Q$line\\E\\.$}ms .

What would _add_context look like? How do I append to a compiled regex, or accomplish this using a better method?

Answer 1

There's no way to add to a compiled pattern without recompiling the entire new pattern. Even /^$re$/ and qr/^$re$/ needs to recompile the entire pattern (although /$re/ doesn't). But if it'll ever be possible to extend already compiled patterns, surely /^$re$/ and qr/^$re$/ will do that. So that's your best option.

sub _add_context {
    my ($re, $file, $line) = @_;
    return qr/${re}at \Q$file\E line \Q$line\E\.$/m;
}

But should /m always be specified? What if you want the presence or absence of /m from $re to apply to the extended pattern? For that, you can use the following:

use strict;
use warnings;
use feature qw( say );

use re qw( is_regexp regexp_pattern );

sub _add_context {
    my ($re, $file, $line) = @_;
    my $context_pat = "at \Q$file\E line \Q$line\E\\.\$";

    return $re . $context_pat
        if !is_regexp($re);

    my ($pat, $mods) = regexp_pattern($re);
    my $context_mods = $mods =~ /m/ ? 'm' : '';
    $re = eval('qr/$pat(?^$context_mods:$context_pat)/'.$mods)
        or die($@);

    return $re;
}

#line 1
say _add_context(qr{^Cannot have more than one slurpy parameter }ms, __FILE__, __LINE__);
say _add_context(qr{^Cannot have more than one slurpy parameter }s,  __FILE__, __LINE__);
say _add_context(qr{^Cannot have more than one slurpy parameter }is, __FILE__, __LINE__);
say _add_context(  "^Cannot have more than one slurpy parameter ",   __FILE__, __LINE__);

Output:

(?^ms:^Cannot have more than one slurpy parameter (?^m:at a\.pl line 1\.$))
(?^s:^Cannot have more than one slurpy parameter (?^:at a\.pl line 2\.$))
(?^si:^Cannot have more than one slurpy parameter (?^:at a\.pl line 3\.$))
^Cannot have more than one slurpy parameter at a\.pl line 4\.$

Answer 2

I would probably do something like this:

#!/usr/bin/perl
use strict;
use warnings;

my $file = "\\\\FILE";
my $line = "50";

my $regex = _add_context(qr/^Something /ms,$file,$line);

sub _add_context {
    my ($reg, $file, $line) = @_;
    my $file_regex = quotemeta $file;
    my $line_regex = quotemeta $line;
    return qr/${reg}${file_regex}${line_regex}/;
}

my $string = <<'EOD';
test
Something \\FILE50
EOD

print $string . "\n";
print $regex . "\n";

if ( $string =~ /$regex/ ) {
    print "Match\n";    
} else {
    print "No match\n"; 
}

It uses quotemeta and you can test it on ideone .