在 perl 中，是否有一种更紧凑的方法来搜索多个模式，并且对于每个模式，用表达式替换

Question

在 perl 中，我正在读取一行并尝试使用一系列 if 语句将一组字符串替换为相应的表达式。例如：

my @shiftInstructions=("lsr", "lsl", "rol", "ror");
while (my $line = <>) {
  if ($line =~ /\$sh/) {
    my $r = int(rand(6));
    $line =~ s/\$sh/$r/;
  }
  if ($line =~ /\$ish/) {
    my $r = $shiftInstructions[rand(4)]
    $line =~ s/\$ish/$r/;
  }
}

出于多种原因，我不喜欢这种方法。首先，它是重复的。我必须首先检查模式是否存在，如果存在，则执行一个函数来生成替换值，然后替换。所以它既冗长又缓慢（每个模式需要 2 次正则表达式搜索，最终可能需要几十个模式字符串）。

我想到了一个映射，其中一些代码映射到相应的代码来执行。

我可以想象映射到一个字符串，然后使用 eval，但是除了运行时我无法检查代码。有没有更清洁的方法？

我在正则表达式中找到了执行选项。如何编写一组子程序来处理每个正则表达式，然后创建一个映射：

my %regexMap = (
    "\$fn", &foundFunc,
    "\$hw", &hex8,
    "\$hb", &hex2,
    "\$sh", &rand6,
    "\$ish", &shiftInst,
    );
while (my $line = <>) {
    $line =~ s/(\$fn|\$hw|\$hb|\$sh|\$ish|)/$regexMap{$1}/e;    
    print $line;
}

Answer 1

if ($line =~ /\$sh/) {
   my $r = int(rand(6));
   $line =~ s/\$sh/$r/;
}

是一种糟糕的写作方式

$line =~ s/\$sh/ int(rand(6)) /e;

所以

my @shiftInstructions=("lsr", "lsl", "rol", "ror");
while (my $line = <>) {
  if ($line =~ /\$sh/) {
    my $r = int(rand(6));
    $line =~ s/\$sh/$r/;
  }
  if ($line =~ /\$ish/) {
    my $r = $shiftInstructions[rand(4)]
    $line =~ s/\$ish/$r/;
  }
  print($line);
}

可以写成

my @shiftInstructions = qw( lsr lsl rol ror );

while (my $line = <>) {
   $line =~ s/\$sh/ int(rand(6)) /e;
   $line =~ s/\$ish/ $shiftInstructions[rand(@shiftInstructions)] /e;
   print($line);
}

但这意味着您正在一遍又一遍地扫描字符串。让我们避免这种情况。

my @shiftInstructions = qw( lsr lsl rol ror );

while (my $line = <>) {
   $line =~ s/\$(sh|ish)/
      if    ( $1 eq "sh"  ) { int(rand(6)) }
      elsif ( $1 eq "ish" ) { $shiftInstructions[rand(@shiftInstructions)] }
   /eg;
   print($line);
}

不幸的是，这重新引入了重复。我们可以使用调度表来解决这个问题。

my @shiftInstructions = qw( lsr lsl rol ror );

my %replacements = (
   sh  => sub { int(rand(6)) },
   ish => sub { $shiftInstructions[rand(@shiftInstructions)] },
);

my $alt = join '|', map quotemeta, keys(%replacements);
my $re = qr/\$($alt)/;

while (my $line = <>) {
   print $line =~ s/$re/ $replacements{$1}->() /reg;
}

现在我们有了一个有效的解决方案，可以在不减慢匹配速度的情况下进行扩展，同时避免重复。

---

您添加到问题中的解决方案很接近，但它有两个错误。

1. &foo 呼叫foo。要获得它的引用，请使用\&foo。

   my %regexMap = (
       "\$fn", \&foundFunc,
       "\$hw", \&hex8,
       "\$hb", \&hex2,
       "\$sh", \&rand6,
       "\$ish", \&shiftInst,
       );
   

2. $regexMap{$1} 现在返回引用。你想调用引用的子，可以使用$regexMap{$1}->()。

   while (my $line = <>) {
       $line =~ s/(\$fn|\$hw|\$hb|\$sh|\$ish|)/ $regexMap{$1}->() /e;
       print $line;
   }
   

Answer 2

在这些情况下，我经常制作某种数据结构来保存模式及其动作：

my @tuples = (
    [ qr/.../, sub { ... } ]
    [ ... ].
    );

现在，无论我想尝试多少种模式，流程的内容都保持不变：

while( <> ) {
    foreach $tuple ( @tuples ) {
        $tuple->[1]() if /$tuple[0]/
        }
     }

用一个采用数据结构的子例程进一步抽象这一点。然后，您可以根据自己的需要传递不同的表格：

sub some_sub {
    my @tuples = @_;

    while( <> ) {
        foreach $tuple ( @tuples ) {
            $tuple->[1]() if /$tuple[0]/
            }
         }
    }

我已经在 Mastering Perl 和 Effective Perl Programming 中写过这类事情，这就是我在 Brick 和 Data::Constraint 等不起眼的模块中所做的事情。

---

我一直在考虑这个问题，我想知道正则表达式是否真的是你想要做的事情的一部分。看起来您正在匹配文字字符串，但使用匹配运算符来做到这一点。您没有提供输入的详细信息，所以我在这里猜测 - 看起来有一个操作（例如 $fn，并且您想要完全匹配该操作。问题是找到该字符串然后将其映射到代码上。看起来像这样（ikegami 的回答是这个想法的另一种形式）。我匹配任何可能看起来像字符串的东西，而不是交替：

while( <> ) {
    # find the string. Need example input to guess better
    if( m/(\$[a-z]+)/ ) {
        $table{$1}->() if exists $table{$1};
        }
    }

但同样，它取决于输入、您可能想要匹配的实际子字符串的数量（因此，交替中的分支数）、您想要处理的行数等等。有一个关于使用Regex::Trie 处理 apache 日志文件的精彩演讲，以及他们试图让事情变得更快的各种实验。我已经忘记了所有细节，但是非常小的调整会在数千万行上产生明显的差异。

有趣的阅读：

• 也许这个谈话？ An exploration of trie regexp matching
• http://taint.org/2006/07/07/184022a.html
• Matching a long list of phrases

Answer 3

OP的代码可以写成如下形式

use strict;
use warnings;
use feature 'say';

my %regexMap = (
    '$fn'   => \&foundFunc,
    '$hw'   => \&hex8,
    '$hb'   => \&hex2,
    '$sh'   => \&rand6,
    '$ish'  => \&shiftInst,
    );

my @keys = map { "\\$_" } keys %regexMap;
my $re = join('|', @keys);

while (<DATA>) {
    chomp;
    next unless /($re)/;
    $regexMap{$1}->();
}

sub foundFunc   { say 'sub_foundFunc' }
sub hex8        { say 'sub_hex8'      }
sub hex2        { say 'sub_hex2'      }
sub rand6       { say 'sub_rand6'     }
sub shiftInst   { say 'sub_shiftInst' }

__DATA__
$fn
$hw
$ac
$hb
$sh
$fn
$mf
$hb
$ish
$hw

输出

sub_foundFunc
sub_hex8
sub_hex2
sub_rand6
sub_foundFunc
sub_hex2
sub_shiftInst
sub_hex8