Regex 在Perl中动态捕获正则表达式匹配

我试图在Perl中动态捕获正则表达式匹配。我知道eval会帮我做这件事，但我可能做错了什么

代码：

是否也可以将捕获的正则表达式模式存储在数组中

是否也可以将捕获的正则表达式模式存储在数组中

当然，可以将捕获的子字符串存储在数组中：

#!/usr/bin/env perl

use strict;
use warnings;

my @patterns = map qr{$_}, qw{
    (\d+)/(\d+)/(\d+)
};

my $str = '1/12/2016';

foreach my $pattern ( @patterns ) {
    my @captured = ($str =~ $pattern)
        or next;
    print "'$_'\n" for @captured;
}

输出：

'1' '12' '2016' ok 1 1..1 如果您试图将此模式编码为三个捕获，您可以这样做：

my @tests = (
    {
        pattern => qr{(\d+)/(\d+)/(\d+)},
        ncaptures => 3,
    }
);

my $str = '1/12/2016';

foreach my $test ( @tests ) {
    my @captured = ($str =~ $test->{pattern})
        or next;
    unless (@captured == $test->{ncaptures}) {
        # handle failure
    }
}

请参阅以了解如何自动计算模式中捕获组的数量。使用该答案中的技巧：

#!/usr/bin/env perl

use strict;
use warnings;

use Test::More;

my @tests = map +{ pattern => qr{$_}, ncaptures => number_of_capturing_groups($_) }, qw(
    (\d+)/(\d+)/(\d+)
);

my $str = '1/12/2016';

foreach my $test ( @tests ) {
    my @captured = ($str =~ $test->{pattern});
    ok @captured == $test->{ncaptures};
}

done_testing;

sub number_of_capturing_groups {
    "" =~ /|$_[0]/;
    return $#+;
}

输出：

'1' '12' '2016' ok 1 1..1 好的1

---

1..1在列表上下文中评估regexp将返回匹配项。在你的例子中：

use Data::Dumper; # so we can see the result
foreach my $pattern (keys (%testHash)) {
    my @a = ($str =~/$pattern/);
    print Dumper(\@a);
}

我会做的

嗯

---

Georg

我相信您真正想要的是以下内容的动态版本：

say $str =~ s/(\d+)\/(\d+)\/(\d+)/$1$2$3/gr;

'(\d+)/(\d+)/(\d+)' => sub { sprintf "%d-%02d-%02d", @_[3,1,2] },

提供我们实现这一目标所需要的

use String::Substitution qw( gsub_copy );

for my $pattern (keys(%testHash)) {
   my $replacement = $testHash{$pattern};
   say gsub_copy($str, $pattern, $replacement);
}

请注意，

$replacement

也可以是回调。这允许更复杂的替换。例如，如果您想将

1/12/2016

转换为

2016-01-12

，您可以使用以下命令：

say $str =~ s/(\d+)\/(\d+)\/(\d+)/$1$2$3/gr;

'(\d+)/(\d+)/(\d+)' => sub { sprintf "%d-%02d-%02d", @_[3,1,2] },

---

要回答您的实际问题：

use String::Substitution qw( interpolate_match_vars last_match_vars );

for my $pattern (keys(%testHash)) {
   my $template = $testHash{$pattern};

   $str =~ $pattern   # Or /$pattern/ if you prefer
      or die("No match!\n");

   say interpolate_match_vars($template, last_match_vars());
}

---

我不完全确定你想在这里做什么，但我不认为你的程序做了你认为它做的事情

您正在对代码块使用

eval

。这就像一个

try

块。如果它

die

s在

eval

块中，它将捕获该错误。它不会像运行代码一样运行字符串。您需要一个字符串

eval

这里不是解释，而是另一种选择

此程序使用。模式中的

%1$s

语法表示“获取第一个参数（

1$

），并将其格式化为字符串（

%s

）。您不需要本地化或分配给

$\uu

来进行匹配。

=~

操作符为您在其他变量上执行此操作。我还使用

qr{}

创建一个带引号的正则表达式（本质上是一个包含预编译模式的变量），我可以直接使用它。因为分隔符是

{}

，所以我不需要跳过斜杠

use strict;
use warnings;
use feature 'say'; # like print ..., "\n"

