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   108823 use strict;
  6         18  
  6         424  
4 6     6   27 use warnings;
  6         10  
  6         183  
5 6     6   3586 use utf8;
  6         60  
  6         33  
6              
7 6     6   245 use vars qw($VERSION @ISA);
  6         10  
  6         638  
8             $VERSION = '0.30';
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   31 use base qw(WWW::Scraper::ISBN::Driver);
  6         7  
  6         2937  
32              
33             ###########################################################################
34             # Modules
35              
36 6     6   8525 use HTML::Entities;
  6         32567  
  6         620  
37 6     6   3049 use JSON;
  6         56222  
  6         35  
38 6     6   5303 use WWW::Mechanize;
  6         681371  
  6         321  
39              
40             ###########################################################################
41             # Constants & Variables
42              
43             my $DOMAIN = 'http://books.google.com';
44              
45 6     6   50 use constant SEARCH => '/books?jscmd=viewapi&callback=bookdata&bibkeys=ISBN:';
  6         8  
  6         452  
46 6     6   53 use constant LB2G => 453.59237; # number of grams in a pound (lb)
  6         8  
  6         226  
47 6     6   20 use constant OZ2G => 28.3495231; # number of grams in an ounce (oz)
  6         7  
  6         270  
48 6     6   23 use constant IN2MM => 25.4; # number of inches in a millimetre (mm)
  6         8  
  6         10368  
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 8131 my $self = shift;
109 2         3 my $isbn = shift;
110 2         2 my $data;
111 2         10 $self->found(0);
112 2         33 $self->book(undef);
113              
114             # validate and convert into EAN13 format
115 2         24 my $ean = $self->convert_to_ean13($isbn);
116 2 50       72 return $self->handler("Invalid ISBN specified")
117             unless($ean);
118              
119 2         15 my $mech = WWW::Mechanize->new();
120 2         13139 $mech->agent_alias( 'Linux Mozilla' );
121              
122 2   33     130 my $search = ($ENV{GOOGLE_DOMAIN} || $DOMAIN) . SEARCH . $ean;
123 2         4 eval { $mech->get( $search ) };
  2         7  
124 2 50 33     287462 return $self->handler("GoogleBooks website appears to be unavailable.")
      33        
125             if($@ || !$mech->success() || !$mech->content());
126              
127 2         182 my $json = $mech->content();
128              
129 2 50       39 return $self->handler("Failed to find that book on GoogleBooks website.")
130             if($json eq 'bookdata({});');
131              
132 2         21 $json =~ s/^bookdata\(//;
133 2         12 $json =~ s/\);$//;
134              
135 2         40 my $code = decode_json($json);
136             #use Data::Dumper;
137             #print STDERR "\n# code=".Dumper($code);
138              
139 2 50 33     11 return $self->handler("Failed to find that book on GoogleBooks website.")
140             unless($code->{'ISBN:'.$ean} || $code->{'ISBN:'.$isbn});
141              
142 2         40 $data->{url} = $code->{'ISBN:'.$ean }{info_url};
143 2   33     6 $data->{url} ||= $code->{'ISBN:'.$isbn}{info_url};
144              
145 2 50       6 return $self->handler("Failed to find that book on GoogleBooks website.")
146             unless($data->{url});
147              
148 2         4 eval { $mech->get( $data->{url} ) };
  2         10  
