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__ |