File Coverage

blib/lib/WWW/Scraper/ISBN/Waterstones_Driver.pm
Criterion Covered Total %
statement 24 81 29.6
branch 0 26 0.0
condition 0 33 0.0
subroutine 8 9 88.8
pod 1 1 100.0
total 33 150 22.0


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__