| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Algorithm::CheckDigits::MBase_003; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
18
|
use 5.006; |
|
|
1
|
|
|
|
|
4
|
|
|
4
|
1
|
|
|
1
|
|
5
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
21
|
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
22
|
|
|
6
|
1
|
|
|
1
|
|
5
|
use integer; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
5
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
34
|
use version; our $VERSION = qv('v1.3.6'); |
|
|
1
|
|
|
|
|
1
|
|
|
|
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
|
|
|
6
|
my $class = ref($proto) || $proto; |
|
40
|
1
|
|
|
|
|
3
|
my $self = bless({}, $class); |
|
41
|
1
|
|
|
|
|
8
|
$self->{type} = lc($type); |
|
42
|
1
|
|
|
|
|
5
|
return $self; |
|
43
|
|
|
|
|
|
|
} # new() |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub is_valid { |
|
46
|
2
|
|
|
2
|
1
|
9
|
my ($self,$number) = @_; |
|
47
|
2
|
50
|
|
|
|
12
|
if ($number =~ /^(.*)(.)$/) { |
|
48
|
2
|
|
|
|
|
7
|
return uc($2) eq $self->_compute_checkdigits($1); |
|
49
|
|
|
|
|
|
|
} |
|
50
|
0
|
|
|
|
|
0
|
return '' |
|
51
|
|
|
|
|
|
|
} # is_valid() |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub complete { |
|
54
|
1
|
|
|
1
|
1
|
98
|
my ($self,$number) = @_; |
|
55
|
1
|
50
|
|
|
|
7
|
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
|
4
|
my ($self,$number) = @_; |
|
64
|
1
|
50
|
|
|
|
7
|
if ($number =~ /^(.*)(.)$/) { |
|
65
|
1
|
50
|
|
|
|
2
|
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
|
|
|
|
|
9
|
my $digit; |
|
83
|
|
|
|
|
|
|
|
|
84
|
5
|
|
|
|
|
32
|
my @digits = split(//,$number); |
|
85
|
5
|
|
|
|
|
6
|
my $even = 0; |
|
86
|
5
|
|
|
|
|
9
|
my $sum1 = 0; |
|
87
|
5
|
|
|
|
|
6
|
my $sum2 = 0; |
|
88
|
|
|
|
|
|
|
|
|
89
|
5
|
|
|
|
|
61
|
for (my $i = $#digits; $i>= 0; $i--) { |
|
90
|
175
|
100
|
|
|
|
368
|
if (uc($digits[$i]) =~ /[0-9A-Z]/) { |
|
91
|
125
|
|
|
|
|
198
|
$digit = $table_to{uc($digits[$i])}; |
|
92
|
|
|
|
|
|
|
} else { |
|
93
|
50
|
|
|
|
|
69
|
$digit = 36; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
175
|
100
|
|
|
|
300
|
$sum1 += 3 * $digit unless ($even); |
|
96
|
175
|
100
|
|
|
|
286
|
$sum2 += $digit if ($even); |
|
97
|
175
|
|
|
|
|
363
|
$even = not $even; |
|
98
|
|
|
|
|
|
|
} |
|
99
|
5
|
|
|
|
|
10
|
my $sum = 37 - (($sum1 + $sum2) % 37); |
|
100
|
|
|
|
|
|
|
|
|
101
|
5
|
|
|
|
|
43
|
return $table_from[$sum]; |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
} # _compute_checkdigit() |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Preloaded methods go here. |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
1; |
|
108
|
|
|
|
|
|
|
__END__ |