Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

numbers masking

by Anonymous Monk
on May 16, 2012 at 06:48 UTC ( [id://970751]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I have the following code for masking numbers

my $len = length $Number; substr($Number, 6, $len - 10) = 'X' x ($len - 10);

Through this code i can i show the first 6 and last 4 digits eg:541321069873210200 is masked as 541321XXXXXXXX0200. But the problem is that when there is a seperator in between the numbers that is also counted as a result of which 5413 21069873210200 is masked as 5413 2XXXXXXXXX0200which only shows the first 5 digits instead of 6.

Please help

Replies are listed 'Best First'.
Re: numbers masking
by johngg (Canon) on May 16, 2012 at 07:24 UTC

    Take the separators out, preserving them and their offset adjusted for their position as it would be in the number without them. Then do the masking and, finally, put them back.

    knoppix@Microknoppix:~$ perl -E ' > $num = q{17403 4893 18345-973409}; > say $num; > $sepCt = 0; > push @seps, [ $1, $-[ 0 ] - $sepCt ++ ] while $num =~ m{(\D)}g; > $num =~ s{\D}{}g; > $maskLen = length( $num ) - 10; > substr $num, 6, $maskLen, q{X} x $maskLen; > substr $num, $_->[ 1 ], 0, $_->[ 0 ] for reverse @seps; > say $num;' 17403 4893 18345-973409 17403 4XXX XXXXX-XX3409 knoppix@Microknoppix:~$

    I hope this is helpful.

    Update: This can be simplified. The adjustment of position and replacement of separators in reverse order is not necessary. Separators can be put back into the string from left to right as, once one has been put back in, the rest of the string has been moved one character to the right so the next position is already correct without adjustment.

    knoppix@Microknoppix:~$ perl -E ' $num = q{17403 4893 18345-973409}; say $num; push @seps, [ $1, $-[ 0 ] ] while $num =~ m{(\D)}g; $num =~ s{\D}{}g; $maskLen = length( $num ) - 10; substr $num, 6, $maskLen, q{X} x $maskLen; substr $num, $_->[ 1 ], 0, $_->[ 0 ] for @seps; say $num;' 17403 4893 18345-973409 17403 4XXX XXXXX-XX3409 knoppix@Microknoppix:~$

    Breaking this down as requested by Anonymonk.

    • Match, capture and record the position of all non-digits in the string

    • Remove all non-digits from the string

    • Mask all but the first six and last four digits

    • Insert the non-digits back into the string in their recorded positions

    Update 2: Clarified (I hope) the wording of the first update.

    Cheers,

    JohnGG

      Thnks, but can u plz explain it

Re: numbers masking
by salva (Canon) on May 16, 2012 at 08:15 UTC
    $number =~ /^(\D*\d){6}/g and $number =~ s/\G(\D*)\d(?=(?:\D*\d){4})/$ +{1}X/g;

    or another somewhat less cryptic approach:

    my ($s, $m ,$e) = $number =~ /^((?:\D*\d){6})(.*)((?:\d\D*){4})$/; $m =~ tr/0-9/X/; $number = "$s$m$e"

    or with a recent perl:

    $number =~ s|^((?:\D*\d){6})(.*)(?=(?:\d\D*){4})|$1. ($2 =~ tr/0-9/X/r +)|e;

      thnks salva. But can please explain the crytic approach(1st one)

        Well, IMO, the expression is not so complex, but you need to understand how regular expressions can be chained using \G and what look-ahead assertions do. Both things are explained in perlre.
Re: numbers masking
by roboticus (Chancellor) on May 16, 2012 at 10:09 UTC

    Something a bit simpler:

    $ cat mask_digs.pl #!/usr/bin/perl use strict; use warnings; while (<DATA>) { print $_; # Chop up the string my @list = map { defined($_) ? $_ : '' } split /(\d)/; # Replace all digits with X, other than first six and last 4. s/\d/X/ for @list[12 .. $#list-8]; # Join it back together print join("", @list), "\n"; } __DATA__ 5432 1234 12346 6694 a16-994-332-1234-16 123321123333333

    Running this gives me:

    $ perl mask_digs.pl 5432 1234 12346 6694 5432 12XX XXXXX 6694 a16-994-332-1234-16 a16-994-3XX-XX34-16 123321123333333 123321XXXXX3333

    Update: Oops, I posted version N-1, replaced. (Version N is commented, and preserves proper number of digits.)

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

Re: numbers masking
by choroba (Cardinal) on May 16, 2012 at 07:02 UTC
    Do you need to keep the "separators"? If not, just remove the separators from the string (e.g.  s/[^0-9]//g), and use the method you already have.

      I need to keep the seperators as it is

        A bit tedious then:
        #!/usr/bin/perl use warnings; use strict; use Test::More; sub mask { my $num = shift; my ($begin, $end) = (q{}, q{});; $begin .= substr $num, 0, 1, q{} until 7 == $begin =~ tr/0-9 +//; $num = substr($begin, -1, 1, q{}) . $num; $end = substr($num, -1, 1, q{}) . $end until 5 == $end =~ tr/0-9 +//; $num .= substr $end, 0, 1, q{}; $num =~ tr/0-9/X/; return $begin . $num . $end; } is(mask($_->[0]), $_->[1]) for ( ['1234 5678 1234 5678' , '1234 56XX XXXX 5678'], ['1234567812345678' , '123456XXXXXX5678'], ['5413 21069873210200' , '5413 21XXXXXXXX0200'], ['541321069873210200' , '541321XXXXXXXX0200'], ['1234/1234-5678-9012:34' , '1234/12XX-XXXX-XX12:34'] ); done_testing();
        Update: Fixed error in tr, thanks, jwkrahn.
Re: numbers masking
by poj (Abbot) on May 16, 2012 at 07:47 UTC
    You could split the string, process each character skipping over the non-digits and then join back together.
    #!perl use strict; my $Number = ' 5 4 1 321 0 698 7 3 210 2 0 0'; my @Number = split //,$Number; my $count = 0; for my $i (0..$#Number){ next if ($Number[$i] =~ /\D/); if (($count > 5) && ($count < 14)){ $Number[$i] = "X"; } ++$count; } print join '',@Number;
    poj
Re: numbers masking
by jwkrahn (Abbot) on May 16, 2012 at 08:03 UTC
    $ perl -le' my @numbers = ( "541321069873210200", "5413 21069873210200" ); my $start_at = 6; my $end_digits = 4; for ( @numbers ) { print; my $digit_count = tr/0-9//; my $replace_count = $digit_count - $end_digits; my $count = -1; s{ ( [0-9] ) }{ ++$count; $count >= $start_at && $count < $replace +_count ? "X" : $1 }xeg; print; } ' 541321069873210200 541321XXXXXXXX0200 5413 21069873210200 5413 21XXXXXXXX0200
Re: numbers masking
by kcott (Archbishop) on May 16, 2012 at 09:18 UTC
    #!/usr/bin/env perl use 5.010; use strict; use warnings; my $start_nonmask_nums = 6; my $end_nonmask_nums = 4; while (my $input = <>) { chomp $input; my $start_mask_pos = get_mask_pos($input, $start_nonmask_nums); my $start_string = substr $input, 0, $start_mask_pos; my $end_mask_pos = get_mask_pos(scalar reverse($input), $end_nonma +sk_nums); my $end_string = substr $input, -$end_mask_pos; my $mid_string = substr $input, $start_mask_pos, -$end_mask_pos; $mid_string =~ y{0-9}{X}; my $masked_number = $start_string . $mid_string . $end_string; say $masked_number; } sub get_mask_pos { my ($string, $count) = @_; $string =~ m{\d}g for (1 .. $count); return pos $string; }

    Here's a test run:

    $ pm_number_mask.pl 541321069873210200 541321XXXXXXXX0200 5413 21069873210 200 5413 21XXXXXXXX0 200 54 13-21XX XXXXXX02#00 54 13-21XX XXXXXX02#00 1!2@3#4$5%6^7&8*9(0)-0_9+8=7{6}5[4]3<2>1 1!2@3#4$5%6^X&X*X(X)-X_X+X=X{X}X[4]3<2>1

    -- Ken

Re: numbers masking
by jwkrahn (Abbot) on May 16, 2012 at 22:14 UTC
    $ perl -le' my @numbers = ( "541321069873210200", "5413 21069873210200" ); my $start_at = 6; my $end_digits = 4; for ( @numbers ) { print; my @digits; push @digits, \substr $_, $-[0], 1 while /[0-9]/g; splice @digits, 0, $start_at; splice @digits, -$end_digits; $$_ = "X" for @digits; print; } ' 541321069873210200 541321XXXXXXXX0200 5413 21069873210200 5413 21XXXXXXXX0200
Re: numbers masking
by moritz (Cardinal) on May 17, 2012 at 09:43 UTC
      That does not skip the first 6 and last 4 digits but the first 6 and last 4 characters!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://970751]
Approved by rovf
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2024-03-28 18:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found