Masking a string in perl using a mask string

Question

I have a string such as 'xxox-x' that I want to mask each line in a file against as such:

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

therefore mask 'xxox-x' against 'deadbeef' would yield 'xxaxbeex'

the same mask 'xxox-x' against 'deadabbabeef' would yield 'xxaxabbabeex'

How can I do this succinctly preferrably using s operator?

Answer 1

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

Answer 2

x can be translated to . and o to (.) whereas - 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";
}

Answer 3

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

Answer 4

Compile your pattern into a 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;
}

To be more concise, you could 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 it:

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'll need Perl 5.10.x for given ... when.

Answer 5

heres a quick stab at a regex generator.. maybe somebody can refactor something pretty from it?

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

Used tidbits from a couple answers ... this is what I ended up with.

EDIT: update from comments

Answer 7

Here's a character by character solution using substr rather that split. It should be efficient for long strings since it skips processing the middle part of the string (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;
}