File Coverage

blib/lib/Algorithm/CheckDigits/M97_002.pm
Criterion Covered Total %
statement 49 54 90.7
branch 7 14 50.0
condition 1 3 33.3
subroutine 12 12 100.0
pod 4 5 80.0
total 73 88 82.9


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::M97_002;
2             # vim: set sw=4 ts=4 tw=78 et si:
3              
4 2     2   38 use 5.006;
  2         7  
5 2     2   10 use strict;
  2         19  
  2         44  
6 2     2   9 use warnings;
  2         4  
  2         56  
7 2     2   503 use integer;
  2         16  
  2         10  
8              
9 2     2   58 use version; our $VERSION = qv('v1.3.5');
  2         4  
  2         21  
10              
11             our @ISA = qw(Algorithm::CheckDigits);
12              
13             my %subst = (
14             A => 10, B => 11, C => 12, D => 13, E => 14,
15             F => 15, G => 16, H => 17, I => 18, J => 19,
16             K => 20, L => 21, M => 22, N => 23, O => 24,
17             P => 25, Q => 26, R => 27, S => 28, T => 29,
18             U => 30, V => 31, W => 32, X => 33, Y => 34,
19             Z => 35,
20             );
21              
22             sub new {
23 2     2 0 5 my $proto = shift;
24 2         4 my $type = shift;
25 2   33     16 my $class = ref($proto) || $proto;
26 2         6 my $self = bless({}, $class);
27 2         32 $self->{type} = lc($type);
28 2         10 return $self;
29             } # new()
30              
31             sub is_valid {
32 46     46 1 108 my $self = shift;
33              
34 46 50       87 if (my ($checkdigit,$number) = _prepare_number(shift)) {
35              
36 46         103 return $checkdigit eq _compute_checkdigit($number);
37             }
38 0         0 return ''
39             } # is_valid()
40              
41             sub complete {
42 1     1 1 98 my $self = shift;
43 1         4 my $incomplete = uc(shift);
44              
45 1 50       3 if (my ($checkdigit,$number) = _prepare_number($incomplete)) {
46              
47 1         4 $incomplete =~ /^(..)..(.+)/;
48              
49 1         3 return $1 . _compute_checkdigit($number) . $2;
50             }
51 0         0 return '';
52             } # complete()
53              
54             sub basenumber {
55 1     1 1 2 my $self = shift;
56 1         3 my $unchecked = shift;
57              
58 1 50       3 if (my ($checkdigit,$number) = _prepare_number($unchecked)) {
59              
60 1         3 $unchecked =~ /^(..)..(.+)/;
61              
62 1 50       6 return $1.'00'.$2
63             if ($checkdigit eq _compute_checkdigit($number));
64             }
65 0         0 return '';
66             } # basenumber()
67              
68             sub checkdigit {
69 1     1 1 3 my $self = shift;
70              
71 1 50       3 if (my ($checkdigit,$number) = _prepare_number(shift)) {
72 1 50       3 return $checkdigit
73             if ($checkdigit eq _compute_checkdigit($number));
74             }
75 0         0 return '';
76             } # checkdigit()
77              
78             sub _compute_checkdigit {
79 49     49   82 my $number = shift;
80              
81             # my $bignum = Math::BigInt->new($number);
82             # my $mod = $bignum % 97;
83             #
84             # A comparison with Benchmark::compthese() brought:
85             #
86             # Rate bignum 9_digits
87             # bignum 2502/s -- -95%
88             # 9_digits 46225/s 1748% --
89             #
90             # so I reverted _compute_checkdigit to this code.
91             # Thanks to Detlef Pilzecker for making me aware of this.
92              
93 49         76 my $mod = '';
94 49         106 while ($number ne '') {
95 180         335 $number = $mod . $number;
96 180         476 $mod = substr($number,0,9,'') % 97;
97             }
98 49         348 return sprintf("%02d",(98 - $mod));
99             } # _compute_checkdigit()
100              
101             sub _prepare_number {
102 49     49   122 my $number = uc(shift);
103              
104 49         302 $number =~ s/\s//g;
105              
106 49 50       243 if ($number =~ /^([A-Z]{2})(\d\d)([A-Z\d]{2,30})$/) {
107 49         113 my $checkdigit = $2;
108 49         140 $number = $3 . $1 . '00';
109 49         304 $number =~ s/([A-Z])/$subst{$1}/g;
110 49         229 return ($checkdigit,$number);
111             }
112 0           return;
113             } # _prepare_number()
114              
115             # Preloaded methods go here.
116              
117             1;
118             __END__