File Coverage

blib/lib/Algorithm/CheckDigits/M10_008.pm
Criterion Covered Total %
statement 44 48 91.6
branch 6 12 50.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 66 79 83.5


line stmt bran cond sub pod time code
1             package Algorithm::CheckDigits::M10_008;
2              
3 2     2   35 use 5.006;
  2         8  
4 2     2   10 use strict;
  2         19  
  2         41  
5 2     2   20 use warnings;
  2         4  
  2         55  
6 2     2   494 use integer;
  2         16  
  2         9  
7              
8 2     2   68 use version; our $VERSION = qv('v1.3.6');
  2         4  
  2         10  
9              
10             our @ISA = qw(Algorithm::CheckDigits);
11              
12             my @weight = ( 1,3,1,7,3,9,1 );
13              
14             my $value = 0;
15             my %ctable = map { $_, $value++ } ( '0'..'9', 'A'..'Z' );
16              
17             my $re_alpha = qr/[B-DF-HJ-NP-TV-Z]/;
18             my $re_alnum = qr/[0-9B-DF-HJ-NP-TV-Z]/;
19             my $re_sedol = qr/(\d{6}|$re_alpha$re_alnum{5})(\d)?/;
20              
21             sub new {
22 3     3 0 6 my $proto = shift;
23 3         7 my $type = shift;
24 3   33     15 my $class = ref($proto) || $proto;
25 3         8 my $self = bless({}, $class);
26 3         18 $self->{type} = lc($type);
27 3         15 return $self;
28             } # new()
29              
30             sub is_valid {
31 30     30 1 81 my $self = shift;
32 30         63 my $number = uc shift;
33              
34 30 50       238 if ($number =~ /^$re_sedol$/o) {
35 30         80 return $2 == $self->_compute_checkdigit($1);
36             }
37 0         0 return ''
38             } # is_valid()
39              
40             sub complete {
41 15     15 1 4197 my $self = shift;
42 15         36 my $number = uc shift;
43              
44 15 50       150 if ($number =~ /^$re_sedol$/o) {
45 15         43 return $number . $self->_compute_checkdigit($number);
46             }
47             else {
48 0         0 return '';
49             }
50             } # complete()
51              
52             sub basenumber {
53 15     15 1 28 my $self = shift;
54 15         32 my $number = uc shift;
55              
56 15 50       142 if ($number =~ /^$re_sedol$/o) {
57 15 50       37 return $1 if ($2 == $self->_compute_checkdigit($1));
58             }
59 0         0 return '';
60             } # basenumber()
61              
62             sub checkdigit {
63 15     15 1 29 my $self = shift;
64 15         33 my $number = uc shift;
65              
66 15 50       149 if ($number =~ /^$re_sedol$/o) {
67 15 50       37 return $2 if ($2 == $self->_compute_checkdigit($1));
68             }
69 0         0 return '';
70             } # checkdigit()
71              
72             sub _compute_checkdigit {
73 75     75   109 my $self = shift;
74 75         152 my $number = shift;
75              
76              
77 75         241 my @digits = map { $ctable{$_} } split(//,$number);
  450         839  
78 75         153 my $sum = 0;
79              
80 75         191 for (my $i = 0; $i <= $#digits; $i++) {
81              
82 450         902 $sum += $weight[$i] * $digits[$i];
83              
84             }
85 75         486 return (10 - ($sum % 10)) % 10;
86             } # _compute_checkdigit()
87              
88             # Preloaded methods go here.
89              
90             1;
91             __END__