File Coverage

blib/lib/Algorithm/CheckDigits/M23_002.pm
Criterion Covered Total %
statement 41 45 91.1
branch 10 16 62.5
condition 6 8 75.0
subroutine 11 11 100.0
pod 4 5 80.0
total 72 85 84.7


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::M23_002;
2              
3 2     2   38 use 5.006;
  2         7  
4 2     2   12 use strict;
  2         15  
  2         44  
5 2     2   10 use warnings;
  2         5  
  2         65  
6 2     2   500 use integer;
  2         16  
  2         12  
7              
8 2     2   74 use version; our $VERSION = 'v1.3.5';
  2         4  
  2         10  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my @keytable = (
13             'W', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
14             'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
15             'P', 'Q', 'R', 'S', 'T', 'U', 'V',
16             );
17              
18             sub new {
19 7     7 0 12 my $proto = shift;
20 7         12 my $type = shift;
21 7   33     33 my $class = ref($proto) || $proto;
22 7         15 my $self = bless({}, $class);
23 7         32 $self->{type} = lc($type);
24 7         29 return $self;
25             } # new()
26              
27             sub is_valid {
28 24     24 1 70 my ($self,$number) = @_;
29 24 50       124 if ($number =~ /^(\d{7})([A-W])([A-IW])?$/i) {
30 24         59 return $2 eq $self->_compute_checkdigit($1,$3);
31             }
32 0         0 return ''
33             } # is_valid()
34              
35             sub complete {
36 6     6 1 443 my ($self,$number) = @_;
37 6 50       35 if ($number =~ /^(\d{7}).?([A-IW])?$/i) {
38 6   100     16 return $1 . $self->_compute_checkdigit($1,$2) . ($2 || '');
39             }
40 0         0 return '';
41             } # complete()
42              
43             sub basenumber {
44 6     6 1 14 my ($self,$number) = @_;
45 6 50       32 if ($number =~ /^(\d{7})([A-W])([A-IW])?$/i) {
46 6 50       21 if (uc($2) eq $self->_compute_checkdigit($1,$3)) {
47 6 100       37 return $3 ? "$1.$3" : $1;
48             }
49             }
50 0         0 return '';
51             } # basenumber()
52              
53             sub checkdigit {
54 6     6 1 14 my ($self,$number) = @_;
55 6 50       32 if ($number =~ /^(\d{7})([A-W])([A-IW])?$/i) {
56 6 50       19 return $2 if (uc($2) eq $self->_compute_checkdigit($1,$3));
57             }
58 0         0 return '';
59             } # checkdigit()
60              
61             sub _compute_checkdigit {
62 42     42   137 my ($self, $number,$optional) = @_;
63 42         74 my $sum = 0;
64 42         129 my @digits = split(//,$number);
65              
66 42         102 for (my $i = 0; $i < 7; $i++) {
67 294         560 $sum += $digits[$i] * (8-$i);
68             }
69 42 100 100     136 if ($optional and $optional =~ /[A-I]/i) {
70 7         16 $sum += 9 * (ord($optional) - ord('A') + 1);
71             }
72 42         243 return $keytable[$sum % 23];
73              
74             } # _compute_checkdigit()
75              
76             # Preloaded methods go here.
77              
78             1;
79             __END__