如何在 Perl 中用一个子字符串替换另一个子字符串？答案

【问题标题】：How can I substitute one substring for another in Perl?如何在 Perl 中用一个子字符串替换另一个子字符串？
【发布时间】：2010-09-22 16:33:18
【问题描述】：

我有一个文件和一个从另一个文件中获取的字符串对列表。我需要用第二个字符串替换该对的第一个字符串，并为每一对执行此操作。是否有更有效/更简单的方法来执行此操作（使用 Perl、grep、sed 或其他），然后为每对值运行单独的正则表达式替换？

【问题讨论】：

@brian d foy 我不确定标题编辑是否准确地总结了问题的内容。
如果您有更好的标题，请使用它。原版也好不到哪里去。

标签： regex perl sed grep

【解决方案1】：

#! /usr/bin/perl

use warnings;
use strict;

my %replace = (
  "foo" => "baz",
  "bar" => "quux",
);

my $to_replace = qr/@{["(" .
                       join("|" => map quotemeta($_), keys %replace) .
                       ")"]}/;

while (<DATA>) {
  s/$to_replace/$replace{$1}/g;
  print;
}

__DATA__
The food is under the bar in the barn.

@{[...]} 位可能看起来很奇怪。在quote and quote-like operators 中插入生成的内容是一种技巧。 join 的结果进入匿名数组引用构造函数 [] 并立即取消引用，感谢 @{}。

如果这一切看起来太古怪了，那就是一样

my $search = join "|" => map quotemeta($_), keys %replace;
my $to_replace = qr/($search)/;

减去临时变量。

注意quotemeta 的使用——感谢 Ivan！——它转义了每对的第一个字符串，因此正则表达式引擎会将它们视为文字字符串。

输出：

bazd在quuxn中的quux下。

元编程——即编写一个程序来编写另一个程序——也很好。开头看起来很熟悉：

#! /usr/bin/perl

use warnings;
use strict;

use File::Compare;

die "Usage: $0 path ..\n" unless @ARGV >= 1;

# stub
my @pairs = (
  ["foo"     => "baz"],
  ["bar"     => "quux"],
  ['foo$bar' => 'potrzebie\\'],
);

现在我们生成的程序可以完成所有s/// 替换——但is quotemeta on the replacement side a good idea?——

my $code =
  "sub { while (<>) { " .
  join(" " => map "s/" . quotemeta($_->[0]) .
                  "/"  . quotemeta($_->[1]) .
                  "/g;",
              @pairs) .
  "print; } }";
#print $code, "\n";

并用eval编译它：

my $replace = eval $code
  or die "$0: eval: $@\n";

要进行替换，我们使用 Perl 的 ready-made in-place editing：

# set up in-place editing
$^I = ".bak";
my @save_argv = @ARGV;

$replace->();

以下是恢复 File::Compare 模块判断为不必要的备份的额外功能：

# in-place editing is conservative: it creates backups
# regardless of whether it modifies the file
foreach my $new (@save_argv) {
  my $old = $new . $^I;
  if (compare($new, $old) == 0) {
    rename $old => $new
      or warn "$0: rename $old => $new: $!\n";
  }
}

【讨论】：

在将它们放入正则表达式之前，您还应该quotemeta 键。
因为我是 perl 的完全绿色，你能解释一下这里做了什么吗？特别是这一行：@{["(" .join("|" => keys %replace) .")"]}

【解决方案2】：

有两种方法，它们都需要你在表的键上编译一个正则表达式交替：

my %table = qw<The A the a quick slow lazy dynamic brown pink . !>;
my $alt 
    = join( '|'
          , map  { quotemeta } keys %table 
            sort { ( length $b <=> length $a ) || $a cmp $b } 
          )
    ;
my $keyword_regex = qr/($alt)/;

然后你可以在替换中使用这个正则表达式：

my $text 
    = <<'END_TEXT';
The quick brown fox jumped over the lazy dog.  The quick brown fox jumped over the lazy dog. 
The quick brown fox jumped over the lazy dog.  The quick brown fox jumped over the lazy dog.  
END_TEXT

$text =~ s/$keyword_regex/$table{ $1 }/ge; # <- 'e' means execute code

或者你可以循环执行：

use English qw<@LAST_MATCH_START @LAST_MATCH_END>;
while ( $text =~ /$keyword_regex/g ) { 
    my $key = $1;
    my $rep = $table{ $key };
    # use the 4-arg form
    substr( $text, $LAST_MATCH_START[1]
          , $LAST_MATCH_END[1] - $LAST_MATCH_START[1], $rep 
          );
    # reset the position to start + new actual
    pos( $text ) = $LAST_MATCH_START[1] + length $rep;
}

【讨论】：

【解决方案3】：

构建对的哈希。然后将目标字符串拆分为单词标记，并根据哈希中的键检查每个标记。如果存在，请将其替换为该键的值。

【讨论】：

【解决方案4】：

如果eval 不是安全问题：

eval $(awk 'BEGIN { printf "sed \047"} {printf "%s", "s/\\<" $1 "\\>/" $2 "/g;"} END{print "\047 substtemplate"}' substwords )

这会构造一个由多个替换命令组成的长 sed 命令。它可能会超过您的最大命令行长度。它期望单词对文件由每行由空格分隔的两个单词组成。将仅对整个单词进行替换（不得替换）。

如果单词对文件包含对sed 重要的字符，它可能会阻塞。

如果你的sed坚持-e，你可以这样做：

eval $(awk 'BEGIN { printf "sed"} {printf "%s", " -e \047s/\\<" $1 "\\>/" $2 "/g\047"} END{print " substtemplate"}' substwords)

【讨论】：