File Coverage

blib/lib/Algorithm/Verhoeff.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	2	2	100.0
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	58	58	100.0

package Algorithm::Verhoeff;

use 5.0;
use strict;
use warnings;
#use bignum; # Needed so large numbers don't get turned into standard form

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Algorithm::Verhoeff ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
    verhoeff_get verhoeff_check
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
    verhoeff_get verhoeff_check
);

our $VERSION = '0.3';


# Preloaded methods go here.

our $di; #Dihedral matrix
our @inverted =  (0, 4, 3, 2, 1, 5, 6, 7, 8, 9 );
our $f;

# First, build $f according to a simple(?) equation
BEGIN{
$f->[0] = [(0 .. 9)];
$f->[1] = [( 1, 5, 7, 6, 2, 8, 3, 0, 9, 4 )];
my $i=2;
my $j=0;
while($i < 8)
{
    while($j < 10)
    {
        $f->[$i]->[$j] = $f->[$i - 1]->[$f->[1]->[$j]];
        $j++;
    }
    $j = 0;
    $i++;
}

# This is defined
$di->[0] = [( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 )];
$di->[1] = [( 1, 2, 3, 4, 0, 6, 7, 8, 9, 5 )];
$di->[2] = [( 2, 3, 4, 0, 1, 7, 8, 9, 5, 6 )];
$di->[3] = [( 3, 4, 0, 1, 2, 8, 9, 5, 6, 7 )];
$di->[4] = [( 4, 0, 1, 2, 3, 9, 5, 6, 7, 8 )];
$di->[5] = [( 5, 9, 8, 7, 6, 0, 4, 3, 2, 1 )];
$di->[6] = [( 6, 5, 9, 8, 7, 1, 0, 4, 3, 2 )];
$di->[7] = [( 7, 6, 5, 9, 8, 2, 1, 0, 4, 3 )];
$di->[8] = [( 8, 7, 6, 5, 9, 3, 2, 1, 0, 4 )];
$di->[9] = [( 9, 8, 7, 6, 5, 4, 3, 2, 1, 0 )];

}

# Now that's all set up, we can actually do stuff.

sub verhoeff_check
{
    my $input = shift;
    my $c = 0; # initialize check at 0
    my $digit;
    my $i = 0;
    foreach $digit (reverse split(//, $input))
    {
        $c = $di->[$c]->[$f->[$i % 8]->[$digit]]; # did you catch that?
        $i++;
    }
    if($c)
    {
        return 0; # a non-zero value of $c is a check failure
    }
    return 1;
}

sub verhoeff_get
{
    my $input = shift;
    my $c = 0; # initialize check at 0
    my $digit = 0;
    my $i = 0; my $r;
    foreach $digit (reverse split(//, $input))
    {
        $c = $di->[$c]->[$f->[($i+1) % 8]->[$digit]]; # not quite the same...
        $i++;
    }
    return $inverted[$c];
}
1;
__END__