File Coverage

blib/lib/Business/BR/Ids/Common.pm
Criterion Covered Total %
statement 37 43 86.0
branch 9 12 75.0
condition 8 12 66.6
subroutine 7 8 87.5
pod n/a
total 61 75 81.3


line stmt bran cond sub pod time code
1            
2             package Business::BR::Ids::Common;
3            
4 17     17   119425 use 5;
  17         59  
  17         1885  
5 17     17   119 use strict;
  17         37  
  17         490  
6 17     17   83 use warnings;
  17         36  
  17         6540  
7            
8             require Exporter;
9            
10             our @ISA = qw(Exporter);
11             our @EXPORT_OK = qw( _dot _dot_10 _canon_i _canon_id );
12            
13             our $VERSION = '0.0022';
14             $VERSION = eval $VERSION;
15            
16             sub _dot {
17 8120     8120   11570 my $a = shift;
18 8120         11551 my $b = shift;
19 8120 100       23940 warn "arguments a and b should have the same length"
20             unless (@$a==@$b);
21 8120         9470 my $s = 0;
22 8120         19128 for ( my $i=0; $i<@$a; $i++ ) {
23 84490         155945 my ($x, $y) = ($a->[$i], $b->[$i]);
24 84490 100 100     384732 if ($x && $y) {
25 69502         216397 $s += $x*$y;
26             }
27             }
28 8120         31900 return $s;
29             }
30            
31             sub _dot_10 {
32 403     403   1442 my $a = shift;
33 403         375 my $b = shift;
34 403 50       830 warn "arguments a and b should have the same length"
35             unless (@$a==@$b);
36 403         421 my $s = 0;
37 403         838 for ( my $i=0; $i<@$a; $i++ ) {
38 4821         14936 my ($x, $y) = ($a->[$i], $b->[$i]);
39 4821 100 100     16378 if ( $x && $y ) {
40 3978         4934 my $xy = $x*$y;
41 3978         33841 $s += $_ for split('', $xy); # sum each digit of the product
42             }
43             }
44 403         1149 return $s;
45             }
46            
47 17     17   106 use Scalar::Util qw(looks_like_number);
  17         47  
  17         8524  
48            
49             # usage: _canon_i($piece, size => 12)
50             sub _canon_i {
51 0     0   0 my $piece = shift;
52 0         0 my %options = @_;
53 0 0 0     0 if (looks_like_number($piece) && int($piece)==$piece) {
54 0         0 return sprintf('%0*s', $options{size}, $piece)
55             } else {
56 0         0 $piece =~ s/\D//g;
57 0         0 return $piece;
58             }
59             }
60            
61             sub _canon_id {
62 2927     2927   5786 my $piece = shift;
63 2927         7272 my %options = @_;
64 2927 100 66     18734 if (looks_like_number($piece) && int($piece)==$piece) {
65 2838         15655 return sprintf('%0*s', $options{size}, $piece)
66             } else {
67 89         688 $piece =~ s/[\W_]//g;
68 89         406 return $piece;
69             }
70             }
71            
72             1;
73            
74             __END__