blib/lib/WWW/Scraper/ISBN/Wheelers_Driver.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 18 | 64 | 28.1 |
branch | 0 | 12 | 0.0 |
condition | 0 | 6 | 0.0 |
subroutine | 6 | 7 | 85.7 |
pod | 1 | 1 | 100.0 |
total | 25 | 90 | 27.7 |
line | stmt | bran | cond | sub | pod | time | code | ||
---|---|---|---|---|---|---|---|---|---|
1 | package WWW::Scraper::ISBN::Wheelers_Driver; | ||||||||
2 | |||||||||
3 | 5 | 5 | 287684 | use strict; | |||||
5 | 39 | ||||||||
5 | 151 | ||||||||
4 | 5 | 5 | 28 | use warnings; | |||||
5 | 10 | ||||||||
5 | 215 | ||||||||
5 | |||||||||
6 | 5 | 5 | 32 | use vars qw($VERSION @ISA); | |||||
5 | 10 | ||||||||
5 | 453 | ||||||||
7 | $VERSION = '0.15'; | ||||||||
8 | |||||||||
9 | #-------------------------------------------------------------------------- | ||||||||
10 | |||||||||
11 | =head1 NAME | ||||||||
12 | |||||||||
13 | WWW::Scraper::ISBN::Wheelers_Driver - Search drivers for the Wheelers' 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 the Wheelers' online book catalog. | ||||||||
22 | |||||||||
23 | =cut | ||||||||
24 | |||||||||
25 | #-------------------------------------------------------------------------- | ||||||||
26 | |||||||||
27 | ########################################################################### | ||||||||
28 | # Inheritence | ||||||||
29 | |||||||||
30 | 5 | 5 | 37 | use base qw(WWW::Scraper::ISBN::Driver); | |||||
5 | 11 | ||||||||
5 | 2659 | ||||||||
31 | |||||||||
32 | ########################################################################### | ||||||||
33 | # Modules | ||||||||
34 | |||||||||
35 | 5 | 5 | 9068 | use WWW::Mechanize; | |||||
5 | 767768 | ||||||||
5 | 253 | ||||||||
36 | |||||||||
37 | ########################################################################### | ||||||||
38 | # Constants | ||||||||
39 | |||||||||
40 | 5 | 5 | 55 | use constant SEARCH => 'https://www.wheelers.co.nz/search/results/?query='; | |||||
5 | 15 | ||||||||
5 | 4856 | ||||||||
41 | |||||||||
42 | #-------------------------------------------------------------------------- | ||||||||
43 | |||||||||
44 | ########################################################################### | ||||||||
45 | # Public Interface | ||||||||
46 | |||||||||
47 | =head1 METHODS | ||||||||
48 | |||||||||
49 | =over 4 | ||||||||
50 | |||||||||
51 | =item C |
||||||||
52 | |||||||||
53 | Creates a query string, then passes the appropriate form fields to the | ||||||||
54 | Wheelers server. | ||||||||
55 | |||||||||
56 | The returned page should be the correct catalog page for that ISBN. If not the | ||||||||
57 | function returns zero and allows the next driver in the chain to have a go. If | ||||||||
58 | a valid page is returned, the following fields are returned via the book hash: | ||||||||
59 | |||||||||
60 | isbn (now returns isbn13) | ||||||||
61 | isbn10 | ||||||||
62 | isbn13 | ||||||||
63 | ean13 (industry name) | ||||||||
64 | author | ||||||||
65 | title | ||||||||
66 | book_link | ||||||||
67 | image_link | ||||||||
68 | description | ||||||||
69 | pubdate | ||||||||
70 | publisher | ||||||||
71 | binding (if known) | ||||||||
72 | pages (if known) | ||||||||
73 | weight (if known) (in grammes) | ||||||||
74 | width (if known) (in millimetres) | ||||||||
75 | height (if known) (in millimetres) | ||||||||
76 | |||||||||
77 | The book_link and image_link refer back to the Wheelers website. | ||||||||
78 | |||||||||
79 | =back | ||||||||
80 | |||||||||
81 | =cut | ||||||||
82 | |||||||||
83 | sub search { | ||||||||
84 | 0 | 0 | 1 | my $self = shift; | |||||
85 | 0 | my $isbn = shift; | |||||||
86 | 0 | $self->found(0); | |||||||
87 | 0 | $self->book(undef); | |||||||
88 | |||||||||
89 | 0 | my $mech = WWW::Mechanize->new(); | |||||||
90 | 0 | $mech->agent_alias( 'Linux Mozilla' ); | |||||||
91 | |||||||||
92 | 0 | eval { $mech->get( SEARCH . $isbn ) }; | |||||||
0 | |||||||||
93 | 0 | 0 | 0 | return $self->handler("Wheelers website appears to be unavailable.") | |||||
0 | |||||||||
94 | if($@ || !$mech->success() || !$mech->content()); | ||||||||
95 | |||||||||
96 | # The Book page | ||||||||
97 | 0 | my $html = $mech->content(); | |||||||
98 | |||||||||
99 | 0 | 0 | return $self->handler("Failed to find that book on Wheelers website.") | ||||||
100 | if($html =~ m!Your search returned 0 results!si); | ||||||||
101 | |||||||||
102 | #print STDERR "\n# html=[\n$html\n]\n"; | ||||||||
103 | |||||||||
104 | 0 | my $data; | |||||||
105 | 0 | ($data->{image}) = $html =~ m!href="(.*?/large/\d+/\d+.jpg)!i; | |||||||
106 | 0 | ($data->{thumb}) = $html =~ m!src="(.*?/small/\d+/\d+.jpg)!i; | |||||||
107 | 0 | ($data->{author}) = $html =~ m! | |||||||
108 | 0 | ($data->{title}) = $html =~ m!\s*([^,<]+)!i; |
|||||||
109 | 0 | ($data->{publisher}) = $html =~ m! | Publisher | \s*]+>([^<]+) | !i;|||||
110 | 0 | ($data->{pubdate}) = $html =~ m! | International Publication Date | \s*([^<]+) | !i;|||||
111 | 0 | ($data->{isbn13}) = $html =~ m! | ISBN-13 | \s*(\d+) | !i;|||||
112 | 0 | ($data->{isbn10}) = $html =~ m! | ISBN-10 | \s*(\d+) | !i;|||||
113 | 0 | ($data->{binding}) = $html =~ m! | Format | \s*([^<]+) | |||||
114 | 0 | ($data->{pages}) = $html =~ m! | Number of Pages | \s*([^<]+) | !s;|||||
115 | 0 | ($data->{width},$data->{height}) = $html =~ m! | |||||||
Dimensions | \s*Width:\s*([\d.]+)mm Height:\s*([\d.]+)mm (?:Spine:\s*([\d.]+)mm)? | \s*||||||||
116 | 0 | ($data->{weight}) = $html =~ m! | |||||||
Weight | \s*([\d,]+)g | \s*||||||||
117 | 0 | ($data->{description}) = $html =~ m!Description of this book\s*([^<]+) !i; |
|||||||
118 | |||||||||
119 | 0 | $data->{binding} =~ s/,.*//; | |||||||
120 | 0 | $data->{weight} =~ s/,//g; | |||||||
121 | 0 | for(qw(image thumb)) { | |||||||
122 | 0 | 0 | next unless(defined $data->{$_}); | ||||||
123 | 0 | 0 | next if($data->{$_} =~ m!^https?://!); | ||||||
124 | 0 | $data->{$_} =~ s!^//!https://!; | |||||||
125 | } | ||||||||
126 | |||||||||
127 | # top 'n' tail trim | ||||||||
128 | 0 | for(keys %$data) { | |||||||
129 | 0 | $data->{$_} =~ s/'/'/g; | |||||||
130 | 0 | $data->{$_} =~ s/^\+//; | |||||||
131 | 0 | $data->{$_} =~ s/\+$//; | |||||||
132 | } | ||||||||
133 | |||||||||
134 | 0 | my $base = $mech->uri(); | |||||||
135 | 0 | $base =~ s!(http://[^/]+).*!$1!; | |||||||
136 | |||||||||
137 | #use Data::Dumper; | ||||||||
138 | #print STDERR "\n# " . Dumper($data); | ||||||||
139 | |||||||||
140 | 0 | 0 | return $self->handler("Could not extract data from Wheelers result page.") | ||||||
141 | unless(defined $data); | ||||||||
142 | |||||||||
143 | # trim top and tail | ||||||||
144 | 0 | 0 | foreach (keys %$data) { next unless(defined $data->{$_});$data->{$_} =~ s/^\s+//;$data->{$_} =~ s/\s+$//; } | ||||||
0 | |||||||||
0 | |||||||||
0 | |||||||||
145 | |||||||||
146 | my $bk = { | ||||||||
147 | 'ean13' => $data->{isbn13}, | ||||||||
148 | 'isbn13' => $data->{isbn13}, | ||||||||
149 | 'isbn10' => $data->{isbn10}, | ||||||||
150 | 'isbn' => $data->{isbn13}, | ||||||||
151 | 'author' => $data->{author}, | ||||||||
152 | 'title' => $data->{title}, | ||||||||
153 | 'book_link' => $mech->uri(), | ||||||||
154 | 'image_link' => $data->{image}, | ||||||||
155 | 'thumb_link' => $data->{thumb}, | ||||||||
156 | 'description' => $data->{description}, | ||||||||
157 | 'pubdate' => $data->{pubdate}, | ||||||||
158 | 'publisher' => $data->{publisher}, | ||||||||
159 | 'binding' => $data->{binding}, | ||||||||
160 | 'pages' => $data->{pages}, | ||||||||
161 | 'weight' => $data->{weight}, | ||||||||
162 | 'width' => $data->{width}, | ||||||||
163 | 'height' => $data->{height}, | ||||||||
164 | 0 | 'html' => $html | |||||||
165 | }; | ||||||||
166 | |||||||||
167 | #use Data::Dumper; | ||||||||
168 | #print STDERR "\n# book=".Dumper($bk); | ||||||||
169 | |||||||||
170 | 0 | $self->book($bk); | |||||||
171 | 0 | $self->found(1); | |||||||
172 | 0 | return $self->book; | |||||||
173 | } | ||||||||
174 | |||||||||
175 | 1; | ||||||||
176 | __END__ |