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 1     1   18 use 5.006;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         19  
5 1     1   5 use warnings;
  1         1  
  1         48  
6 1     1   6 use integer;
  1         2  
  1         6  
7              
8 1     1   34 use version; our $VERSION = 'v1.3.4';
  1         3  
  1         4  
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 6     6 0 10 my $proto = shift;
20 6         11 my $type = shift;
21 6   33     24 my $class = ref($proto) || $proto;
22 6         13 my $self = bless({}, $class);
23 6         22 $self->{type} = lc($type);
24 6         25 return $self;
25             } # new()
26              
27             sub is_valid {
28 12     12 1 45 my ($self,$number) = @_;
29 12 50       69 if ($number =~ /^(\d{7})([A-W])([A-IW])?$/i) {
30 12         25 return $2 eq $self->_compute_checkdigit($1,$3);
31             }
32 0         0 return ''
33             } # is_valid()
34              
35             sub complete {
36 6     6 1 508 my ($self,$number) = @_;
37 6 50       38 if ($number =~ /^(\d{7}).?([A-IW])?$/i) {
38 6   100     14 return $1 . $self->_compute_checkdigit($1,$2) . ($2 || '');
39             }
40 0         0 return '';
41             } # complete()
42              
43             sub basenumber {
44 6     6 1 15 my ($self,$number) = @_;
45 6 50       37 if ($number =~ /^(\d{7})([A-W])([A-IW])?$/i) {
46 6 50       20 if (uc($2) eq $self->_compute_checkdigit($1,$3)) {
47 6 100       39 return $3 ? "$1.$3" : $1;
48             }
49             }
50 0         0 return '';
51             } # basenumber()
52              
53             sub checkdigit {
54 6     6 1 15 my ($self,$number) = @_;
55 6 50       38 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 30     30   106 my ($self, $number,$optional) = @_;
63 30         54 my $sum = 0;
64 30         94 my @digits = split(//,$number);
65              
66 30         75 for (my $i = 0; $i < 7; $i++) {
67 210         401 $sum += $digits[$i] * (8-$i);
68             }
69 30 100 100     100 if ($optional and $optional =~ /[A-I]/i) {
70 5         10 $sum += 9 * (ord($optional) - ord('A') + 1);
71             }
72 30         180 return $keytable[$sum % 23];
73              
74             } # _compute_checkdigit()
75              
76             # Preloaded methods go here.
77              
78             1;
79             __END__