line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Business::ISSN; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1464
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
67
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
14
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
61
|
|
6
|
2
|
|
|
2
|
|
11
|
no warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
81
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
1050
|
use subs qw(_common_format _checksum is_valid_checksum); |
|
2
|
|
|
|
|
46
|
|
|
2
|
|
|
|
|
11
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
123
|
use Exporter qw(import); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1638
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @EXPORT = qw(); |
13
|
|
|
|
|
|
|
our @EXPORT_OK = qw(is_valid_checksum); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '1.003'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
7
|
|
|
7
|
1
|
2660
|
my $class = shift; |
19
|
7
|
|
|
|
|
15
|
my $common_data = _common_format shift; |
20
|
|
|
|
|
|
|
|
21
|
7
|
100
|
|
|
|
18
|
return unless $common_data; |
22
|
|
|
|
|
|
|
|
23
|
5
|
|
|
|
|
13
|
my $self = bless {}, $class; |
24
|
|
|
|
|
|
|
|
25
|
5
|
|
|
|
|
12
|
$self->{'issn'} = $common_data; |
26
|
|
|
|
|
|
|
|
27
|
5
|
|
|
|
|
18
|
$common_data =~m/([0-9]{7,7})([0-9\dxX])$/; |
28
|
|
|
|
|
|
|
|
29
|
5
|
|
|
|
|
7
|
@{$self}{ qw(checksum code) } = ( $2, $1 ); |
|
5
|
|
|
|
|
23
|
|
30
|
|
|
|
|
|
|
|
31
|
5
|
|
|
|
|
14
|
$self->_check_validity; |
32
|
|
|
|
|
|
|
|
33
|
5
|
|
|
|
|
13
|
return $self; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
21
|
|
|
21
|
|
45
|
sub _issn { $_[0]->{'issn'} } |
37
|
13
|
|
|
13
|
1
|
1430
|
sub is_valid { $_[0]->{'valid'} } |
38
|
2
|
|
|
2
|
1
|
12
|
sub checksum { $_[0]->{'checksum'} } |
39
|
4
|
|
|
4
|
|
10
|
sub _hyphen_positions { 4 } |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub fix_checksum { |
42
|
4
|
|
|
4
|
1
|
8
|
my $self = shift; |
43
|
4
|
|
|
|
|
5
|
my $debug = 1; |
44
|
|
|
|
|
|
|
|
45
|
4
|
|
|
|
|
8
|
my $last_char = substr($self->_issn, -1, 1); |
46
|
|
|
|
|
|
|
|
47
|
4
|
|
|
|
|
8
|
my $checksum = _checksum $self->_issn; |
48
|
|
|
|
|
|
|
|
49
|
4
|
|
|
|
|
10
|
substr( $self->{issn}, -1, 1) = $checksum; |
50
|
|
|
|
|
|
|
|
51
|
4
|
|
|
|
|
11
|
$self->_check_validity; |
52
|
|
|
|
|
|
|
|
53
|
4
|
100
|
|
|
|
13
|
return 0 if $last_char eq $checksum; |
54
|
2
|
|
|
|
|
7
|
return 1; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub as_string { |
58
|
6
|
100
|
|
6
|
1
|
17
|
return unless $_[0]->is_valid; |
59
|
|
|
|
|
|
|
|
60
|
4
|
|
|
|
|
11
|
my $issn = $_[0]->_issn; |
61
|
|
|
|
|
|
|
|
62
|
4
|
|
|
|
|
11
|
substr($issn, $_[0]->_hyphen_positions, 0) = '-'; |
63
|
|
|
|
|
|
|
|
64
|
4
|
|
|
|
|
19
|
return $issn; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub is_valid_checksum { |
68
|
16
|
|
|
16
|
|
28
|
my $data = _common_format shift; |
69
|
16
|
100
|
|
|
|
33
|
return 0 unless $data; |
70
|
14
|
100
|
|
|
|
32
|
return 1 if substr($data, -1, 1) eq _checksum $data; |
71
|
6
|
|
|
|
|
13
|
return 0; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _check_validity { |
75
|
9
|
|
|
9
|
|
19
|
$_[0]->{'valid'} = is_valid_checksum( $_[0]->_issn ); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub _checksum { |
79
|
18
|
|
|
18
|
|
30
|
my $data = _common_format shift; |
80
|
|
|
|
|
|
|
|
81
|
18
|
50
|
|
|
|
34
|
return unless $data; |
82
|
|
|
|
|
|
|
|
83
|
18
|
|
|
|
|
54
|
my @digits = split //, $data; |
84
|
18
|
|
|
|
|
25
|
my $sum = 0; |
85
|
|
|
|
|
|
|
|
86
|
18
|
|
|
|
|
37
|
foreach( reverse 2..8 ) # oli 10 |
87
|
|
|
|
|
|
|
{ |
88
|
126
|
|
|
|
|
211
|
$sum += $_ * (shift @digits); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
#return what the check digit should be |
92
|
18
|
|
|
|
|
34
|
my $checksum = (11 - ($sum % 11))%11; |
93
|
|
|
|
|
|
|
|
94
|
18
|
100
|
|
|
|
46
|
$checksum = 'X' if $checksum == 10; |
95
|
|
|
|
|
|
|
|
96
|
18
|
|
|
|
|
55
|
return $checksum; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub _common_format { |
100
|
|
|
|
|
|
|
#we want uppercase X's |
101
|
41
|
|
|
41
|
|
73
|
my $data = uc shift; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
#get rid of everything except decimal digits and X |
104
|
41
|
|
|
|
|
116
|
$data =~ s/[^0-9X]//g; |
105
|
|
|
|
|
|
|
|
106
|
41
|
100
|
|
|
|
145
|
return $data if $data =~ m/^[0-9]{7}[0-9X]\z/; |
107
|
|
|
|
|
|
|
|
108
|
4
|
|
|
|
|
9
|
return; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
1; |
112
|
|
|
|
|
|
|
__END__ |