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;

It's all fine and dandy until someone has to look at the code.

Replies are listed 'Best First'.
Re: RFC: Business::CreditCard::Obscure
by perrin (Chancellor) on Aug 21, 2006 at 19:12 UTC
    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.

      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. ;-)


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

      A collection of thoughts and links from the minds of geeks
      The Code that can be seen is not the true Code
      I haven't found a problem yet that can't be solved by a well-placed trebuchet
        I know, I just don't like lvalue subtring. It might be faster, for people who aren't bothered by the way it looks.
Re: RFC: Business::CreditCard::Obscure
by cees (Curate) on Aug 21, 2006 at 19:42 UTC

    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;

      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.

      Igor 'izut' Sutton
      your code, your rules.

Re: RFC: Business::CreditCard::Obscure
by izut (Chaplain) on Aug 21, 2006 at 18:11 UTC

    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.

    Igor 'izut' Sutton
    your code, your rules.

      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.

      It's all fine and dandy until someone has to look at the code.

        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');

        Igor 'izut' Sutton
        your code, your rules.