如何在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)