在Perl中動態捕獲正則表達式匹配

Question

我想動態捕獲Perl中的正則表達式匹配。我知道eval會幫助我做到這一點，但我可能做錯了什麼。

代碼：

use strict; 
use warnings; 

my %testHash = (
    '(\d+)\/(\d+)\/(\d+)' => '$1$2$3' 
); 

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

foreach my $pattern (keys (%testHash)) { 
    my $value = $testHash{$pattern}; 
    my $result; 

    eval { 
     local $_ = $str; 
     /$pattern/; 
     print "\$1 - $1\n"; 
     print "\$2 - $2\n"; 
     print "\$3 - $3\n"; 
     eval { print "$value\n"; } 
    } 
} 

是否也可以捕捉到的正則表達式模式存儲在一個陣列？

Answer 1

也可以將捕獲的正則表達式模式存儲在數組中嗎？

當然是可以捕獲的子串存放在數組中：

#!/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'

我不太明白你想用的組合做local,eval EXPR和eval BLOCK在您的代碼和以下散列的目的：

my %testHash = (
    '(\d+)\/(\d+)\/(\d+)' => '$1$2$3' 
); 

如果你試圖編纂，這種模式應該導致三個捕獲，你可以是這樣做的：

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 
    } 
} 

見this answer找出如何可以自動計數數捕獲組的模式。在這個問題的答案使用技術：

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

輸出：

ok 1 
1..1

Answer 2

Evaluing在列表環境正則表達式返回匹配。所以在你的例子中：

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

會做這項工作。

HTH 喬治

Answer 3

我相信你真正想要的是下面的動態版本：

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

String::Substitution提供了我們需要做到這一點。

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，你可以使用以下命令：

'(\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()); 
} 

Answer 4

我不能完全確定要什麼在這裏做，但我不認爲你的程序做你認爲它做的。

您正在使用代碼爲BLOCK的eval。這就像一個try塊。如果die位於eval塊內，它將捕獲該錯誤。它不會像運行代碼一樣運行你的字符串。你需要一個字符串eval。

而不是解釋，這是一個替代方案。

此程序使用sprintf and numbers the parameters。模式中的%1$s語法表示_採用第一個參數（1$）並將其格式化爲字符串（%s）。您不需要本地化或分配到$_進行匹配。 =~運算符可以爲您執行其他變量。我還使用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格式。
• 最後一個沒有捕獲組。我們通過查看最後一個元素的索引（$#作爲通常具有@印記的數組的印記）來檢查in @+，其中在當前活動的動態範圍中保存最後成功的子匹配的末端的偏移量。第一個元素是整個匹配的結束，所以如果這隻有一個元素，我們沒有捕獲組。

輸出對我來說是這樣的：

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中進行排序的，並且如果您在沒有sort的散列中遍歷密鑰，那麼順序是隨機的。

Answer 5

道歉！我意識到我的問題和示例代碼都是模糊的。但在閱讀你的建議後，我帶着下面的代碼。 我還沒有優化此代碼，並且替換有限制。

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";