RFC: Business::CreditCard::Obscure

[kwaping]

This is a very simple pure-Perl module that I thought might be CPAN-worthy (after refinement and POD, etc.). It takes a string input "cardnum" and replaces part of it with another character or string "replacement". The user can specify the replacement string as well as how many characters of the original string are left unchanged at both the "head" and "tail".

Comments are appreciated!

package Business::CreditCard::Obscure;

use strict;
use warnings;

sub new {

    my ($pack,%in) = @_;

    my $hash = {};

    $hash->{'cardnum'} = defined($in{'cardnum'}) ? $in{'cardnum'} : un
+def;
    $hash->{'head'} = defined($in{'head'}) ? $in{'head'} : 0;
    $hash->{'tail'} = defined($in{'tail'}) ? -$in{'tail'} : -4;
    $hash->{'replacement'} = defined($in{'replacement'}) ? $in{'replac
+ement'} : '*';

    return bless $hash, $pack;
}

sub obscure {

    my ($check,%in) = @_;
    my $self = ($check eq __PACKAGE__) ? $check->new(%in) : $check;

    $self->{'cardnum'} = $in{'cardnum'} if ($in{'cardnum'});
    $self->{'head'} = $in{'head'} if ($in{'head'});
    $self->{'tail'} = - $in{'tail'} if ($in{'tail'});
    $self->{'replacement'} = $in{'replacement'} if ($in{'replacement'}
+);

    return "cardnum not found" unless (defined($self->{'cardnum'}));
    return "head not found" unless (defined($self->{'head'}));
    return "tail not found" unless (defined($self->{'tail'}));
    return "replacement not found" unless (defined($self->{'replacemen
+t'}));

    my $cardnum = $self->{'cardnum'};

    substr(    $cardnum,
            $self->{'head'},
            $self->{'tail'}
            ) =~ s/./$self->{'replacement'}/g;

    return $self->{'obscured'} = $cardnum;

}

1;

[perrin]

I'm certainly in favor of code reuse and OO and input validation, but the actual functionality here is so small that it hardly seems worth it. I do this in my own code with this sub:

sub _safe_card_number {
    my ($class, $card_number) = @_;
    $card_number =
      'X' x (length($card_number) - 4) . substr($card_number, -4);
    return $card_number;
}

I could imagine someone wanting to change the 'X' to something else, but leaving the last 4 characters is pretty much universal from what I've seen.

[radiantmatrix]

You're using substr repetitively, but you don't need to.

print obscure('5555666677778888', 4, 2, '*');

sub obscure {
   my ($num, $tip, $tail, $char) = @_;
   my $repl_length = length($num) - $tip - $tail;

   substr($num, $tip, $repl_length) = $char x $repl_length;
   
   return $num;
}

__END__
5555**********88

Looking at this again, I'm noting that this in production code should really make use of some data validation. Calling obscure() with a negative value for $tip would have some interesting results, for example. ;-)

Updates:

• 2006-08-25 : Added thoughts about data validation

[perrin]

I know, I just don't like lvalue subtring. It might be faster, for people who aren't bothered by the way it looks.

[cees]

This is a module that might benefit from Sub::Exporter. It allows you to export custom functions that are tailored to the user's needs. Here are some usage examples:

use Business::CreditCard::Obscure qw(obscure);

print obscure('4444333322221111');  # 4444********1111

use Business::CreditCard::Obscure
    obscure => { head => 4, tail => -4, replacement => '!' };

print obscure('4444333322221111');  # 4444!!!!!!!!1111

use Business::CreditCard::Obscure
    obscure => { head => 4, -as => 'obscurevisa' },
    obscure => { head => 3, tail => -3, -as => 'obscurediner' };

print obscurevisa('4444333322221111');  # 4444********1111
print obscurediner('444333222111');  # 444******111

And here is the code to implement the above examples:

package Business::CreditCard::Obscure;

use strict;
use warnings;

use Sub::Exporter
    -setup => {
      exports => [ obscure => \&build_obscure ]
    };

sub build_obscure {
  my ( $class, $name, $arg ) = @_;

  $arg->{head}        ||=  0;
  $arg->{tail}        ||= -4;
  $arg->{replacement} ||= '*';

  return sub {
    my $data = shift;
    substr( $data, $arg->{head}, $arg->{tail} )
        =~ s/./$arg->{replacement}/g;
    return $data;
  }
}

1;

[izut]

That's what I was thinking about. Like:

package Business::CreditCard::Obscure;

sub new {
    ...
}

sub obscure {
    ...
    _obscure(%data);
}

sub _obscure {
    ...
}

Then exporting Business::CreditCard::Obscure::_obscure as obscure.

[izut]

I think you're not following OOP too close. I would change it to something like this (untested):

sub new {
    my ($class, %parameters) = @_; 
    my $self = {};

    # here we check required parameters, to croak() them. since we are
+ using 
    # OOP, we *need* to ensure this object will be complete to perform
+ whatever
    # operations, avoiding coupling.
    foreach (qw(cardnum)) { # maybe we have other required parameters
        croak "Required parameter '$_' not found"
            unless exists $parameters{$_};
    }
 
    # now we set defaults for not obligatory parameters
    $self->{'tail'}        = $parameters{'tail'} || -4;
    $self->{'head'}        = $parameters{'head'} || 0;
    $self->{'replacement'} = $parameters{'replacement'} || "*";
}

sub obscure {
    my ($self) = @_;
    my $obscured = substr($self->{'cardnum'},
                          $self->{'head'},
                          $self->{'tail'}
    ) =~ s/./$self->{'replacement'}/g;

    return $obscured;
}

Hope this helps.

[kwaping]

I understand what you're saying and appreciate the comment. There is something you may be overlooking, though. I would like the user to have the choice of either calling new then obscure, or just going straight to Business::CreditCard::Obscure->obscure(). That's why I have the extra goodies inside that method. The constructor stuff in the new method was mostly just for user convenience to suit their preferred coding style. I'm aiming for maximum effective flexibility.

[izut]

I could use the module like this:

my $obscure = Business::CreditCard::Obscure->new(cardnum => '123456789
+012')->obscure();

Since it is very specific, why don't you write your module to export a function, like this:

use Business::CreditCard::Obscure qw(obscure);
my $obscure = obscure(cardnum = '123456789012');