File Coverage

blib/lib/WWW/Scraper/ISBN/Waterstones_Driver.pm
Criterion Covered Total %
statement 34 71 47.8
branch 1 24 4.1
condition 8 27 29.6
subroutine 8 8 100.0
pod 1 1 100.0
total 52 131 39.6


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