如何在Perl中附加到已编译的正则表达式?

时间:2015-03-03 22:58:33

标签: regex perl

我正在编写函数来生成正则表达式以匹配各种错误消息。例如......

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

然后我可以使用它们进行测试,以便更容易处理错误消息中的小变化。

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

我想允许用户传入他们期望错误来自的文件和行号。

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

我会写类似......

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

最终结果为qr{^Cannot have more than one slurpy parameter at \Q$file\E line \Q$line\E\.$}ms

_add_context会是什么样的?如何附加到已编译的正则表达式,或使用更好的方法完成此操作?

2 个答案:

答案 0 :(得分:3)

如果不重新编译整个新模式,就无法添加到已编译的模式中。即使/^$re$/qr/^$re$/也需要重新编译整个模式(尽管/$re/没有)。但是,如果有可能扩展已编译的模式,那么/^$re$/qr/^$re$/肯定会这样做。所以这是你最好的选择。

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

但是应该始终指定/m吗?如果您希望/m$re的存在与否适用于扩展模式,该怎么办?为此,您可以使用以下内容:

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__);

输出:

(?^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\.$

答案 1 :(得分:1)

我可能会这样做:

#!/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"; 
}

它使用quotemeta,您可以在ideone上进行测试。