my %testHash = (
    qr{(\d+)/(\d+)/(\d+)}         => '%1$s.%2$s.%3$s',
    qr{(\d+)/(\d+)/(\d+) nomatch} => '%1$s.%2$s.%3$s',
    qr{(\d+)/(\d+)/(\d\d\d\d)}    => '%3$4d-%2$02d-%1$02d',
    qr{\d}                        => '%s', # no capture group
);

my $str = '1/12/2016';

foreach my $pattern ( keys %testHash ) {
    my @captures = ( $str =~ $pattern );

    say "pattern: $pattern";

    if ($#+ == 0) {
        say "  no capture groups";
        next;
    }

    unless (@captures) {
        say "  no match";
        next;
    }

    # debug-output
    for my $i ( 1 .. $#- ) {
        say sprintf "  \$%d - %s", $i, $captures[ $i - 1 ];
    }

    say sprintf $testHash{$pattern}, @captures;
}

我列举了四个例子：

• 第一个图案就是你的。它使用

  %1$s

  等，如上所述
• 第二个不匹配。我们在标量上下文中查看

  @captured

  中的元素数
• 第三个显示您还可以对结果重新排序，甚至可以使用

  sprintf

  格式
• 最后一个没有捕获组。我们通过查看最后一个元素的索引（

  $#

  作为通常具有

  @

  sigil的数组的sigil）进行检查，该索引保存当前活动动态范围中最后一个成功子匹配的端点的偏移量。第一个元素是整个匹配的结尾，因此如果只有一个元素，我们就没有捕获组

我的输出如下：

pattern: (?^:(\d+)/(\d+)/(\d\d\d\d))
  $1 - 1
  $2 - 12
  $3 - 2016
2016-12-01
pattern: (?^:(\d+)/(\d+)/(\d+) nomatch)
  no match
pattern: (?^:\d)
  no capture groups
pattern: (?^:(\d+)/(\d+)/(\d+))
  $1 - 1
  $2 - 12
  $3 - 2016
1.12.2016

---

请注意，输出中的顺序是混淆的。这是因为散列在Perl中没有顺序，如果您在散列中迭代键而不进行排序，则顺序是随机的。

抱歉！我意识到我的问题和示例代码都很模糊。但是在阅读了你的建议之后，我得到了以下代码。 我还没有优化这段代码，而且替换代码是有限制的

foreach my $key (keys %testHash) {

    if ( $str =~ $key ) {
        my @matchArr = ($str =~ $key); # Capture all matches

        # Search and replace (limited from $1 to $9)
        for ( my $i = 0; $i < @matchArr; $i++ ) {
            my $num = $i+1;
            $testHash{$key} =~ s/\$$num/$matchArr[$i]/;
        }

        $result = $testHash{$key};

        last;
    }
}

print "$result\n";

foreach my$key（key%testHash）{
如果（$str=~$key）{
my@matchArr=（$str=~$key）#捕获所有匹配项
#搜索和替换（限制在1美元到9美元之间）
对于（我的$i=0；$i<@matchArr；$i++）{
我的$num=$i+1；
$testHash{$key}=~s/\$$num/$matchArr[$i]/；
}
$result=$testHash{$key}；
最后的
}
}
打印“$result\n”；

您希望发生什么？我不明白你想做什么。当表达式没有捕获时，你会得到稍微奇怪的结果。请参阅我的答案.list上下文，而不是array.Hm。。如果没有匹配项，我会得到一个空数组，并且会得到一个坏模式的异常。这正是我所期望的。现在尝试一个没有捕获的成功匹配（

'a'=~/a/

）。你会得到

[1]

而不是

[]

@SinanÜnür是的，我知道。但是我们都不喜欢使用的函数叫做wantarray。所以至少在我的领域，我们通常谈论数组上下文（AFAIK不存在）。但是池上对列表上下文的更改对我来说当然没问题：）我想我不明白你的意思。对于没有捕获组的匹配，我得到

@matches=（1）

，这可能是因为匹配成功，所以返回1，

@-=（0）

。两者都有相同数量的元素，只是单个元素中的内容不同。我最初没有注意到，

$testHash{$pattern}

是一个需要插入捕获的模板。修复了我的答案。您的模式测试失败

*

。与我最初的测试一样，您没有注意到捕获需要插入到

$value

中。