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

时间:2009-12-09 01:33:54

标签: regex perl

我有一个像'xxox-x'这样的字符串,我想屏蔽文件中的每一行:

  • x被忽略(或只是设置为已知值)
  • o保持不变
  • - 是一个可变长度字段,可以保持其他所有内容不变

因此对'deadbeef'掩饰'xxox-x'会产生'xxaxbeex'

与'deadabbabeef'相同的面具'xxox-x'会产生'xxaxabbabeex'

我怎样才能简洁地使用s运算符呢?

7 个答案:

答案 0 :(得分:7)

$mask =~ s/-/'o' x (length $str - length $mask)/e;
$str =~ s/(.)/substr($mask, pos $str, 1) eq 'o' ? $1 : 'x'/eg;

答案 1 :(得分:1)

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

答案 2 :(得分:1)

将您的模式编译为Perl sub:

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

为了更简洁,你可以写

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

请注意,您需要given ... when的Perl 5.10.x。

答案 3 :(得分:0)

x可以转换为.o转换为(.),而-变为(.+?)

#!/usr/bin/perl

use strict; use warnings;

my %s = qw( deadbeef xxaxbeex deadabbabeef xxaxabbabeex);

for my $k ( keys %s ) {
    (my $x = $k) =~ s/^..(.).(.+?).\z/xx$1x$2x/;
    print +($x eq $s{$k} ? 'good' : 'bad'), "\n";
}

答案 4 :(得分:0)

继续快速刺破正则表达式生成器..也许有人可以从中重构一些漂亮的东西?

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

}

答案 5 :(得分:0)

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

来自几个答案的使用花絮......这就是我最终的结果。

编辑:从评论中更新

答案 6 :(得分:0)

以下是使用substr而不是split的逐字符解决方案。它应该对长字符串有效,因为它会跳过处理字符串的中间部分(当有短划线时)。

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