File Coverage

blib/lib/WWW/Scraper/ISBN/Driver.pm
Criterion Covered Total %
statement 77 77 100.0
branch 34 34 100.0
condition 16 19 84.2
subroutine 14 14 100.0
pod 10 10 100.0
total 151 154 98.0


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::Driver;
2              
3 8     8   33452 use strict;
  8         16  
  8         267  
4 8     8   34 use warnings;
  8         10  
  8         342  
5              
6             our $VERSION = '1.03';
7              
8             #----------------------------------------------------------------------------
9             # Library Modules
10              
11 8     8   73 use Carp;
  8         16  
  8         7211  
12              
13             #----------------------------------------------------------------------------
14             # Public API
15              
16             # Preloaded methods go here.
17             sub new {
18 11     11 1 717 my $proto = shift;
19 11   66     38 my $class = ref($proto) || $proto;
20              
21 11         34 my $self = {
22             FOUND => 0,
23             VERBOSITY => 0,
24             BOOK => undef,
25             ERROR => ''
26             };
27            
28 11         20 bless ($self, $class);
29 11         22 return $self;
30             }
31              
32 15     15 1 903 sub found { my $self = shift; return $self->_accessor('FOUND',@_) }
  15         24  
33 6     6 1 389 sub verbosity { my $self = shift; return $self->_accessor('VERBOSITY',@_) }
  6         14  
34 6     6 1 431 sub book { my $self = shift; return $self->_accessor('BOOK',@_) }
  6         13  
35 8     8 1 389 sub error { my $self = shift; return $self->_accessor('ERROR',@_) }
  8         16  
36              
37             sub _accessor {
38 35     35   29 my $self = shift;
39 35         30 my $accessor = shift;
40 35 100       58 if (@_) { $self->{$accessor} = shift };
  14         18  
41 35         258 return $self->{$accessor};
42             }
43              
44             sub search {
45 2     2 1 600 croak(q{Child class must overload 'search()' method.});
46             }
47              
48             #----------------------------------------------------------------------------
49             # Internal Class methods
50              
51             # a generic method for storing the error & setting not found
52             sub handler {
53 4     4 1 419 my $self = shift;
54 4 100       13 if (@_) {
55 3         6 $self->{ERROR} = shift;
56 3 100       10 print "Error: $self->{ERROR}\n" if $self->verbosity;
57             };
58 4         10 return $self->found(0);
59             }
60              
61             sub convert_to_ean13 {
62 23     23 1 3218 my $self = shift;
63 23   50     48 my $isbn = shift || return;
64 23         17 my $prefix;
65              
66 23 100 100     91 return unless(length $isbn == 10 || length $isbn == 13);
67              
68 22 100       58 if(length $isbn == 13) {
69 14 100       68 return if($isbn !~ /^(978|979)(\d{10})$/);
70 12         34 ($prefix,$isbn) = ($1,$2);
71             } else {
72 8 100       41 return if($isbn !~ /^(\d{10}|\d{9}X)$/);
73 7         10 $prefix = '978';
74             }
75              
76 19         32 my $isbn13 = $prefix . $isbn;
77 19         34 chop($isbn13);
78 19         82 my @isbn = split(//,$isbn13);
79 19         29 my ($lsum,$hsum) = (0,0);
80 19         37 while(@isbn) {
81 114         115 $hsum += shift @isbn;
82 114         178 $lsum += shift @isbn;
83             }
84              
85 19         29 my $csum = ($lsum * 3) + $hsum;
86 19         20 $csum %= 10;
87 19 100       33 $csum = 10 - $csum if($csum != 0);
88              
89 19         66 return $isbn13 . $csum;
90             }
91              
92             sub convert_to_isbn10 {
93 16     16 1 18 my $self = shift;
94 16   50     35 my $ean = shift || return;
95 16         15 my ($isbn,$isbn10);
96              
97 16 100 100     64 return unless(length $ean == 10 || length $ean == 13);
98              
99 15 100       23 if(length $ean == 13) {
100 10 100       49 return if($ean !~ /^(?:978|979)(\d{9})\d$/);
101 9         30 ($isbn,$isbn10) = ($1,$1);
102             } else {
103 5 100       22 return if($ean !~ /^(\d{9})[\dX]$/);
104 4         12 ($isbn,$isbn10) = ($1,$1);
105             }
106              
107 13         18 my ($csum, $pos, $digit) = (0, 0, 0);
108 13         31 for ($pos = 9; $pos > 0; $pos--) {
109 117         94 $digit = $isbn % 10;
110 117         80 $isbn /= 10; # Decimal shift ISBN for next time
111 117         166 $csum += ($pos * $digit);
112             }
113 13         12 $csum %= 11;
114 13 100       22 $csum = 'X' if ($csum == 10);
115 13         125 return $isbn10 . $csum;
116             }
117              
118             sub is_valid {
119 11     11 1 12 my $self = shift;
120 11 100       27 my $isbn = shift or return 0;
121              
122             # validate and convert into EAN13 format
123 10         18 my $ean = $self->convert_to_ean13($isbn);
124              
125 10 100       17 return 0 if(!$ean);
126 9 100 100     42 return 0 if(length $isbn == 13 && $isbn ne $ean);
127 8 100 100     27 return 0 if(length $isbn == 10 && $isbn ne $self->convert_to_isbn10($ean));
128              
129 6         29 return 1;
130             }
131              
132             1;
133              
134             __END__