File Coverage

blib/lib/Algorithm/CheckDigits/M16_001.pm
Criterion Covered Total %
statement 44 49 89.8
branch 8 16 50.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 68 84 80.9


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::M16_001;
2              
3 1     1   19 use 5.006;
  1         4  
4 1     1   7 use strict;
  1         2  
  1         23  
5 1     1   5 use warnings;
  1         2  
  1         32  
6 1     1   7 use integer;
  1         2  
  1         5  
7              
8 1     1   22 use version; our $VERSION = 'v1.3.5';
  1         3  
  1         5  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             sub new {
13 1     1 0 3 my $proto = shift;
14 1         2 my $type = shift;
15 1   33     9 my $class = ref($proto) || $proto;
16 1         2 my $self = bless({}, $class);
17 1         8 $self->{type} = lc($type);
18 1         6 return $self;
19             } # new()
20              
21             sub is_valid {
22 2     2 1 11 my ($self,$number) = @_;
23 2 50       10 if ($number =~ /^([0-9a-f]{15})([0-9a-f])$/i) {
24 2         7 return $2 eq $self->_compute_checkdigit($1);
25             }
26 0         0 return ''
27             } # is_valid()
28              
29             sub complete {
30 1     1 1 95 my ($self,$number) = @_;
31 1 50       6 if ($number =~ /^[0-9a-f]{15}$/i) {
32 1         4 return $number . $self->_compute_checkdigit($number);
33             }
34 0         0 return '';
35             } # complete()
36              
37             sub basenumber {
38 1     1 1 3 my ($self,$number) = @_;
39 1 50       7 if ($number =~ /^([0-9a-f]{15})([0-9a-f])$/i) {
40 1 50       4 return $1 if (uc($2) eq $self->_compute_checkdigit($1));
41             }
42 0         0 return '';
43             } # basenumber()
44              
45             sub checkdigit {
46 1     1 1 3 my ($self,$number) = @_;
47 1 50       7 if ($number =~ /^([0-9a-f]{15})([0-9a-f])$/i) {
48 1 50       7 return $2 if (uc($2) eq $self->_compute_checkdigit($1));
49             }
50 0         0 return '';
51             } # checkdigit()
52              
53             sub _compute_checkdigit {
54 5     5   9 my $self = shift;
55 5         11 my $number = shift;
56              
57 5 50       17 if ($number =~ /^[0-9a-f]{15}$/i) {
58 5         9 my ($a,$b,$c);
59              
60 5         23 my @digits = split(//,$number);
61 5         8 $a = 16;
62              
63 5         15 for (my $i = 0; $i <= $#digits; $i++) {
64              
65 75         120 $b = ($a % 17) + hex($digits[$i]);
66 75         86 $c = $b % 16;
67 75 50       148 $c = 16 unless ($c);
68 75         153 $a = 2 * $c;
69              
70             }
71 5         51 return sprintf("%X",(17 - ($a % 17)) % 16);
72             }
73 0           return -1;
74             } # _compute_checkdigit()
75              
76             # Preloaded methods go here.
77              
78             1;
79             __END__