Geek Answers Handbook

Masking a string in perl using a mask string

I have a line such as "xxox-x" that I want to mask every line in the file as such:

  • x are ignored (or simply set to a known value)
  • o remain unchanged
  • is a variable-length field that will keep everything else intact

therefore the mask "xxox-x" against "deadbeef" will give "xxaxbeex"

the same xxox-x mask versus deadabbabeef will give xxaxabbabeex

How can I do this if desired using the s-operator?

+4
source share
7 answers
$mask =~ s/-/'o' x (length $str - length $mask)/e; $str =~ s/(.)/substr($mask, pos $str, 1) eq 'o' ? $1 : 'x'/eg;
+7
source 
 $ perl -pe 's/^..(.).(.+).$/xx$1x$2x/;' deadbeef xxaxbeex deadabbabeef xxaxabbabeex
+1
source

Compile your template in the Perl substring:

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

To be more concise, you can write

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

Testing:

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

Output:

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

Note that you will need Perl 5.10.x for given ... when .

+1
source

x can be translated to . and o in (.) , while - becomes (.+?) :

 #!/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"; }
0
source

heres a quick punch in the regex generator. Can someone reorganize something beautiful out of this?

 #!/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; }
0
source 
 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 $_; }

Using tidbits from a couple of answers ... that's what I ended up with.

EDIT: update with comments

0
source

Here's a character-by-character solution using substr rather than split . It should be effective for long lines, as it skips processing the middle of the line (when there is a dash).

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

More articles:


All Articles