使用掩模串

Question

我有一个字符串，如“xxox-X”，我想屏蔽各线在一个文件中对这样掩蔽在Perl的字符串：

• X的被忽略（或只设置为已知值）
• O公司保持不变
• 的 - 是一个可变长度字段，将让一切不变，因此

掩盖“xxox-X”反对“DEADBEEF”会产生“xxaxbeex”

相同的掩模 'xxox-X' 反对 'deadabbabeef' 会产生 'xxaxabbabeex'

我怎么能做到这一点简洁preferrably使用S运营商？

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

编译你的模式到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; 
} 

要更简洁，你可以写

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 

请注意，你需要的Perl 5.10.x的given ... when。

Answer 5

继承人快速刺伤一个正则表达式生成器..也许有人可以从它重构的东西很漂亮吗？

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

} 

Answer 6

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

从一对夫妇的答案使用的花絮......这就是我结束了。

编辑：更新的评论

Answer 7

这是一个被字符溶液中的字符使用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; 
}