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

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
[download]

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
<–radiant.matrix–>
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.

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
[download]

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;
[download]

That's what I was thinking about. Like:

package Business::CreditCard::Obscure;

sub new {
    ...
}

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

sub _obscure {
    ...
}
[download]

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

Igor 'izut' Sutton
your code, your rules.

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;
}
[download]

Hope this helps.

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();
[download]

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');
[download]

Igor 'izut' Sutton
your code, your rules.