File Coverage

blib/lib/Algorithm/CheckDigits/M23_001.pm
Criterion Covered Total %
statement 37 42 88.1
branch 7 14 50.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 60 75 80.0


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::M23_001;
2              
3 1     1   19 use 5.006;
  1         4  
4 1     1   7 use strict;
  1         2  
  1         21  
5 1     1   4 use warnings;
  1         2  
  1         36  
6 1     1   6 use integer;
  1         2  
  1         15  
7              
8 1     1   34 use version; our $VERSION = 'v1.3.5';
  1         2  
  1         4  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my @keytable = (
13             'T', 'R', 'W', 'A', 'G', 'M', 'Y', 'F',
14             'P', 'D', 'X', 'B', 'N', 'J', 'Z', 'S',
15             'Q', 'V', 'H', 'L', 'C', 'K', 'E',
16             );
17              
18             sub new {
19 1     1 0 2 my $proto = shift;
20 1         3 my $type = shift;
21 1   33     6 my $class = ref($proto) || $proto;
22 1         3 my $self = bless({}, $class);
23 1         8 $self->{type} = lc($type);
24 1         6 return $self;
25             } # new()
26              
27             sub is_valid {
28 2     2 1 9 my ($self,$number) = @_;
29 2 50       14 if ($number =~ /^(\d{8})-?([A-HJ-NP-TV-Z])$/i) {
30 2         6 return $2 eq $self->_compute_checkdigit($1);
31             }
32 0         0 return ''
33             } # is_valid()
34              
35             sub complete {
36 1     1 1 96 my ($self,$number) = @_;
37 1 50       7 if ($number =~ /^(\d{8})-?$/i) {
38 1         3 return $number . $self->_compute_checkdigit($1);
39             }
40 0         0 return '';
41             } # complete()
42              
43             sub basenumber {
44 1     1 1 3 my ($self,$number) = @_;
45 1 50       7 if ($number =~ /^(\d{8}-?)([A-HJ-NP-TV-Z])$/i) {
46 1 50       5 return $1 if (uc($2) eq $self->_compute_checkdigit($1));
47             }
48 0         0 return '';
49             } # basenumber()
50              
51             sub checkdigit {
52 1     1 1 3 my ($self,$number) = @_;
53 1 50       7 if ($number =~ /^(\d{8})-?([A-HJ-NP-TV-Z])$/i) {
54 1 50       4 return $2 if (uc($2) eq $self->_compute_checkdigit($1));
55             }
56 0         0 return '';
57             } # checkdigit()
58              
59             sub _compute_checkdigit {
60 5     5   8 my $self = shift;
61 5         12 my $number = shift;
62              
63 5         13 $number =~ s/-//g;
64 5 50       15 if ($number =~ /^\d{8}$/i) {
65 5         37 return $keytable[($number % 23)];
66             }
67 0           return -1;
68             } # _compute_checkdigit()
69              
70             # Preloaded methods go here.
71              
72             1;
73             __END__