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

Question

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

Answer 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的结果进入匿名数组引用构造函数[]，并立即取消引用，这归功于@{}。

如果一切似乎太wonkish，这是一样的

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

减去临时变量。

请注意使用quotemeta - 感谢Ivan！ - 它转义每对中的第一个字符串，以便正则表达式引擎将它们视为文字字符串。

输出：

The bazd is under the quux in the quuxn.

元编程，也就是说，写写入另一个程序的程序，也不错。开始的时候看起来很熟悉：

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

Answer 2

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

Answer 3

有两种方式，他们都需要您汇编的密钥的正则表达式交替表：

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

Answer 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)