File Coverage

blib/lib/Math/CheckDigits.pm
Criterion Covered Total %
statement 74 76 97.3
branch 28 38 73.6
condition 3 6 50.0
subroutine 12 12 100.0
pod 0 6 0.0
total 117 138 84.7


line stmt bran cond sub pod time code
1             package Math::CheckDigits;
2              
3 2     2   50369 use 5.006;
  2         8  
  2         81  
4 2     2   10 use strict;
  2         4  
  2         64  
5 2     2   10 use warnings;
  2         8  
  2         75  
6 2     2   1886 use integer;
  2         75  
  2         11  
7 2     2   2107 use utf8;
  2         21  
  2         14  
8             our $VERSION = '0.05';
9             $VERSION = eval $VERSION; ## no critic
10              
11             my %DEFAULT = (
12             trans_table => {},
13             options => {
14             start_at_right => 1, # multipule
15             DSR => 1, # use DSR or DR
16             runes => 0, # use runes
17             },
18             );
19              
20             sub new {
21 7     7 0 8342 my $cls = shift;
22 7         13 my $self = {};
23 7 100       18 if ( @_ == 2 ){
24 1         4 ( $self->{modulus}, $self->{weight} ) = @_
25             }
26             else {
27 6 100       25 $self = { %$self, ref $_[0] ? %{$_[0]} : @_ };
  2         7  
28             }
29 7 50 33     35 die 'not enough arguments!'
30             if !$self->{modulus} || !$self->{weight};
31              
32 7 100       18 if (!ref $self->{weight}) {
33 1         3 $self->{weight} = [$self->{weight}, 1];
34             }
35              
36 7         13 $self->{trans_table} = {
37 7 50       40 %{$DEFAULT{trans_table}},
38 7         11 %{$self->{trans_table} || {}},
39             };
40              
41 7         18 $self->{options} = {
42 7 50       39 %{$DEFAULT{options}},
43 7         10 %{$self->{options} || {}},
44             };
45              
46 7         31 bless $self, $cls;
47             }
48              
49             sub checkdigit {
50 15     15 0 698 my $self = shift;
51 15         56 my @digits = split //, shift;
52              
53 15 100       31 @digits = reverse @digits if $self->options('start_at_right');
54              
55 15         39 my $check_sum = $self->_calc_check_sum( $self->{weight}, @digits );
56 15         22 my $check_digit = $check_sum % $self->{modulus};
57              
58             # DSR or DR ?
59 15 50       42 $check_digit = $self->{modulus} - $check_digit if $self->options('DSR');
60              
61             # see trans table if exists. ( eg. 16 => 'g' )
62 15         30 my %trans_table = $self->trans_table;
63 15 100       32 $check_digit =
64             defined $trans_table{$check_digit} ?
65             $trans_table{$check_digit} : $check_digit;
66 15 50       26 $check_digit = 0 if length( $check_digit ) >= 2;
67              
68 15         626 return $check_digit;
69             }
70              
71             sub is_valid {
72 8     8 0 350 my ( $self, $digits ) = @_;
73 8         50 ( $digits, my $check_num )
74             = $digits =~ /^(.*)(.)$/;
75 8         17 return $self->checkdigit( $digits ) == $check_num;
76             }
77              
78             sub complete {
79 3     3 0 7 my ( $self, $digits ) = @_;
80 3         7 return $digits . $self->checkdigit( $digits );
81             }
82              
83             sub trans_table {
84 32     32 0 30 my $self = shift;
85 32 100       53 if ( @_ ){
86 2 50       14 $self->{trans_table} = ref $_[0] ? shift : { @_ };
87 2         5 return $self;
88             }
89 30         25 return %{$self->{trans_table}};
  30         112  
90             }
91              
92             sub options {
93 146     146 0 147 my $self = shift;
94              
95 146 50       245 return %{$self->{options}} if @_ == 0;
  0         0  
96 146 100 66     705 return $self->{options}{$_[0]} if (@_ == 1) && (!ref $_[0]);
97              
98 2         12 $self->{options}
99 2 50       4 = { %{$self->{options}}, ref $_[0] ? %{$_[0]} : @_ };
  0         0  
100              
101 2         7 return $self;
102             }
103              
104             sub _calc_check_sum {
105 15     15   19 my $self = shift;
106 15         43 my ( $weight, @digits ) = @_;
107              
108 15         31 my %trans_table = reverse $self->trans_table;
109 15         39 for ( keys %trans_table ){
110 11 50       24 delete $trans_table{$_} if /\d/;
111             }
112              
113 15         20 my ( $i, $check_sum ) = ( 0, 0 );
114 15         20 for my $digit ( @digits ){
115 114 100       169 my $num = defined $trans_table{$digit} ? $trans_table{$digit} : $digit;
116 114 50       222 die "'$num' does not map to number. Use trans_table method." if $num =~ /\D/;
117              
118 114         146 $num = $weight->[ $i % @$weight ] * $num;
119 114 100       172 if ( !$self->options('runes') ){
120 108         103 $check_sum += $num;
121             }
122             else{
123 6         15 my @nums = split //, $num;
124 6         17 $check_sum += $_ for @nums;
125             }
126 114         164 $i++;
127             }
128              
129 15         44 return $check_sum;
130             }
131              
132             1;
133             __END__