如何将子字符串中的字符(包括转义字符)替换为字符"X"？

Question

我想替换perl脚本中给定字符串（包括转义字符）中的子字符串（包括escape字符）。如果可能，使用regexp。

输入：

abcdefg hijkl: (mnop-qrst) uvwx
aabbccd deeff: (gghh-iijj) kkll
aaabbbc ccddd: (eeef-ffgg) ghhh

替换字符串示例：

ijkl:
gghh-iijj
ccddd: (eeef-ffgg)

输出：

abcdefg hXXXX: (mnop-qrst) uvwx
aabbccd deeff: (XXXX-XXXX) kkll
aaabbbc XXXXX: (XXXX-XXXX) ghhh

除了"有没有一种方法可以用和它一样长的X个字符替换子字符串？"这篇文章之外，我什么都没找到，但没有转义符
正则表达式$s =~ s/(Q$patternE)/'X' x length $1/e;适用于任何字母数字替换字符串，但如果它包含()=,.-:;* 等特殊字符，则不适用

在上面的示例中，输入字符串和替换字符串都可以包含特殊字符。

Answer 1

我建议这里的技巧是预生成正则表达式模式。

use strict;
use warnings;

my @replace_strings = qw ( ijkl:
    mnop-qrst
    hijkl: );
my %replace = map { $_ => "X" x length($_) } @replace_strings;
my $replace_regex = join( "|", map {quotemeta} @replace_strings );
$replace_regex = qr/($replace_regex)/;
while (<DATA>) {
    s/$replace_regex/$replace{$1}/g;
    print;
}
 __DATA__
 abcdefg hijkl: (mnop-qrst) uvwx

我们：

• 使用"替换字符串"列表
• 使用map生成替换（X X长度）
• 生成正则表达式以匹配"搜索"
• 然后使用它来应用"替换"

这样打印：

abcdefg XXXXXX (XXXXXXXXX) uvwx

你可以使用类似的技术。

根据注释-看起来您想要定义一些字符串，并只替换其中的文本。

这样的东西怎么样：

my %replace = map { $_ => ($_ =~ s/w/X/gr) } @replace_strings;

哪个（在您的源数据上）给出：

abcdefg hXXXX: (mnop-qrst) uvwx
aabbccd deeff: (XXXX-XXXX) kkll
aaabbbc XXXXX: (XXXX-XXXX) ghhh

（如果您也想替换-，可以将其添加到模式中）。

Answer 2

更新

这里有一个解决方案，它允许模式中的任何空白与目标字符串中的任何数量的空白相匹配。注意，要做到这一点，我必须手动转义非单词字符，所以Q。。。不再需要E

请注意，最后一个模式在ccddd:和(eeef-ffgg)之间有许多空格，但它正确地匹配字符串中的单个空格

use strict;
use warnings;
my @patterns = (
  'ijkl:',
  'gghh-iijj',
  'ccddd:            (eeef-ffgg)',
);
# Build and compile the regex
my $pattern = join '|', map {
  my $item = $_;
  $item =~ s/([^ws])/\$1/g;
  $item =~ s/s+/\s+/g;
  $item;
} @patterns;
$pattern = qr/$pattern/;
while ( my $s = <DATA> ) {
  $s =~ s/($pattern)/$1 =~ tr{a-zA-Z0-9}{X}r/eg;
  print $s;
}
__DATA__
abcdefg hijkl: (mnop-qrst) uvwx
aabbccd deeff: (gghh-iijj) kkll
aaabbbc ccddd: (eeef-ffgg) ghhh

输出

abcdefg hXXXX: (mnop-qrst) uvwx
aabbccd deeff: (XXXX-XXXX) kkll
aaabbbc XXXXX: (XXXX-XXXX) ghhh

---

原始帖子

所需要的只是更换

s/(Q$patternE)/'X' x length $1/e

带有

s/(Q$patternE)/$1 =~ tr{a-zA-Z0-9}{X}r/e

这是一个演示。注意，/r修饰符需要Perl v5.14或更好的

use strict;
use warnings;
use 5.014;
my @matches = (
  'ijkl:',
  'gghh-iijj',
  'ccddd: (eeef-ffgg)',
);
while ( my $s = <DATA> ) {
  $s =~ s/(Q$_E)/$1 =~ tr{a-zA-Z0-9}{X}r/e for @matches;
  print $s;
}
__DATA__
abcdefg hijkl: (mnop-qrst) uvwx
aabbccd deeff: (gghh-iijj) kkll
aaabbbc ccddd: (eeef-ffgg) ghhh

输出

abcdefg hXXXX: (mnop-qrst) uvwx
aabbccd deeff: (XXXX-XXXX) kkll
aaabbbc XXXXX: (XXXX-XXXX) ghhh