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 12     12   252 use 5.008;
  12         54  
2              
3             package Business::ISBN13;
4 12     12   64 use strict;
  12         18  
  12         331  
5 12     12   44 use base qw(Business::ISBN);
  12         17  
  12         1119  
6              
7 12     12   49 use Business::ISBN qw(:all);
  12         19  
  12         1366  
8 12     12   5974 use Data::Dumper;
  12         76737  
  12         779  
9              
10 12     12   71 use Carp qw(carp croak cluck);
  12         18  
  12         5015  
11              
12             my $debug = 0;
13              
14             our $VERSION = '3.015_02';
15              
16 46     46   79 sub _max_length { 13 }
17              
18 50     50   94 sub _set_type { $_[0]->{type} = 'ISBN13' }
19              
20             sub _parse_prefix {
21 50     50   108 my $isbn = $_[0]->isbn; # stupid workaround for 'Can't modify non-lvalue subroutine call'
22 50         171 ( $isbn =~ /\A(97[89])(.{10})\z/g )[0];
23             }
24              
25             sub _set_prefix {
26 50 100   50   4512 croak "Cannot set prefix [$_[1]] on an ISBN-13"
27             unless $_[1] =~ m/\A97[89]\z/;
28              
29 48         102 $_[0]->{prefix} = $_[1];
30             }
31              
32             sub _hyphen_positions {
33             [
34 9     9   23 $_[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 1001 my $self = shift;
45              
46 1 50       5 return unless $self->prefix eq '978';
47              
48 1         4 my $isbn10 = Business::ISBN->new(
49             substr( $self->isbn, 3 )
50             );
51 1         5 $isbn10->fix_checksum;
52              
53 1         2 return $isbn10;
54             }
55              
56             sub as_isbn13 {
57 1     1 1 661 my $self = shift;
58              
59 1         26 my $isbn13 = Business::ISBN->new( $self->as_string );
60 1         6 $isbn13->fix_checksum;
61              
62 1         2 return $isbn13;
63             }
64              
65             #internal function. you don't get to use this one.
66             sub _checksum {
67 66     66   105 my $data = $_[0]->isbn;
68              
69 66 50       98 return unless defined $data;
70              
71 66         68 my $sum = 0;
72              
73 66         90 foreach my $index ( 0, 2, 4, 6, 8, 10 )
74             {
75 396         435 $sum += substr($data, $index, 1);
76 396         477 $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 66         118 my $checksum = ( 10 * ( int( $sum / 10 ) + 1 ) - $sum ) % 10;
83              
84 66         239 return $checksum;
85             }
86              
87             1;
88              
89             __END__