File Coverage

blib/lib/Algorithm/CheckDigits/MBase_003.pm
Criterion Covered Total %
statement 48 52 92.3
branch 12 18 66.6
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 76 89 85.3


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::MBase_003;
2              
3 1     1   19 use 5.006;
  1         4  
4 1     1   7 use strict;
  1         2  
  1         32  
5 1     1   6 use warnings;
  1         3  
  1         25  
6 1     1   5 use integer;
  1         2  
  1         6  
7              
8 1     1   32 use version; our $VERSION = qv('v1.3.5');
  1         3  
  1         4  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my @weight = ( 6, 3, 7, 9, 10, 5, 8, 4, 2, 1 );
13              
14             my %table_to = (
15             '0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4,
16             '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9,
17             'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
18             'F' => 15, 'G' => 16, 'H' => 17, 'I' => 18, 'J' => 19,
19             'K' => 20, 'L' => 21, 'M' => 22, 'N' => 23, 'O' => 24,
20             'P' => 25, 'Q' => 26, 'R' => 27, 'S' => 28, 'T' => 29,
21             'U' => 30, 'V' => 31, 'W' => 32, 'X' => 33, 'Y' => 34,
22             'Z' => 35,
23             );
24              
25             my @table_from = (
26             '0', '1', '2', '3', '4',
27             '5', '6', '7', '8', '9',
28             'A', 'B', 'C', 'D', 'E',
29             'F', 'G', 'H', 'I', 'J',
30             'K', 'L', 'M', 'N', 'O',
31             'P', 'Q', 'R', 'S', 'T',
32             'U', 'V', 'W', 'X', 'Y',
33             'Z', '#',
34             );
35              
36             sub new {
37 1     1 0 2 my $proto = shift;
38 1         2 my $type = shift;
39 1   33     7 my $class = ref($proto) || $proto;
40 1         2 my $self = bless({}, $class);
41 1         8 $self->{type} = lc($type);
42 1         6 return $self;
43             } # new()
44              
45             sub is_valid {
46 2     2 1 9 my ($self,$number) = @_;
47 2 50       13 if ($number =~ /^(.*)(.)$/) {
48 2         8 return uc($2) eq $self->_compute_checkdigits($1);
49             }
50 0         0 return ''
51             } # is_valid()
52              
53             sub complete {
54 1     1 1 99 my ($self,$number) = @_;
55 1 50       6 if ($number =~ /^(.*)$/) {
56 1         5 return "$1"
57             . $self->_compute_checkdigits($1)
58             }
59 0         0 return '';
60             } # complete()
61              
62             sub basenumber {
63 1     1 1 3 my ($self,$number) = @_;
64 1 50       7 if ($number =~ /^(.*)(.)$/) {
65 1 50       6 return "$1" if ($2 eq $self->_compute_checkdigits($1));
66             }
67 0         0 return '';
68             } # basenumber()
69              
70             sub checkdigit {
71 1     1 1 3 my ($self,$number) = @_;
72 1 50       7 if ($number =~ /^(.*)(.)$/) {
73 1 50       3 return $2 if ($2 eq $self->_compute_checkdigits($1));
74             }
75 0         0 return '';
76             } # checkdigit()
77              
78             sub _compute_checkdigits {
79 5     5   9 my $self = shift;
80 5         11 my $number = shift;
81              
82 5         6 my $digit;
83              
84 5         31 my @digits = split(//,$number);
85 5         10 my $even = 0;
86 5         6 my $sum1 = 0;
87 5         7 my $sum2 = 0;
88              
89 5         79 for (my $i = $#digits; $i>= 0; $i--) {
90 175 100       374 if (uc($digits[$i]) =~ /[0-9A-Z]/) {
91 125         198 $digit = $table_to{uc($digits[$i])};
92             } else {
93 50         73 $digit = 36;
94             }
95 175 100       306 $sum1 += 3 * $digit unless ($even);
96 175 100       290 $sum2 += $digit if ($even);
97 175         309 $even = not $even;
98             }
99 5         10 my $sum = 37 - (($sum1 + $sum2) % 37);
100              
101 5         41 return $table_from[$sum];
102              
103             } # _compute_checkdigit()
104              
105             # Preloaded methods go here.
106              
107             1;
108             __END__