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   17 use 5.006;
  1         3  
4 1     1   4 use strict;
  1         2  
  1         20  
5 1     1   4 use warnings;
  1         2  
  1         21  
6 1     1   4 use integer;
  1         2  
  1         4  
7              
8 1     1   33 use version; our $VERSION = 'v1.3.6';
  1         3  
  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         12 my $type = shift;
27 8   33     30 my $class = ref($proto) || $proto;
28 8         49 my $self = bless({}, $class);
29 8         26 $self->{type} = lc($type);
30 8         33 return $self;
31             } # new()
32              
33             sub is_valid {
34 16     16 1 63 my ($self,$number) = @_;
35 16 50       82 if ($number =~ /^(.+)(.)$/) {
36 16         49 return uc($2) eq $self->_compute_checkdigit($1);
37             }
38 0         0 return ''
39             } # is_valid()
40              
41             sub complete {
42 8     8 1 776 my ($self,$number) = @_;
43 8 50       42 if ($number =~ /^[-0-9A-Za-z]+$/) {
44 8         20 return $number . $self->_compute_checkdigit($number);
45             }
46 0         0 return '';
47             } # complete()
48              
49             sub basenumber {
50 8     8 1 17 my ($self,$number) = @_;
51 8 50       40 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       37 if ($number =~ /^(.+)(.)$/) {
60 8 50       24 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   57 my $self = shift;
67 40         73 my $number = shift;
68              
69 40 50       119 if ($number =~ /^[-0-9A-Za-z]+$/) {
70              
71 40         91 $number =~ s/-//g;
72 40         124 my @digits = split(//,$number);
73 40         68 my $sum = 0;
74 40         54 my $weight = 2;
75              
76 40         103 for (my $i = $#digits; $i >= 0; $i--) {
77              
78 305 100       566 $digits[$i] = 1 + ord(uc($digits[$i])) - ord('A')
79             if ($digits[$i] =~ /[A-Z]/i);
80 305         459 $sum += $weight * $digits[$i];
81 305         552 ++$weight;
82              
83             }
84 40         59 $sum %= 11;
85 40 50       295 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__