File Coverage

blib/lib/WWW/Scraper/ISBN/GoogleBooks_Driver.pm
Criterion Covered Total %
statement 118 127 92.9
branch 28 54 51.8
condition 7 21 33.3
subroutine 14 14 100.0
pod 1 1 100.0
total 168 217 77.4


!si; !si; !si; !i; !i; !si unless($data->{author});
line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::GoogleBooks_Driver;
2              
3 6     6   133495 use strict;
  6         18  
  6         277  
4 6     6   34 use warnings;
  6         12  
  6         500  
5 6     6   4186 use utf8;
  6         72  
  6         38  
6              
7 6     6   254 use vars qw($VERSION @ISA);
  6         12  
  6         517  
8             $VERSION = '0.29';
9              
10             #--------------------------------------------------------------------------
11              
12             =head1 NAME
13              
14             WWW::Scraper::ISBN::GoogleBooks_Driver - Search driver for Google Books online book catalog.
15              
16             =head1 SYNOPSIS
17              
18             See parent class documentation (L)
19              
20             =head1 DESCRIPTION
21              
22             Searches for book information from Google Books online book catalog
23              
24             =cut
25              
26             #--------------------------------------------------------------------------
27              
28             ###########################################################################
29             # Inheritence
30              
31 6     6   30 use base qw(WWW::Scraper::ISBN::Driver);
  6         8  
  6         3261  
32              
33             ###########################################################################
34             # Modules
35              
36 6     6   9332 use HTML::Entities;
  6         35791  
  6         648  
37 6     6   3317 use JSON;
  6         59975  
  6         40  
38 6     6   6954 use WWW::Mechanize;
  6         912215  
  6         377  
39              
40             ###########################################################################
41             # Constants & Variables
42              
43             my $DOMAIN = 'http://books.google.com';
44              
45 6     6   71 use constant SEARCH => '/books?jscmd=viewapi&callback=bookdata&bibkeys=ISBN:';
  6         8  
  6         503  
46 6     6   64 use constant LB2G => 453.59237; # number of grams in a pound (lb)
  6         10  
  6         351  
47 6     6   29 use constant OZ2G => 28.3495231; # number of grams in an ounce (oz)
  6         8  
  6         349  
48 6     6   27 use constant IN2MM => 25.4; # number of inches in a millimetre (mm)
  6         10  
  6         14458  
