File Coverage

blib/lib/Algorithm/CheckDigits/MXX_001.pm
Criterion Covered Total %
statement 66 70 94.2
branch 29 38 76.3
condition 11 30 36.6
subroutine 12 12 100.0
pod 4 5 80.0
total 122 155 78.7


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::MXX_001;
2              
3 1     1   19 use 5.006;
  1         4  
4 1     1   6 use strict;
  1         2  
  1         20  
5 1     1   5 use warnings;
  1         3  
  1         23  
6 1     1   5 use integer;
  1         2  
  1         5  
7              
8 1     1   19 use version; our $VERSION = 'v1.3.5';
  1         2  
  1         13  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my %weight = (
13             'aba_rn' => [ 3,7,1,3,7,1,3,7,1, ],
14             'mxx-001' => [ 7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1, ],
15             'pa_de' => [ 7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1,7,3,1, ],
16             );
17              
18             sub new {
19 5     5 0 13 my ($proto, $type) = @_;
20 5   33     22 my $class = ref($proto) || $proto;
21 5         11 my $self = bless({}, $class);
22 5         19 $self->{type} = lc($type);
23 5         11 $self->{weight} = $weight{$type};
24 5 100       11 if ('aba_rn' eq $type) {
25 1         2 $self->{complement} = 1;
26             }
27 5         25 return $self;
28             } # new()
29              
30             sub is_valid {
31 10     10 1 35 my ($self,$number) = @_;
32 10 100       27 if ('aba_rn' eq $self->{type}) {
33 2         13 $number =~ y/[0-9]//cd;
34 2 50       11 if ($number =~ /^(\d{8})(\d)$/) {
35 2         7 my $ccd = $self->_compute($1);
36 2         5 my $pcd = $2;
37 2 100       9 return 1 if ($ccd == $pcd);
38             }
39             }
40             else {
41 8 100       50 if ($number =~ /^\d{9}(\d).<+\d{6}(\d)<+\d{6}(\d)<+(\d)$/) {
    50          
42 2         5 my @cd = $self->_compute_checkdigit($number);
43 2 100 33     24 return 1 if ( $cd[0] == $1 and $cd[1] == $2
      33        
      66        
44             and $cd[2] == $3 and $cd[3] == $4
45             );
46             }
47             elsif ($number =~ /^(\d+)(\d)$/) {
48 6 100       14 return 1 if $2 == $self->_compute($1);
49             }
50             }
51 5         21 return 0;
52             } # is_valid()
53              
54             sub complete {
55 5     5 1 433 my ($self,$number) = @_;
56 5 100       34 if ($number =~ /^(\d{9}).(.<+\d{6}).(<+\d{6}).(<+).$/) {
    50          
57 1         5 my @cd = $self->_compute_checkdigit($number);
58 1         8 return $1 . $cd[0] . $2 . $cd[1] . $3 . $cd[2] . $4 . $cd[3];
59             }
60             elsif ($number =~ /^(\d+)$/) {
61 4         12 return $number . $self->_compute($number);
62             }
63 0         0 return '';
64             } # complete()
65              
66             sub basenumber {
67 5     5 1 14 my ($self,$number) = @_;
68 5 100       33 if ($number =~ /^(\d{9})(\d)(.<+\d{6})(\d)(<+\d{6})(\d)(<+)(\d)$/) {
    50          
69 1         4 my @cd = $self->_compute_checkdigit($number);
70 1 50 33     21 return $1 . '_' . $3 . '_' . $5 . '_' . $7 . '_'
      33        
      33        
71             if ( $cd[0] == $2 and $cd[1] == $4
72             and $cd[2] == $6 and $cd[3] == $8
73             );
74             }
75             elsif ($number =~ /^(\d+)(\d)$/) {
76 4 50       9 return $1 if $2 == $self->_compute($1);
77             }
78 0         0 return '';
79             } # basenumber()
80              
81             sub checkdigit {
82 5     5 1 12 my ($self,$number) = @_;
83 5 100       31 if ($number =~ /^\d{9}(\d).<+\d{6}(\d)<+\d{6}(\d)<+(\d)$/) {
    50          
84 1         3 my @cd = $self->_compute_checkdigit($number);
85 1 50 33     20 return join('<',@cd)
      33        
      33        
86             if ( $cd[0] == $1 and $cd[1] == $2
87             and $cd[2] == $3 and $cd[3] == $4
88             );
89             }
90             elsif ($number =~ /^(\d+)(\d)$/) {
91 4         11 return $self->_compute($1);
92             }
93 0         0 return '';
94             } # checkdigit()
95              
96             sub _compute {
97 40     40   105 my ($self,$digits) = @_;
98 40         70 my ($sum,$i) = (0,0);
99 40         55 my @w = @{$self->{weight}};
  40         108  
100 40         135 while ($digits =~ /(\d)/g) {
101 370         967 $sum += $1 * $w[$i++];
102             }
103 40 100       78 if ($self->{complement}) {
104 5         27 return (10 - $sum % 10) % 10;
105             }
106 35         147 return $sum % 10;
107             } # _compute()
108              
109             sub _compute_checkdigit {
110 5     5   12 my ($self,$number) = @_;
111              
112 5 50       20 if ($number =~ /^(\d{9})..<+(\d{6}).<+(\d{6}).<+.$/) {
113 5         10 my @cd;
114 5         11 $cd[0] = $self->_compute($1);
115 5         11 $cd[1] = $self->_compute($2);
116 5         11 $cd[2] = $self->_compute($3);
117 5         23 $cd[3] = $self->_compute($1 . $cd[0] . $2 . $cd[1] . $3 . $cd[2]);
118 5         17 return @cd;
119             }
120 0           return ();
121             } # _compute_checkdigit()
122              
123             # Preloaded methods go here.
124              
125             1;
126             __END__