File Coverage

blib/lib/Business/ISBN13.pm
Criterion Covered Total %
statement 41 41 100.0
branch 4 6 66.6
condition n/a
subroutine 14 14 100.0
pod 2 2 100.0
total 61 63 96.8


line stmt bran cond sub pod time code
1 8     8   169 use 5.008;
  8         33  
2              
3             package Business::ISBN13;
4 8     8   53 use strict;
  8         17  
  8         317  
5 8     8   51 use base qw(Business::ISBN);
  8         18  
  8         1021  
6              
7 8     8   87 use Business::ISBN qw(:all);
  8         19  
  8         1283  
8 8     8   5321 use Data::Dumper;
  8         89299  
  8         763  
9              
10 8     8   67 use Carp qw(carp croak cluck);
  8         15  
  8         4816  
11              
12             my $debug = 0;
13              
14             our $VERSION = '3.013';
15              
16 32     32   122 sub _max_length { 13 }
17              
18 35     35   185 sub _set_type { $_[0]->{type} = 'ISBN13' }
19              
20             sub _parse_prefix {
21 35     35   128 my $isbn = $_[0]->isbn; # stupid workaround for 'Can't modify non-lvalue subroutine call'
22 35         257 ( $isbn =~ /\A(97[89])(.{10})\z/g )[0];
23             }
24              
25             sub _set_prefix {
26 36 100   36   1190 croak "Cannot set prefix [$_[1]] on an ISBN-13"
27             unless $_[1] =~ m/\A97[89]\z/;
28              
29 34         136 $_[0]->{prefix} = $_[1];
30             }
31              
32             sub _hyphen_positions {
33             [
34 9     9   44 $_[0]->_prefix_length,
35             $_[0]->_prefix_length + $_[0]->_group_code_length,
36             $_[0]->_prefix_length + $_[0]->_group_code_length + $_[0]->_publisher_code_length,
37             $_[0]->_checksum_pos,
38             ]
39             }
40              
41             # sub group { 'Bookland' }
42              
43             sub as_isbn10 {
44 1     1 1 7 my $self = shift;
45              
46 1 50       23 return unless $self->prefix eq '978';
47              
48 1         5 my $isbn10 = Business::ISBN->new(
49             substr( $self->isbn, 3 )
50             );
51 1         11 $isbn10->fix_checksum;
52              
53 1         5 return $isbn10;
54             }
55              
56             sub as_isbn13 {
57 1     1 1 3 my $self = shift;
58              
59 1         7 my $isbn13 = Business::ISBN->new( $self->as_string );
60 1         11 $isbn13->fix_checksum;
61              
62 1         4 return $isbn13;
63             }
64              
65             #internal function. you don't get to use this one.
66             sub _checksum {
67 53     53   188 my $data = $_[0]->isbn;
68              
69 53 50       229 return unless defined $data;
70              
71 53         89 my $sum = 0;
72              
73 53         136 foreach my $index ( 0, 2, 4, 6, 8, 10 )
74             {
75 318         647 $sum += substr($data, $index, 1);
76 318         618 $sum += 3 * substr($data, $index + 1, 1);
77             }
78              
79             #take the next higher multiple of 10 and subtract the sum.
80             #if $sum is 37, the next highest multiple of ten is 40. the
81             #check digit would be 40 - 37 => 3.
82 53         201 my $checksum = ( 10 * ( int( $sum / 10 ) + 1 ) - $sum ) % 10;
83              
84 53         331 return $checksum;
85             }
86              
87             1;
88              
89             __END__