我正在编写函数来生成正则表达式以匹配各种错误消息。例如......
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
会是什么样的?如何附加到已编译的正则表达式,或使用更好的方法完成此操作?
答案 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";
}