Regex 使用掩码字符串在perl中屏蔽字符串

我有一个字符串，如'xxox-x'，我想屏蔽文件中的每一行：

• 忽略x（或仅设置为已知值）
• o’s保持不变
• -是一个可变长度字段，它将保持所有其他内容不变

因此，针对“死牛肉”的“xxox-x”面具将产生“xxaxbeex”

针对“DeadAbbeef”的相同掩码“xxox-x”将产生“xxaxAbbeex”

---

如何使用s运算符简洁地执行此操作？

x

可以转换为

和

o

转换为

（。

），而

-

变成

（.+？）

：

$ perl -pe 's/^..(.).(.+).$/xx$1x$2x/;'
deadbeef
xxaxbeex
deadabbabeef
xxaxabbabeex

---

将模式编译成Perl子文件：

sub compile {
  use feature 'switch';
  my($pattern) = @_;
  die "illegal pattern" unless $pattern =~ /^[-xo]+$/;

  my($search,$replace);
  my $i = 0;
  for (split //, $pattern) {
    given ($_) {
      when ("x") {
        $search  .= "."; $replace .= "x";
      }
      when ("o") {
        $search  .= "(?<sub$i>.)";
        $replace .= "\$+{sub$i}";
        ++$i;
      }
      when ("-") {
        $search  .= "(?<sub$i>.*)";
        $replace .= "\$+{sub$i}";
        ++$i;
      }
    }
  }

  my $code = q{
    sub {
      local($_) = @_;
      s/^SEARCH$/REPLACE/s;
      $_;
    }
  };
  $code =~ s/SEARCH/$search/;
  $code =~ s/REPLACE/$replace/;

  #print $code;
  local $@;
  my $sub = eval $code;
  die $@ if $@;

  $sub;
}

输出：

deadbeef => xxaxbeex : PASS
deadabbabeef => xxaxabbabeex : PASS

---

注意，对于给定的

，您需要Perl5.10.x。。。当

这里有一个快速的正则表达式生成器。。也许有人可以从中重构一些漂亮的东西

#!/usr/bin/perl

use strict;
use Test::Most qw( no_plan );

my $mask = 'xxox-x';

is( mask( $mask, 'deadbeef' ),     'xxaxbeex' );
is( mask( $mask, 'deadabbabeef' ), 'xxaxabbabeex' );

sub mask {
    my ($mask, $string) = @_;
    my $regex = $mask;
    my $capture_index = 1;

    my $mask_rules = {
        'x' => '.',
        'o' => '(.)',
        '-' => '(.+)',
    };

    $regex =~ s/$_/$mask_rules->{$_}/g for keys %$mask_rules;
    $mask  =~ s/$_/$mask_rules->{$_}/g for keys %$mask_rules;

    $mask  =~ s/\./x/g;
    $mask  =~ s/\([^)]+\)/'$' . $capture_index++/eg;

    eval  " \$string =~ s/^$regex\$/$mask/ ";

    $string;

}

使用了一些答案中的花絮。。。这就是我的结局

---

编辑：从注释更新这里是一个使用

substr

而不是

split

的逐字符解决方案。它对于长字符串应该是有效的，因为它跳过了对字符串中间部分的处理（当有破折号时）

---

如果有类似于

xxo-xx-x

的模式，会发生什么情况？假设掩码只有一个可变长度字段。。否则你会有歧义，你可以先将“-”s的数量乘以剩余字符的数量，然后用正规除法。这将消除歧义。如果文件行太短会发生什么？e、 g.“xxo xox”与“abcde”势均力敌。。。但是，假设掩码和字符串都是变量。。。也许可以使用稍微不同的掩码语法来提供与此功能类似的东西。这解决了在从掩码构建替换字符串时跟踪反向引用的问题。使用适当数量的o’s作为旁注进行替换的好主意。。。我认为您需要将$pos初始化为0，并将substr（$mask，pos，1）更改为substr（$mask，$pos++，1）不，

pos

