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

这@{[...]}可能看起来很奇怪.在引用和类似报价的运算符中插入生成的内容是一种破坏.join进入匿名数组引用构造函数的结果,[]并立即取消引用,谢谢@{}.

如果所有这些看起来太令人兴奋,那就和它一样

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

减去临时变量.

注意使用quotemeta-thanks Ivan!-which会转义每对的第一个字符串,因此regular-expression引擎会将它们视为文字字符串.

输出:

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///替代,但是是quotemeta在更换侧是一个好主意？-

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 现成的就地编辑:

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