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__
|