49              
50             my %LANG = (
51             'cz' => { Publisher => 'Vydavatel', Author => 'Autor', Title => 'Titul', Length => [ 'Délka', qr/\QD\x{e9}lka\E/, 'Délka' ],
52             Pages => [ 'Počet stran:', qr/\QPo\x{10d}et stran:\E/, 'Počet stran:' ] },
53             'de' => { Publisher => 'Verlag', Author => 'Autor', Title => 'Titel', Length => qr{L.+nge}, Pages => 'Seiten' },
54             'en' => { Publisher => 'Publisher', Author => 'Author', Title => 'Title', Length => 'Length', Pages => 'pages' },
55             'es' => { Publisher => 'Editor', Author => 'Autor', Title => 'Título', Length => [ 'N.º de páginas', 'N.º de páginas' ],
56             Pages => [ 'páginas', 'páginas' ] },
57             'fr' => { Publisher => '.+diteur', Author => 'Auteur', Title => 'Titre', Length => 'Longueur', Pages => 'pages' },
58             'fi' => { Publisher => 'Kustantaja', Author => 'Kirjoittaja', Title => 'Otsikko', Length => 'Pituus', Pages => 'sivua' },
59             'nl' => { Publisher => 'Uitgever', Author => 'Auteur', Title => 'Titel', Length => 'Lengte', Pages => [ q{pagina's}, 'pagina's' ] },
60             'md' => { Publisher => 'Editor', Author => 'Autor', Title => 'Titlu', Length => 'Lungime', Pages => 'pagini' },
61             'ru' => { Publisher => ['Издатель', qr/\Q\x{418}\x{437}\x{434}\x{430}\x{442}\x{435}\x{43b}\x{44c}\E/, 'Издатель', 'Издатель' ],
62             Author => 'Автор', Title => 'Название',
63             Length => [ 'Количество страниц', qr/\Q\x{41a}\x{43e}\x{43b}\x{438}\x{447}\x{435}\x{441}\x{442}\x{432}\x{43e} \x{441}\x{442}\x{440}\x{430}\x{43d}\x{438}\x{446}/, 'Количество страниц', 'Количество страниц' ],
64             Pages => [ 'Всего страниц:', qr/\Q\x{412}\x{441}\x{435}\x{433}\x{43e} \x{441}\x{442}\x{440}\x{430}\x{43d}\x{438}\x{446}:/, 'Всего страниц:', 'Всего страниц', 'Всего страниц:' ] },
65             'iw' => { Publisher => [ '\x{5d4}\x{5d5}\x{5e6}\x{5d0}\x{5d4}', 'הוצאה' ],
66             Author => 'Author', Title => 'Title', Length => [ qr/\Q\x{5d0}\x{5d5}\x{5e8}\x{5da}\E/, 'אורך', '\x{5d0}\x{5d5}\x{5e8}\x{5da}', 'אורך' ],
67             Pages => [ qr/\Q\x{5e2}\x{5de}\x{5d5}\x{5d3}\x{5d9}\x{5dd}\E/, 'עמודים', '\x{5e2}\x{5de}\x{5d5}\x{5d3}\x{5d9}\x{5dd}', 'עמודים' ] }
68             );
69              
70             #--------------------------------------------------------------------------
71              
72             ###########################################################################
73             # Public Interface
74              
75             =head1 METHODS
76              
77             =over 4
78              
79             =item C
80              
81             Creates a query string, then passes the appropriate form fields to the
82             GoogleBooks server.
83              
84             The returned page should be the correct catalog page for that ISBN. If not the
85             function returns zero and allows the next driver in the chain to have a go. If
86             a valid page is returned, the following fields are returned via the book hash:
87              
88             isbn (now returns isbn13)
89             isbn10
90             isbn13
91             ean13 (industry name)
92             author
93             title
94             book_link
95             image_link
96             pubdate
97             publisher
98             description (if available)
99             pages (if known)
100              
101             The book_link and image_link refer back to the GoogleBooks website.
102              
103             =back
104              
105             =cut
106              
107             sub search {
108 2     2 1 9401 my $self = shift;
109 2         7 my $isbn = shift;
110 2         3 my $data;
111 2         10 $self->found(0);
112 2         33 $self->book(undef);
113              
114             # validate and convert into EAN13 format
115 2         20 my $ean = $self->convert_to_ean13($isbn);
116 2 50       112 return $self->handler("Invalid ISBN specified")
117             unless($ean);
118              
119 2         14 my $mech = WWW::Mechanize->new();
120 2         24652 $mech->agent_alias( 'Linux Mozilla' );
121              
122 2   33     168 my $search = ($ENV{GOOGLE_DOMAIN} || $DOMAIN) . SEARCH . $ean;
123 2         5 eval { $mech->get( $search ) };
  2         7  
124 2 50 33     318453 return $self->handler("GoogleBooks website appears to be unavailable.")
      33        
125             if($@ || !$mech->success() || !$mech->content());
126              
127 2         127 my $json = $mech->content();
128              
129 2 50       36 return $self->handler("Failed to find that book on GoogleBooks website.")
130             if($json eq 'bookdata({});');
131              
132 2         16 $json =~ s/^bookdata\(//;
133 2         11 $json =~ s/\);$//;
134              
135 2         46 my $code = decode_json($json);
136             #use Data::Dumper;
137             #print STDERR "\n# code=".Dumper($code);
138              
139 2 50 33     15 return $self->handler("Failed to find that book on GoogleBooks website.")
140             unless($code->{'ISBN:'.$ean} || $code->{'ISBN:'.$isbn});
141              
142 2         42 $data->{url} = $code->{'ISBN:'.$ean }{info_url};
143 2   33     9 $data->{url} ||= $code->{'ISBN:'.$isbn}{info_url};
144              
145 2 50       9 return $self->handler("Failed to find that book on GoogleBooks website.")
146             unless($data->{url});
147              
148 2         5 eval { $mech->get( $data->{url} ) };
  2         14  
149 2 50 33     678525 return $self->handler("GoogleBooks website appears to be unavailable.")
      33        
150             if($@ || !$mech->success() || !$mech->content());
151              
152             # The Book page
153             #my $html = $mech->content();
154 2         147 my $html = encode_entities($mech->content(),'^\n\x20-\x25\x27-\x7e');
155 2         12056 $html =~ s/\'/'/sig;
156 2         7081 $html =~ s/\\x\(([a-z\d]+)\)/\&#$1;/sig;
157 2         648 $html =~ s/7/7/sig;
158              
159 2 50       5979 return $self->handler("Failed to find that book on GoogleBooks website. [$isbn]")
160             if($html =~ m!Sorry, we couldn't find any matches for!si);
161              
162             #use Data::Dumper;
163             #print STDERR "\n# " . Dumper($data);
164             #print STDERR "\n# html=[$html]\n";
165              
166 2         23 $data->{url} = $mech->uri();
167 2         96 my ($ccTLD) = $data->{url} =~ m{^http://[.\w]+\.google\.(\w\w)\b};
168              
169 2         34 my $lang = 'en'; # English (default)
170 2 50       6 $lang = 'de' if($data->{url} =~ m{^http://[.\w]+\.google\.(de|ch|at)\b}); # German
171 2 50       23 $lang = 'iw' if($data->{url} =~ m{^http://[.\w]+\.google\.co\.il\b}); # Hebrew
172 2 50       22 $lang = $ccTLD if($LANG{$ccTLD}); # we have a ccTLD translation
173              
174 2 50       9 return $self->handler("Language '".uc $lang."'not currently supported, patches welcome.")
175             if($lang =~ m!xx!);
176              
177 2         8 _match( $html, $data, $lang );
178              
179             # remove HTML tags
180 2         6 for(qw(author)) {
181 2 50       7 next unless(defined $data->{$_});
182 2         24 $data->{$_} =~ s!<[^>]+>!!g;
183             }
184              
185             # trim top and tail
186 2 50       9 for(keys %$data) { next unless(defined $data->{$_});$data->{$_} =~ s/^\s+//;$data->{$_} =~ s/\s+$//; }
  22         34  
  22         52  
  22         114  
187              
188             # .com (and possibly others) don't always use Google's own CDN
189 2 50       11 if($data->{image} =~ m!^/!) {
190 0         0 my $domain = $mech->uri();
191 0         0 $domain = s!^(http://[^/]+).*$!$1!;
192 0         0 $data->{image} = $domain . $data->{image};
193 0         0 $data->{thumb} = $data->{image};
194             }
195              
196 2         13 my $url = $mech->uri();
197              
198 2         68 my $bk = {
199             'ean13' => $data->{isbn13},
200             'isbn13' => $data->{isbn13},
201             'isbn10' => $data->{isbn10},
202             'isbn' => $data->{isbn13},
203             'author' => $data->{author},
204             'title' => $data->{title},
205             'book_link' => "$url",
206             'image_link' => $data->{image},
207             'thumb_link' => $data->{thumb},
208             'pubdate' => $data->{pubdate},
209             'publisher' => $data->{publisher},
210             'description' => $data->{description},
211             'pages' => $data->{pages},
212             'html' => $html
213             };
214              
215             #use Data::Dumper;
216             #print STDERR "\n# book=".Dumper($bk);
217              
218 2         142 $self->book($bk);
219 2         29 $self->found(1);
220 2         19 return $self->book;
221             }
222              
223             =head2 Private Methods
224              
225             =over 4
226              
227             =item C<_match>
228              
229             Pattern matches for book page.
230              
231             =back
232              
233             =cut
234              
235             sub _match {
236 2     2   79 my ($html, $data, $lang) = @_;
237 2         5 my ($publisher);
238              
239             #print "\n# lang=$lang\n";
240              
241             # Some pages can present publisher text in multiple styles
242 2 50       17 my @pubs = ref($LANG{$lang}->{Publisher}) eq 'ARRAY' ? @{$LANG{$lang}->{Publisher}} : ($LANG{$lang}->{Publisher});
  0         0  
243 2         6 for my $pub (@pubs) {
244 2         5380 ($publisher) = $html =~ m!(?:]*>)?$pub(?:)?(?:]*>)?([^<]+)(?:)?
245 2 50       22 last if($publisher);
246             }
247 2 50       7 if($publisher) {
248 2         53 my @publist = split(qr/\s*,\s*/,$publisher);
249 2         11 $data->{publisher} = $publist[0];
250 2         8 $data->{pubdate} = $publist[-1];
251             }
252              
253             # Some pages can present length/pages text in multiple styles
254 2 50       12 my @lengths = ref($LANG{$lang}->{Length}) eq 'ARRAY' ? @{$LANG{$lang}->{Length}} : ($LANG{$lang}->{Length});
  0         0  
255 2 50       14 my @pages = ref($LANG{$lang}->{Pages}) eq 'ARRAY' ? @{$LANG{$lang}->{Pages}} : ($LANG{$lang}->{Pages});
  0         0  
256 2         4 for my $length (@lengths) {
257 2         5 for my $page (@pages) {
258 2         5198 ($data->{pages}) = $html =~ m!(?:]*>)?$length(?:)?(?:]*>)?(\d+)\s*$page(?:)?
259 2 50       16 last if($data->{pages});
260 0         0 ($data->{pages}) = $html =~ m!(?:]*>)?$length(?:)?(?:]*>)?\s*$page\s+(\d+)(?:)?
261 0 0       0 last if($data->{pages});
262             }
263 2 50       8 last if($data->{pages});
264             }
265              
266             # get ISBN styles
267 2         4280 my ($isbns) = $html =~ m!(?:]*>)?ISBN(?:)?(?:]*>)?([^<]+)(?:)?
268 2         39 my (@isbns) = split(qr/\s*,\s*/,$isbns);
269 2         7 for my $value (@isbns) {
270 4 100       16 $data->{isbn13} = $value if(length $value == 13);
271 4 100       16 $data->{isbn10} = $value if(length $value == 10);
272             }
273              
274             #use Data::Dumper;
275             #print STDERR "\n# isbns=[$isbns]";
276             #print STDERR "\n# " . Dumper($data);
277              
278             # get other fields
279 2         5685 ($data->{image}) = $html =~ m!
]+id=summary-frontcover[^>]*>
!i;
280 2 50       10 ($data->{image}) = $html =~ m!
]+>]+id=summary-frontcover[^>]*>
!i unless($data->{image});
281 2         3759 ($data->{author}) = $html =~ m!(?:]*>)?$LANG{$lang}->{Author}(?:)?(.*?)
282 2 50       11 ($data->{author}) = $html =~ m!([^<]+)
283 2         3489 ($data->{title}) = $html =~ m!(?:]*>)?$LANG{$lang}->{Title}(?:)?(?:]*>)?([^<]+)(?:)?!i;
284 2 50       9 ($data->{title}) = $html =~ m!! unless($data->{title});
285 2         158 ($data->{description}) = $html =~ m!!si;
286              
287 2         17 $data->{author} =~ s/"//g;
288 2         15 $data->{thumb} = $data->{image};
289             }
290              
291             1;
292              
293             __END__