File Coverage

blib/lib/CTK/Digest/M11R.pm
Criterion Covered Total %
statement 39 39 100.0
branch 6 10 60.0
condition 3 5 60.0
subroutine 7 7 100.0
pod 1 1 100.0
total 56 62 90.3


line stmt bran cond sub pod time code
1             package CTK::Digest::M11R;
2 1     1   55578 use strict;
  1         7  
  1         23  
3 1     1   465 use utf8;
  1         12  
  1         4  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Digest::M11R - interface for modulus 11 (recursive) check digit calculation
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17             use CTK::Digest::M11R;
18             my $m11r = CTK::Digest::M11R->new();
19             my $digest = $m11r->digest( "123456789" ); # 5
20              
21             =head1 DESCRIPTION
22              
23             This is Digest backend module that provides calculate the modulus 11 (recursive) check digit
24              
25             =head1 METHODS
26              
27             =head2 digest
28              
29             my $digest = $m11r->digest( "123456789" ); # 5
30              
31             Returns M11R checkdigit by specified digits-string
32              
33             =head1 HISTORY
34              
35             See C file
36              
37             =head1 TO DO
38              
39             See C file
40              
41             =head1 BUGS
42              
43             * none noted
44              
45             =head1 SEE ALSO
46              
47             L, L, B
48              
49             =head1 AUTHOR
50              
51             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
52              
53             =head1 COPYRIGHT
54              
55             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
56              
57             =head1 LICENSE
58              
59             This program is free software; you can redistribute it and/or
60             modify it under the same terms as Perl itself.
61              
62             See C file and L
63              
64             =cut
65              
66 1     1   36 use vars qw/ $VERSION /;
  1         1  
  1         67  
67             $VERSION = 1.01;
68              
69 1     1   5 use Carp;
  1         1  
  1         42  
70              
71 1     1   330 use parent qw/CTK::Digest/;
  1         253  
  1         4  
72              
73             sub digest {
74             # See also: Algorithm::CheckDigits::M11_015 and check_okpo()
75 1     1 1 4 my $self = shift;
76 1         2 my $data = shift;
77 1 50       3 $self->{data} = $data if defined $data;
78 1         2 my $test = $self->{data};
79 1 50 33     7 croak "Incorrect input digit-string" if !$test || $test =~ m/[^0-9]/g;
80 1         2 my $len = length($test);
81 1 50       5 my $iters = ($len + (($len & 1) ? 1 : 0)) / 2;
82 1         6 my @digits = split(//, $test); # Get all digits from input string of chars
83             #printf "Test=%s; len=%d; iters=%d\n", $test, $len, $iters;
84              
85 1         1 my $w_lim = 10; # Maximum for round-robin(10) weight list: 1,2,3,4,5,6,7,8,9,10,1,2,3,4,5...
86 1         2 my $step = 2; # Step for weight list offset calculation for next iteration
87              
88             # Calculation sum for one weight list by ofset
89             my $calc = sub {
90 3   100 3   6 my $off = shift || 0;
91 3         4 my $s = 0;
92 3         4 for (my $i = 0; $i < $len; $i++) {
93 27         30 my $w = (($i + $off) % $w_lim) + 1;
94 27         38 $s += ($w * $digits[$i]);
95             #printf " > i=%d; d=%d; w=%d; sum=%d\n", $i, $digits[$i], $w, $s;
96             }
97 3         4 return $s % 11;
98 1         4 };
99              
100             # Main cycle
101 1         2 my $sum = 0;
102 1         4 for (my $j = 0; $j < $iters; $j++) {
103 3         4 my $offset = $j*$step;
104 3         4 $sum = $calc->($offset);
105             #printf " >> j=%d; offset=%d; sum=%d\n", $j, $offset, $sum;
106 3 100       9 last if $sum < 10;
107             }
108 1 50       3 $sum = 0 if $sum >= 10; # 0 if incorrect again
109             #printf " >>> sum=%d\n", $sum;
110              
111 1         7 return $sum;
112             }
113              
114             1;
115              
116             __END__