149 2 50 33     644202 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         96 my $html = encode_entities($mech->content(),'^\n\x20-\x25\x27-\x7e');
155 2         8463 $html =~ s/\'/'/sig;
156 2         4735 $html =~ s/\\x\(([a-z\d]+)\)/\&#$1;/sig;
157 2         608 $html =~ s/7/7/sig;
158              
159 2 50       3833 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         20 $data->{url} = $mech->uri();
167 2         82 my ($ccTLD) = $data->{url} =~ m{^http://[.\w]+\.google\.(\w\w)\b};
168              
169 2         30 my $lang = 'en'; # English (default)
170 2 50       5 $lang = 'de' if($data->{url} =~ m{^http://[.\w]+\.google\.(de|ch|at)\b}); # German
171 2 50       18 $lang = 'iw' if($data->{url} =~ m{^http://[.\w]+\.google\.co\.il\b}); # Hebrew
172 2 50       14 $lang = $ccTLD if($LANG{$ccTLD}); # we have a ccTLD translation
173              
174 2 50       7 return $self->handler("Language '".uc $lang."'not currently supported, patches welcome.")
175             if($lang =~ m!xx!);
176              
177 2         7 _match( $html, $data, $lang );
178              
179             # remove HTML tags
180 2         7 for(qw(author)) {
181 2 50       7 next unless(defined $data->{$_});
182 2         22 $data->{$_} =~ s!<[^>]+>!!g;
183             }
184              
185             # trim top and tail
186 2 50       13 for(keys %$data) { next unless(defined $data->{$_});$data->{$_} =~ s/^\s+//;$data->{$_} =~ s/\s+$//; }
  22         33  
  22         50  
  22         140  
187              
188             # .com (and possibly others) don't always use Google's own CDN
189 2 50       12 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         17 my $url = $mech->uri();
197              
198 2         65 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         143 $self->book($bk);
219 2         34 $self->found(1);
220 2         17 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   66 my ($html, $data, $lang) = @_;
237 2         3 my ($publisher);
238              
239             #print "\n# lang=$lang\n";
240              
241             # Some pages can present publisher text in multiple styles
242 2 50       18 my @pubs = ref($LANG{$lang}->{Publisher}) eq 'ARRAY' ? @{$LANG{$lang}->{Publisher}} : ($LANG{$lang}->{Publisher});
  0         0  
243 2         7 for my $pub (@pubs) {
244 2         3736 ($publisher) = $html =~ m!(?:]*>)?$pub(?:)?(?:]*>)?([^<]+)(?:)?
245 2 50       20 last if($publisher);
246             }
247 2 50       7 if($publisher) {
248 2         57 my @publist = split(qr/\s*,\s*/,$publisher);
249 2         10 $data->{publisher} = $publist[0];
250 2         6 $data->{pubdate} = $publist[-1];
251             }
252              
253             # Some pages can present length/pages text in multiple styles
254 2 50       11 my @lengths = ref($LANG{$lang}->{Length}) eq 'ARRAY' ? @{$LANG{$lang}->{Length}} : ($LANG{$lang}->{Length});
  0         0  
255 2 50       9 my @pages = ref($LANG{$lang}->{Pages}) eq 'ARRAY' ? @{$LANG{$lang}->{Pages}} : ($LANG{$lang}->{Pages});
  0         0  
256 2         9 for my $length (@lengths) {
257 2         6 for my $page (@pages) {
258 2         3491 ($data->{pages}) = $html =~ m!(?:]*>)?$length(?:)?(?:]*>)?(\d+)\s*$page(?:)?
259 2 50       12 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       6 last if($data->{pages});
264             }
265              
266             # get ISBN styles
267 2         3379 my ($isbns) = $html =~ m!(?:]*>)?ISBN(?:)?(?:]*>)?([^<]+)(?:)?
268 2         29 my (@isbns) = split(qr/\s*,\s*/,$isbns);
269 2         8 for my $value (@isbns) {
270 4 100       17 $data->{isbn13} = $value if(length $value == 13);
271 4 100       14 $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         5527 ($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         3407 ($data->{author}) = $html =~ m!(?:]*>)?$LANG{$lang}->{Author}(?:)?(.*?)
282 2 50       9 ($data->{author}) = $html =~ m!([^<]+)
283 2         3410 ($data->{title}) = $html =~ m!(?:]*>)?$LANG{$lang}->{Title}(?:)?(?:]*>)?([^<]+)(?:)?!i;
284 2 50       10 ($data->{title}) = $html =~ m!! unless($data->{title});
285 2         153 ($data->{description}) = $html =~ m!!si;
286              
287 2         18 $data->{author} =~ s/"//g;
288 2         18 $data->{thumb} = $data->{image};
289             }
290              
291             1;
292              
293             __END__