File Coverage

blib/lib/Algorithm/CheckDigits/MXX_005.pm
Criterion Covered Total %
statement 40 45 88.8
branch 7 14 50.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 63 78 80.7


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::MXX_005;
2              
3 1     1   18 use 5.006;
  1         3  
4 1     1   6 use strict;
  1         2  
  1         34  
5 1     1   7 use warnings;
  1         2  
  1         36  
6 1     1   6 use integer;
  1         2  
  1         5  
7              
8 1     1   22 use version; our $VERSION = 'v1.3.4';
  1         1  
  1         4  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my $ctable = [
13             [ 0, 9, 4, 6, 8, 2, 7, 1, 3, 5, 0, ],
14             [ 9, 4, 6, 8, 2, 7, 1, 3, 5, 0, 9, ],
15             [ 4, 6, 8, 2, 7, 1, 3, 5, 0, 9, 8, ],
16             [ 6, 8, 2, 7, 1, 3, 5, 0, 9, 4, 7, ],
17             [ 8, 2, 7, 1, 3, 5, 0, 9, 4, 6, 6, ],
18             [ 2, 7, 1, 3, 5, 0, 9, 4, 6, 8, 5, ],
19             [ 7, 1, 3, 5, 0, 9, 4, 6, 8, 2, 4, ],
20             [ 1, 3, 5, 0, 9, 4, 6, 8, 2, 7, 3, ],
21             [ 3, 5, 0, 9, 4, 6, 8, 2, 7, 1, 2, ],
22             [ 5, 0, 9, 4, 6, 8, 2, 7, 1, 3, 1, ],
23             ];
24              
25             sub new {
26 1     1 0 3 my $proto = shift;
27 1         2 my $type = shift;
28 1   33     7 my $class = ref($proto) || $proto;
29 1         2 my $self = bless({}, $class);
30 1         8 $self->{type} = lc($type);
31 1         6 return $self;
32             } # new()
33              
34             sub is_valid {
35 2     2 1 9 my ($self,$number) = @_;
36 2 50       12 if ($number =~ /^(\d{8})(\d)$/i) {
37 2         5 return $2 == $self->_compute_checkdigit($1);
38             }
39 0         0 return ''
40             } # is_valid()
41              
42             sub complete {
43 1     1 1 95 my ($self,$number) = @_;
44 1 50       7 if ($number =~ /^(\d{8})$/i) {
45 1         3 return $number . $self->_compute_checkdigit($1);
46             }
47 0         0 return '';
48             } # complete()
49              
50             sub basenumber {
51 1     1 1 4 my ($self,$number) = @_;
52 1 50       6 if ($number =~ /^(\d{8})(\d)$/i) {
53 1 50       3 return $1 if ($2 == $self->_compute_checkdigit($1));
54             }
55 0         0 return '';
56             } # basenumber()
57              
58             sub checkdigit {
59 1     1 1 3 my ($self,$number) = @_;
60 1 50       7 if ($number =~ /^(\d{8})(\d)$/i) {
61 1 50       3 return $2 if ($2 == $self->_compute_checkdigit($1));
62             }
63 0         0 return '';
64             } # checkdigit()
65              
66             sub _compute_checkdigit {
67 5     5   10 my $self = shift;
68 5         10 my $number = shift;
69 5         8 my $carry = 0;
70 5 50       16 if ($number =~ /^\d{8}$/) {
71 5         21 my @digits = split(//,$number);
72 5         13 for (my $i = 0;$i <= $#digits;$i++) {
73 40         81 $carry = $ctable->[$carry]->[$digits[$i]];
74             }
75 5         37 return (10 - $carry) % 10;
76             }
77 0           return -1;
78             } # _compute_checkdigit()
79              
80             # Preloaded methods go here.
81              
82             1;
83             __END__