是一个Perl函数，描述最后一个正则表达式匹配在字符串中的位置。当然，我有点搞砸了，应该写

pos（$str）

，但如果它是

$\uu

：）@ephemient，非常漂亮，优雅，简单！你能扩展你的代码来处理任意数量的

o

s的任意掩码吗？忽略其他注释。我一生都失败了。我认为可以找到一个更优雅的解决方案，但事实并非如此。尽管我会注意到（@a）{gived（${}}}是多余的。Perlsyn（）特别指出，

for（@a）{when“x”{…}}

是允许的。请使用

local$\u=$\ u0]

——有关基本原理，请参阅

perldoc perlvar

（）的开头部分。另外，如果替换的字符串是空字符串而不是

'x'

，则可以将后者缩短为

substr（$mask，pos，1）eq'o'&&$1，因为Perl布尔函数在失败时返回空字符串。
sub _patref { '$+{sub' . $_[0]++ . '}' }

sub compile {
  my($pattern) = @_;
  die "illegal pattern" unless $pattern =~ /^[-xo]+$/;

  my %gen = (
    'x' => sub { $_[1] .= '.';               $_[2] .= 'x' },
    'o' => sub { $_[1] .= "(?<sub$_[0]>.)";  $_[2] .= &_patref },
    '-' => sub { $_[1] .= "(?<sub$_[0]>.*)"; $_[2] .= &_patref },
  );

  my($i,$search,$replace) = (0,"","");
  $gen{$1}->($i,$search,$replace)
    while $pattern =~ /(.)/g;

  eval "sub { local(\$_) = \@_; s/\\A$search\\z/$replace/; \$_ }"
    or die $@;
}

use v5.10;

my $replace = compile "xxox-x";

my @tests = (
  [ deadbeef     => "xxaxbeex" ],
  [ deadabbabeef => "xxaxabbabeex" ],
);

for (@tests) {
  my($input,$expect) = @$_;
  my $got = $replace->($input);
  print "$input => $got : ", ($got eq $expect ? "PASS" : "FAIL"), "\n";
}

deadbeef => xxaxbeex : PASS
deadabbabeef => xxaxabbabeex : PASS

#!/usr/bin/perl

use strict;
use Test::Most qw( no_plan );

my $mask = 'xxox-x';

is( mask( $mask, 'deadbeef' ),     'xxaxbeex' );
is( mask( $mask, 'deadabbabeef' ), 'xxaxabbabeex' );

sub mask {
    my ($mask, $string) = @_;
    my $regex = $mask;
    my $capture_index = 1;

    my $mask_rules = {
        'x' => '.',
        'o' => '(.)',
        '-' => '(.+)',
    };

    $regex =~ s/$_/$mask_rules->{$_}/g for keys %$mask_rules;
    $mask  =~ s/$_/$mask_rules->{$_}/g for keys %$mask_rules;

    $mask  =~ s/\./x/g;
    $mask  =~ s/\([^)]+\)/'$' . $capture_index++/eg;

    eval  " \$string =~ s/^$regex\$/$mask/ ";

    $string;

}

sub mask {
    local $_ = $_[0];
    my $mask = $_[1];
    $mask =~ s/-/'o' x (length($_)-(length($mask)-1))/e;
    s/(.)/substr($mask, pos, 1) eq 'o' && $1/eg;
    return $_;
}

sub apply_mask {
    my $mask = shift;
    my $string = shift;

    my ($head, $tail) = split /-/, $mask;

    for( 0 .. length($head) - 1 ) {
        my $m = substr $head, $_, 1;

        next if $m eq 'o';
        die "Bad char $m\n" if $m ne 'x';

        substr($string, $_, 1) = 'x';
    }

    return $string unless defined $tail;

    $tail = reverse $tail;
    my $last_char = length($string) - 1;

    for( 0 .. length($tail) - 1 ) {
        my $m = substr $tail, $_, 1;

        next if $m eq 'o';
        die "Bad char $m\n" if $m ne 'x';


        substr($string, $last_char - $_, 1) = 'x';

    }

    return $string;
}