line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::Scraper::ISBN::Waterstones_Driver; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
297610
|
use strict; |
|
5
|
|
|
|
|
38
|
|
|
5
|
|
|
|
|
152
|
|
4
|
5
|
|
|
5
|
|
25
|
use warnings; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
196
|
|
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
31
|
use vars qw($VERSION @ISA); |
|
5
|
|
|
|
|
23
|
|
|
5
|
|
|
|
|
424
|
|
7
|
|
|
|
|
|
|
$VERSION = '0.09'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
#-------------------------------------------------------------------------- |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
WWW::Scraper::ISBN::Waterstones_Driver - Search driver for the Waterstones online book catalog. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
See parent class documentation (L) |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 DESCRIPTION |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Searches for book information from Waterstones online book catalog. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=cut |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#-------------------------------------------------------------------------- |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
########################################################################### |
28
|
|
|
|
|
|
|
# Inheritence |
29
|
|
|
|
|
|
|
|
30
|
5
|
|
|
5
|
|
38
|
use base qw(WWW::Scraper::ISBN::Driver); |
|
5
|
|
|
|
|
18
|
|
|
5
|
|
|
|
|
2711
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
########################################################################### |
33
|
|
|
|
|
|
|
# Modules |
34
|
|
|
|
|
|
|
|
35
|
5
|
|
|
5
|
|
9424
|
use WWW::Mechanize; |
|
5
|
|
|
|
|
786293
|
|
|
5
|
|
|
|
|
232
|
|
36
|
5
|
|
|
5
|
|
3887
|
use JSON::XS; |
|
5
|
|
|
|
|
23885
|
|
|
5
|
|
|
|
|
353
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
########################################################################### |
39
|
|
|
|
|
|
|
# Constants |
40
|
|
|
|
|
|
|
|
41
|
5
|
|
|
5
|
|
43
|
use constant REFERER => 'https://www.waterstones.com'; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
334
|
|
42
|
5
|
|
|
5
|
|
34
|
use constant SEARCH => 'https://www.waterstones.com/index/search?term='; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
5480
|
|
43
|
|
|
|
|
|
|
my ($URL1,$URL2) = ('http://www.waterstones.com/book/','/[^?]+\?b=\-3\&t=\-26\#Bibliographicdata\-26'); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
#-------------------------------------------------------------------------- |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
########################################################################### |
48
|
|
|
|
|
|
|
# Public Interface |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 METHODS |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=over 4 |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=item C |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Creates a query string, then passes the appropriate form fields to the |
57
|
|
|
|
|
|
|
Book Depository server. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
The returned page should be the correct catalog page for that ISBN. If not the |
60
|
|
|
|
|
|
|
function returns zero and allows the next driver in the chain to have a go. If |
61
|
|
|
|
|
|
|
a valid page is returned, the following fields are returned via the book hash: |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
isbn (now returns isbn13) |
64
|
|
|
|
|
|
|
isbn10 |
65
|
|
|
|
|
|
|
isbn13 |
66
|
|
|
|
|
|
|
ean13 (industry name) |
67
|
|
|
|
|
|
|
author |
68
|
|
|
|
|
|
|
title |
69
|
|
|
|
|
|
|
book_link |
70
|
|
|
|
|
|
|
image_link |
71
|
|
|
|
|
|
|
thumb_link |
72
|
|
|
|
|
|
|
description |
73
|
|
|
|
|
|
|
pubdate |
74
|
|
|
|
|
|
|
publisher |
75
|
|
|
|
|
|
|
binding (if known) |
76
|
|
|
|
|
|
|
pages (if known) |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The book_link, image_link and thumb_link all refer back to the Waterstones |
79
|
|
|
|
|
|
|
website. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=back |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub search { |
86
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
87
|
0
|
|
|
|
|
|
my $isbn = shift; |
88
|
0
|
|
|
|
|
|
$self->found(0); |
89
|
0
|
|
|
|
|
|
$self->book(undef); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# validate and convert into EAN13 format |
92
|
0
|
|
|
|
|
|
my $ean = $self->convert_to_ean13($isbn); |
93
|
0
|
0
|
0
|
|
|
|
return $self->handler("Invalid ISBN specified") |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
94
|
|
|
|
|
|
|
if(!$ean || (length $isbn == 13 && $isbn ne $ean) |
95
|
|
|
|
|
|
|
|| (length $isbn == 10 && $isbn ne $self->convert_to_isbn10($ean))); |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
my $mech = WWW::Mechanize->new(); |
98
|
0
|
|
|
|
|
|
$mech->agent_alias( 'Linux Mozilla' ); |
99
|
0
|
|
|
|
|
|
$mech->add_header( 'Accept-Encoding' => undef ); |
100
|
0
|
|
|
|
|
|
$mech->add_header( 'Referer' => REFERER ); |
101
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
eval { $mech->get( SEARCH . $ean ) }; |
|
0
|
|
|
|
|
|
|
103
|
0
|
0
|
0
|
|
|
|
return $self->handler("The Waterstones website appears to be unavailable.") |
|
|
|
0
|
|
|
|
|
104
|
|
|
|
|
|
|
if($@ || !$mech->success() || !$mech->content()); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
#print STDERR "\n# search=[".SEARCH."$ean]\n"; |
107
|
|
|
|
|
|
|
#print STDERR "\n# is_html=".$mech->is_html().", content type=".$mech->content_type()."\n"; |
108
|
|
|
|
|
|
|
#print STDERR "\n# dump headers=".$mech->dump_headers."\n"; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# we get back a redirect |
111
|
0
|
|
|
|
|
|
my $response = $mech->response(); |
112
|
0
|
|
|
|
|
|
my $url = $response->header( 'X-Meta-Og-Url' ); |
113
|
|
|
|
|
|
|
#print STDERR "\n# url=[$url]\n"; |
114
|
|
|
|
|
|
|
|
115
|
0
|
0
|
0
|
|
|
|
return $self->handler("Failed to find that book on the Waterstones website. [$isbn]") |
116
|
|
|
|
|
|
|
if($url eq REFERER || $url eq REFERER . "/books/search/term/$ean"); |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
eval { $mech->get( $url ) }; |
|
0
|
|
|
|
|
|
|
119
|
0
|
0
|
0
|
|
|
|
return $self->handler("Failed to find that book on the Waterstones website. [$isbn]") |
|
|
|
0
|
|
|
|
|
120
|
|
|
|
|
|
|
if($@ || !$mech->success() || !$mech->content()); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# The Book page |
123
|
0
|
|
|
|
|
|
my $html = $mech->content(); |
124
|
|
|
|
|
|
|
|
125
|
0
|
0
|
|
|
|
|
return $self->handler("Failed to find that book on the Waterstones website. [$isbn]") |
126
|
|
|
|
|
|
|
if($html =~ m|Sorry! We did not find any results for|si); |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
|
|
|
|
return $self->handler("Waterstones website has crashed. [$isbn]") |
129
|
|
|
|
|
|
|
if($html =~ m|Exception was UseCaseError: \d+|si); |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
|
$html =~ s/&/&/g; |
132
|
|
|
|
|
|
|
#print STDERR "\n# content2=[\n$html\n]\n"; |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
my $data; |
135
|
|
|
|
|
|
|
($data->{title},$data->{author}) |
136
|
0
|
|
|
|
|
|
= $html =~ m!(.*?)\s*by\s*(.*?) \| Waterstones!si; |
137
|
0
|
|
|
|
|
|
($data->{binding}) = $html =~ m!.*? \((.*?)\)!si; |
138
|
0
|
|
|
|
|
|
($data->{description}) = $html =~ m! (.*?) !si; |
139
|
0
|
|
|
|
|
|
($data->{publisher}) = $html =~ m!([^<]+)!si; |
140
|
0
|
|
|
|
|
|
($data->{pubdate}) = $html =~ m!([\d\/]+)\s*!si; |
141
|
0
|
|
|
|
|
|
($data->{isbn13}) = $html =~ m!([^<]+)!si; |
142
|
0
|
|
|
|
|
|
($data->{image}) = $html =~ m!
|
143
|
0
|
|
|
|
|
|
my ($json) = $html =~ m!!si; |
144
|
|
|
|
|
|
|
#print STDERR "\n# json=[\n$json\n]\n"; |
145
|
|
|
|
|
|
|
|
146
|
0
|
0
|
|
|
|
|
if($json) { |
147
|
0
|
|
|
|
|
|
$data->{json} = decode_json( $json ); |
148
|
0
|
|
|
|
|
|
for(qw(author title imprint publication_date format)) { |
149
|
0
|
|
|
|
|
|
$data->{$_} = $data->{json}{'gtm-books'}[0]{$_}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
0
|
|
|
|
$data->{binding} ||= $data->{format}; |
153
|
0
|
|
0
|
|
|
|
$data->{pubdate} ||= $data->{publication_date}; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#use Data::Dumper; |
157
|
|
|
|
|
|
|
#print STDERR "\n# data=" . Dumper($data); |
158
|
|
|
|
|
|
|
|
159
|
0
|
0
|
|
|
|
|
return $self->handler("Could not extract data from the Waterstones result page. [$isbn]") |
160
|
|
|
|
|
|
|
unless(defined $data); |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
for(qw(author publisher description title)) { |
163
|
0
|
0
|
|
|
|
|
$data->{$_} =~ s/?39;/'/g if($data->{$_}); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
$data->{isbn10} = $self->convert_to_isbn10($ean); |
167
|
0
|
0
|
|
|
|
|
$data->{title} =~ s!\s*\($data->{binding}\)\s*!! if($data->{title}); |
168
|
0
|
0
|
|
|
|
|
$data->{description} =~ s!<[^>]+>!! if($data->{description}); |
169
|
|
|
|
|
|
|
|
170
|
0
|
0
|
|
|
|
|
if($data->{image}) { |
171
|
0
|
|
|
|
|
|
$data->{thumb} = $data->{image}; |
172
|
0
|
|
|
|
|
|
$data->{thumb} =~ s!/images/nbd/[lms]/!/images/nbd/s/!; |
173
|
0
|
|
|
|
|
|
$data->{image} =~ s!/images/nbd/[lms]/!/images/nbd/l/!; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
#use Data::Dumper; |
177
|
|
|
|
|
|
|
#print STDERR "\n# data=" . Dumper($data); |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# trim top and tail |
180
|
0
|
|
|
|
|
|
foreach (keys %$data) { |
181
|
0
|
0
|
|
|
|
|
next unless(defined $data->{$_}); |
182
|
0
|
|
|
|
|
|
$data->{$_} =~ s! ! !g; |
183
|
0
|
|
|
|
|
|
$data->{$_} =~ s/^\s+//; |
184
|
0
|
|
|
|
|
|
$data->{$_} =~ s/\s+$//; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# my $url = $mech->uri(); |
188
|
|
|
|
|
|
|
# $url =~ s/\?.*//; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $bk = { |
191
|
|
|
|
|
|
|
'ean13' => $data->{isbn13}, |
192
|
|
|
|
|
|
|
'isbn13' => $data->{isbn13}, |
193
|
|
|
|
|
|
|
'isbn10' => $data->{isbn10}, |
194
|
|
|
|
|
|
|
'isbn' => $data->{isbn13}, |
195
|
|
|
|
|
|
|
'author' => $data->{author}, |
196
|
|
|
|
|
|
|
'title' => $data->{title}, |
197
|
|
|
|
|
|
|
'book_link' => "$url", |
198
|
|
|
|
|
|
|
'image_link' => $data->{image}, |
199
|
|
|
|
|
|
|
'thumb_link' => $data->{thumb}, |
200
|
|
|
|
|
|
|
'description' => $data->{description}, |
201
|
|
|
|
|
|
|
'pubdate' => $data->{pubdate}, |
202
|
|
|
|
|
|
|
'publisher' => $data->{publisher}, |
203
|
|
|
|
|
|
|
'binding' => $data->{binding}, |
204
|
|
|
|
|
|
|
'pages' => $data->{pages}, |
205
|
|
|
|
|
|
|
'json' => $data->{json}, |
206
|
0
|
|
|
|
|
|
'html' => $html |
207
|
|
|
|
|
|
|
}; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
#use Data::Dumper; |
210
|
|
|
|
|
|
|
#print STDERR "\n# book=".Dumper($bk); |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
$self->book($bk); |
213
|
0
|
|
|
|
|
|
$self->found(1); |
214
|
0
|
|
|
|
|
|
return $self->book; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
1; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
__END__ |