File Coverage

blib/lib/CTK/Digest/M11R.pm
Criterion Covered Total %
statement 37 37 100.0
branch 5 8 62.5
condition 3 5 60.0
subroutine 7 7 100.0
pod 1 1 100.0
total 53 58 91.3


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