File Coverage

blib/lib/Algorithm/CheckDigits/M11_001.pm
Criterion Covered Total %
statement 45 50 90.0
branch 10 18 55.5
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 71 87 81.6


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::M11_001;
2              
3 1     1   18 use 5.006;
  1         3  
4 1     1   6 use strict;
  1         2  
  1         19  
5 1     1   5 use warnings;
  1         2  
  1         20  
6 1     1   5 use integer;
  1         2  
  1         4  
7              
8 1     1   32 use version; our $VERSION = 'v1.3.4';
  1         2  
  1         3  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my $cd = {
13             'isbn' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 'X', 0 ],
14             'ustid_pt' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0 ],
15             'hkid' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 'A', 0 ],
16             'wagonnr_br' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1 ],
17             'nhs_gb' => [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, 0 ],
18             'vat_sl' => [ 1, 0, 2, 3, 4, 5, 6, 7, 8, 9, 0, -1 ], # ?
19             };
20              
21             $cd->{'issn'} = $cd->{'isbn'};
22             $cd->{'vatrn_pt'} = $cd->{'ustid_pt'};
23              
24             sub new {
25 8     8 0 13 my $proto = shift;
26 8         13 my $type = shift;
27 8   33     28 my $class = ref($proto) || $proto;
28 8         19 my $self = bless({}, $class);
29 8         25 $self->{type} = lc($type);
30 8         35 return $self;
31             } # new()
32              
33             sub is_valid {
34 16     16 1 53 my ($self,$number) = @_;
35 16 50       81 if ($number =~ /^(.+)(.)$/) {
36 16         52 return uc($2) eq $self->_compute_checkdigit($1);
37             }
38 0         0 return ''
39             } # is_valid()
40              
41             sub complete {
42 8     8 1 650 my ($self,$number) = @_;
43 8 50       43 if ($number =~ /^[-0-9A-Za-z]+$/) {
44 8         21 return $number . $self->_compute_checkdigit($number);
45             }
46 0         0 return '';
47             } # complete()
48              
49             sub basenumber {
50 8     8 1 19 my ($self,$number) = @_;
51 8 50       42 if ($number =~ /^(.+)(.)$/) {
52 8 50       27 return $1 if (uc($2) eq $self->_compute_checkdigit($1));
53             }
54 0         0 return '';
55             } # basenumber()
56              
57             sub checkdigit {
58 8     8 1 18 my ($self,$number) = @_;
59 8 50       41 if ($number =~ /^(.+)(.)$/) {
60 8 50       25 return $2 if (uc($2) eq $self->_compute_checkdigit($1));
61             }
62 0         0 return '';
63             } # checkdigit()
64              
65             sub _compute_checkdigit {
66 40     40   67 my $self = shift;
67 40         72 my $number = shift;
68              
69 40 50       125 if ($number =~ /^[-0-9A-Za-z]+$/) {
70              
71 40         95 $number =~ s/-//g;
72 40         132 my @digits = split(//,$number);
73 40         61 my $sum = 0;
74 40         59 my $weight = 2;
75              
76 40         101 for (my $i = $#digits; $i >= 0; $i--) {
77              
78 305 100       610 $digits[$i] = 1 + ord(uc($digits[$i])) - ord('A')
79             if ($digits[$i] =~ /[A-Z]/i);
80 305         466 $sum += $weight * $digits[$i];
81 305         508 ++$weight;
82              
83             }
84 40         61 $sum %= 11;
85 40 50       294 return $cd->{$self->{type}}[11-$sum] if ($cd->{$self->{type}});
86             }
87 0           return -1;
88             } # _compute_checkdigit()
89              
90             # Preloaded methods go here.
91              
92             1;
93             __END__