File Coverage

blib/lib/Algorithm/CheckDigits/M10_001.pm

Criterion	Covered	Total	%
statement	57	66	86.3
branch	17	26	65.3
condition	1	3	33.3
subroutine	12	12	100.0
pod	4	5	80.0
total	91	112	81.2

# vim: set ts=4 sw=4 tw=78 si et:
package Algorithm::CheckDigits::M10_001;

use 5.006;
use strict;
use warnings;
use integer;

use version; our $VERSION = qv('v1.3.6');

our @ISA = qw(Algorithm::CheckDigits);

my %prefix = (
    'amex'     => [ '34', '37', ],
    'bahncard' => [ '70', ],
    'diners'   => [ '30[0-5]', '36', '38', ],
    'discover' => [ '6011', ],
    'enroute' => [ '2014', '2149', ],
    'jcb'     => [ '1800', '2131', '3088', ],
    'mastercard' => [ '5[1-5]', ],
    'miles&more' => [ '99', '22', ],
    'visa'       => [ '4', ],
);

my %ctable = (
    '0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4,
    '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9,
    'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
    'F' => 15, 'G' => 16, 'H' => 17, 'I' => 18, 'J' => 19,
    'K' => 20, 'L' => 21, 'M' => 22, 'N' => 23, 'O' => 24,
    'P' => 25, 'Q' => 26, 'R' => 27, 'S' => 28, 'T' => 29,
    'U' => 30, 'V' => 31, 'W' => 32, 'X' => 33, 'Y' => 34,
    'Z' => 35,
);

# Aliases
$prefix{'eurocard'} = $prefix{'mastercard'};

# omit prefixes doesn't work with the test numbers
my %omitprefix = (
    'jcb'      => 0,
    'enroute'  => 0,
    'discover' => 0,
);

sub new {
    my $proto = shift;
    my $type  = shift;
    my $class = ref($proto) || $proto;
    my $self  = bless( {}, $class );
    $self->{type} = lc($type);
    $self->_determine_pattern();
    return $self;
}    # new()

sub is_valid {
    my ( $self, $number ) = @_;
    if ( $number =~ /^($self->{pattern})([0-9])$/i ) {
        return $2 == $self->_compute_checkdigit( uc($1) );
    }
    return '';
}    # is_valid()

sub complete {
    my ( $self, $number ) = @_;
    if ( $number =~ /^$self->{pattern}$/i ) {
        return $number . $self->_compute_checkdigit( uc($number) );
    }
    return '';
}    # complete()

sub basenumber {
    my ( $self, $number ) = @_;
    if ( $number =~ /^($self->{pattern})([0-9])$/i ) {
        return $1 if ( $2 == $self->_compute_checkdigit( uc($1) ) );
    }
    return '';
}    # basenumber()

sub checkdigit {
    my ( $self, $number ) = @_;
    if ( $number =~ /^($self->{pattern})([0-9])$/i ) {
        return $2 if ( $2 == $self->_compute_checkdigit( uc($1) ) );
    }
    return '';
}    # checkdigit()

sub _compute_checkdigit {
    my $self   = shift;
    my $number = shift;
    $number =~ s/\s//g;
    if ( $omitprefix{ $self->{type} } ) {
        my $pf = $prefix{ $self->{type} };
        for my $p ( @{$pf} ) {
            if ( $number =~ /^$p([0-9]+)$/ ) {
                $number = $1;
                last;
            }
        }
    }
    if ('isin' eq $self->{type}) {
        # With ISIN letters are handled differently than for instance with
        # CUSIP, so we substitute them here
        $number =~ s/([A-Z])/$ctable{$1}/ge;
    }
    elsif ('imeisv' eq $self->{type}) {
        # With IMEISV the SV (software version) is left out from the
        # computation of the checkdigit
        $number = substr( $number, 0, 14 ) if ( 'imeisv' eq $self->{type} );
    }

    my @digits =  map { $ctable{$_} } split( //, $number );
    my $even   = 1;
    my $sum    = 0;
    for ( my $i = $#digits; $i >= 0; $i-- ) {
        if ($even) {
            my $tmp = 2 * $digits[$i];
            $sum += $tmp / 10 + $tmp % 10;
        }
        else {
            $sum += $digits[$i] / 10 + $digits[$i] % 10;
        }
        $even = not $even;
    }
    return ( 10 - $sum % 10 ) % 10;
}    # _compute_checkdigit()

sub _determine_pattern {
    my $self = shift;
    if ('cusip' eq $self->{type}) {
        $self->{pattern} = qr/[0-9A-Z]{8}/io;
    }
    else {
        $self->{pattern} = qr/[0-9A-Z ]+/io;
    }
} # _determine_pattern()

# Preloaded methods go here.

1;
__END__