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   123770 use strict;
  8         30  
  8         202  
4 8     8   34 use warnings;
  8         25  
  8         327  
5              
6             our $VERSION = '1.04';
7              
8             #----------------------------------------------------------------------------
9             # Library Modules
10              
11 8     8   48 use Carp;
  8         13  
  8         6786  
12              
13             #----------------------------------------------------------------------------
14             # Public API
15              
16             # Preloaded methods go here.
17             sub new {
18 11     11 1 664 my $proto = shift;
19 11   66     46 my $class = ref($proto) || $proto;
20              
21 11         42 my $self = {
22             FOUND => 0,
23             VERBOSITY => 0,
24             BOOK => undef,
25             ERROR => ''
26             };
27            
28 11         22 bless ($self, $class);
29 11         25 return $self;
30             }
31              
32 15     15 1 832 sub found { my $self = shift; return $self->_accessor('FOUND',@_) }
  15         32  
33 6     6 1 433 sub verbosity { my $self = shift; return $self->_accessor('VERBOSITY',@_) }
  6         13  
34 6     6 1 441 sub book { my $self = shift; return $self->_accessor('BOOK',@_) }
  6         17  
35 8     8 1 425 sub error { my $self = shift; return $self->_accessor('ERROR',@_) }
  8         18  
36              
37             sub _accessor {
38 35     35   43 my $self = shift;
39 35         45 my $accessor = shift;
40 35 100       68 if (@_) { $self->{$accessor} = shift };
  14         26  
41 35         136 return $self->{$accessor};
42             }
43              
44             sub search {
45 2     2 1 630 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 462 my $self = shift;
54 4 100       12 if (@_) {
55 3         7 $self->{ERROR} = shift;
56 3 100       8 print "Error: $self->{ERROR}\n" if $self->verbosity;
57             };
58 4         27 return $self->found(0);
59             }
60              
61             sub convert_to_ean13 {
62 23     23 1 5812 my $self = shift;
63 23   50     59 my $isbn = shift || return;
64 23         39 my $prefix;
65              
66 23 100 100     88 return unless(length $isbn == 10 || length $isbn == 13);
67              
68 22 100       49 if(length $isbn == 13) {
69 14 100       86 return if($isbn !~ /^(978|979)(\d{10})$/);
70 12         45 ($prefix,$isbn) = ($1,$2);
71             } else {
72 8 100       61 return if($isbn !~ /^(\d{10}|\d{9}X)$/);
73 7         13 $prefix = '978';
74             }
75              
76 19         39 my $isbn13 = $prefix . $isbn;
77 19         36 chop($isbn13);
78 19         75 my @isbn = split(//,$isbn13);
79 19         38 my ($lsum,$hsum) = (0,0);
80 19         47 while(@isbn) {
81 114         164 $hsum += shift @isbn;
82 114         216 $lsum += shift @isbn;
83             }
84              
85 19         50 my $csum = ($lsum * 3) + $hsum;
86 19         30 $csum %= 10;
87 19 100       45 $csum = 10 - $csum if($csum != 0);
88              
89 19         80 return $isbn13 . $csum;
90             }
91              
92             sub convert_to_isbn10 {
93 16     16 1 30 my $self = shift;
94 16   50     48 my $ean = shift || return;
95 16         38 my ($isbn,$isbn10);
96              
97 16 100 100     67 return unless(length $ean == 10 || length $ean == 13);
98              
99 15 100       35 if(length $ean == 13) {
100 10 100       62 return if($ean !~ /^(?:978|979)(\d{9})\d$/);
101 9         32 ($isbn,$isbn10) = ($1,$1);
102             } else {
103 5 100       29 return if($ean !~ /^(\d{9})[\dX]$/);
104 4         15 ($isbn,$isbn10) = ($1,$1);
105             }
106              
107 13         27 my ($csum, $pos, $digit) = (0, 0, 0);
108 13         36 for ($pos = 9; $pos > 0; $pos--) {
109 117         168 $digit = $isbn % 10;
110 117         155 $isbn /= 10; # Decimal shift ISBN for next time
111 117         206 $csum += ($pos * $digit);
112             }
113 13         19 $csum %= 11;
114 13 100       29 $csum = 'X' if ($csum == 10);
115 13         138 return $isbn10 . $csum;
116             }
117              
118             sub is_valid {
119 11     11 1 19 my $self = shift;
120 11 100       29 my $isbn = shift or return 0;
121              
122             # validate and convert into EAN13 format
123 10         22 my $ean = $self->convert_to_ean13($isbn);
124              
125 10 100       22 return 0 if(!$ean);
126 9 100 100     32 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         32 return 1;
130             }
131              
132             1;
133              
134             __END__