blib/lib/WWW/Scraper/ISBN/Foyles_Driver.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 68 | 68 | 100.0 |
branch | 9 | 18 | 50.0 |
condition | 10 | 24 | 41.6 |
subroutine | 6 | 6 | 100.0 |
pod | 1 | 1 | 100.0 |
total | 94 | 117 | 80.3 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WWW::Scraper::ISBN::Foyles_Driver; | ||||||
2 | |||||||
3 | 6 | 6 | 111849 | use strict; | |||
6 | 15 | ||||||
6 | 242 | ||||||
4 | 6 | 6 | 25 | use warnings; | |||
6 | 8 | ||||||
6 | 218 | ||||||
5 | |||||||
6 | 6 | 6 | 25 | use vars qw($VERSION @ISA); | |||
6 | 15 | ||||||
6 | 629 | ||||||
7 | $VERSION = '0.17'; | ||||||
8 | |||||||
9 | #-------------------------------------------------------------------------- | ||||||
10 | |||||||
11 | =head1 NAME | ||||||
12 | |||||||
13 | WWW::Scraper::ISBN::Foyles_Driver - Search driver for the Foyles 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 Foyles online book catalog. | ||||||
22 | |||||||
23 | =cut | ||||||
24 | |||||||
25 | #-------------------------------------------------------------------------- | ||||||
26 | |||||||
27 | ########################################################################### | ||||||
28 | # Inheritence | ||||||
29 | |||||||
30 | 6 | 6 | 28 | use base qw(WWW::Scraper::ISBN::Driver); | |||
6 | 7 | ||||||
6 | 3192 | ||||||
31 | |||||||
32 | ########################################################################### | ||||||
33 | # Modules | ||||||
34 | |||||||
35 | 6 | 6 | 8981 | use WWW::Mechanize; | |||
6 | 794943 | ||||||
6 | 4728 | ||||||
36 | |||||||
37 | ########################################################################### | ||||||
38 | # Constants | ||||||
39 | |||||||
40 | my $REFERER = 'http://www.foyles.co.uk'; | ||||||
41 | my $FORMNAME = 'aspnetForm'; | ||||||
42 | |||||||
43 | #-------------------------------------------------------------------------- | ||||||
44 | |||||||
45 | ########################################################################### | ||||||
46 | # Public Interface | ||||||
47 | |||||||
48 | =head1 METHODS | ||||||
49 | |||||||
50 | =over 4 | ||||||
51 | |||||||
52 | =item C |
||||||
53 | |||||||
54 | Creates a query string, then passes the appropriate form fields to the | ||||||
55 | Foyles server. | ||||||
56 | |||||||
57 | The returned page should be the correct catalog page for that ISBN. If not the | ||||||
58 | function returns zero and allows the next driver in the chain to have a go. If | ||||||
59 | a valid page is returned, the following fields are returned via the book hash: | ||||||
60 | |||||||
61 | isbn (now returns isbn13) | ||||||
62 | isbn10 | ||||||
63 | isbn13 | ||||||
64 | ean13 (industry name) | ||||||
65 | author | ||||||
66 | title | ||||||
67 | book_link | ||||||
68 | image_link | ||||||
69 | thumb_link | ||||||
70 | description | ||||||
71 | pubdate | ||||||
72 | publisher | ||||||
73 | binding (if known) | ||||||
74 | |||||||
75 | The book_link, image_link and thumb_link all refer back to the Foyles website. | ||||||
76 | |||||||
77 | =back | ||||||
78 | |||||||
79 | =cut | ||||||
80 | |||||||
81 | sub search { | ||||||
82 | 2 | 2 | 1 | 9013 | my $self = shift; | ||
83 | 2 | 4 | my $isbn = shift; | ||||
84 | 2 | 14 | $self->found(0); | ||||
85 | 2 | 32 | $self->book(undef); | ||||
86 | |||||||
87 | # validate and convert into EAN13 format | ||||||
88 | 2 | 21 | my $ean = $self->convert_to_ean13($isbn); | ||||
89 | 2 | 50 | 66 | 90 | return $self->handler("Invalid ISBN specified") | ||
33 | |||||||
66 | |||||||
33 | |||||||
90 | if(!$ean || (length $isbn == 13 && $isbn ne $ean) | ||||||
91 | || (length $isbn == 10 && $isbn ne $self->convert_to_isbn10($ean))); | ||||||
92 | |||||||
93 | 2 | 52 | my $mech = WWW::Mechanize->new(); | ||||
94 | 2 | 14167 | $mech->agent_alias( 'Windows IE 6' ); | ||||
95 | 2 | 153 | $mech->add_header( 'Accept-Encoding' => undef ); | ||||
96 | |||||||
97 | 2 | 24 | eval { $mech->get( $REFERER ) }; | ||||
2 | 10 | ||||||
98 | 2 | 50 | 33 | 7363287 | return $self->handler("The Foyles website appears to be unavailable.") | ||
33 | |||||||
99 | if($@ || !$mech->success() || !$mech->content()); | ||||||
100 | |||||||
101 | 2 | 121 | my @forms = $mech->forms; | ||||
102 | 2 | 838169 | my %forms = map {$_->attr('name') => 1} @forms; | ||||
2 | 10 | ||||||
103 | |||||||
104 | 2 | 50 | 30 | return $self->handler("The Foyles website appears to be broken [".join(',',keys %forms)."].") | |||
105 | unless($forms{$FORMNAME}); | ||||||
106 | |||||||
107 | 2 | 11 | $mech->form_name( $FORMNAME ); | ||||
108 | 2 | 47 | $mech->field( 'ctl00$txtTerm', $ean ); | ||||
109 | 2 | 123 | $mech->field( '__EVENTTARGET', 'ctl00$LinkBtnQuickSearchBy' ); | ||||
110 | 2 | 58 | $mech->field( '__EVENTARGUMENT', '' ); | ||||
111 | |||||||
112 | 2 | 65 | eval { $mech->submit(); }; | ||||
2 | 10 | ||||||
113 | 2 | 50 | 33 | 9367142 | return $self->handler("The Foyles website appears to be unavailable.") | ||
33 | |||||||
114 | if($@ || !$mech->success() || !$mech->content()); | ||||||
115 | |||||||
116 | # The Book page | ||||||
117 | 2 | 110 | my $html = $mech->content(); | ||||
118 | |||||||
119 | 2 | 50 | 8107 | return $self->handler("The Foyles website appears to be unavailable.") | |||
120 | if($html =~ m!I'm sorry we have encountered a problem with this page!si); | ||||||
121 | |||||||
122 | 2 | 50 | 9531 | return $self->handler("Failed to find that book on the Foyles website. [$isbn]") | |||
123 | if($html =~ m!Sorry, there are no results for|This item is not currently listed on the Foyles Website!si); | ||||||
124 | |||||||
125 | 2 | 1394 | $html =~ s/&/&/g; | ||||
126 | 2 | 1333 | $html =~ s/ / /g; | ||||
127 | #print STDERR "\n# content2=[\n$html\n]\n"; | ||||||
128 | |||||||
129 | 2 | 7 | my $data; | ||||
130 | 2 | 3212 | ($data->{title}) = $html =~ m! \s*([^<]+)!si; |
||||
131 | 2 | 4139 | ($data->{author}) = $html =~ m! \s*([^<]+)!si; |
||||
132 | 2 | 3760 | ($data->{binding}) = $html =~ m!Type: ([^<]+)!si; | ||||
133 | 2 | 3650 | ($data->{publisher}) = $html =~ m!Publisher: ([^<]+)!si; | ||||
134 | 2 | 6954 | ($data->{pubdate}) = $html =~ m!Publication Date: ([^<]+)!si; | ||||
135 | 2 | 12371 | ($data->{isbn13}) = $html =~ m!ISBN-13: !si; | ||||
136 | 2 | 3661 | ($data->{description}) = $html =~ m!([^<]+)!si; | ||||
137 | 2 | 81 | ($data->{image}) = $html =~ m! \s* |
||||
138 | |||||||
139 | 2 | 8 | $data->{thumb} = $data->{image}; | ||||
140 | 2 | 40 | $data->{isbn10} = $self->convert_to_isbn10($ean); | ||||
141 | 2 | 114 | $data->{isbn13} = $ean; | ||||
142 | |||||||
143 | 2 | 31 | for(qw(publisher)) { | ||||
144 | 2 | 50 | 11 | next unless($data->{$_}); | |||
145 | 2 | 10 | $data->{$_} =~ s/?39;/'/g; | ||||
146 | } | ||||||
147 | |||||||
148 | #use Data::Dumper; | ||||||
149 | #print STDERR "\n# " . Dumper($data); | ||||||
150 | |||||||
151 | 2 | 50 | 7 | return $self->handler("Could not extract data from the Foyles result page.") | |||
152 | unless(defined $data); | ||||||
153 | |||||||
154 | # trim top and tail | ||||||
155 | 2 | 14 | foreach (keys %$data) { | ||||
156 | 20 | 50 | 34 | next unless(defined $data->{$_}); | |||
157 | 20 | 32 | $data->{$_} =~ s! ! !g; | ||||
158 | 20 | 29 | $data->{$_} =~ s/^\s+//; | ||||
159 | 20 | 76 | $data->{$_} =~ s/\s+$//; | ||||
160 | } | ||||||
161 | |||||||
162 | 2 | 20 | my $bk = { | ||||
163 | 'ean13' => $data->{isbn13}, | ||||||
164 | 'isbn13' => $data->{isbn13}, | ||||||
165 | 'isbn10' => $data->{isbn10}, | ||||||
166 | 'isbn' => $data->{isbn13}, | ||||||
167 | 'author' => $data->{author}, | ||||||
168 | 'title' => $data->{title}, | ||||||
169 | 'book_link' => $mech->uri(), | ||||||
170 | 'image_link' => $data->{image}, | ||||||
171 | 'thumb_link' => $data->{thumb}, | ||||||
172 | 'description' => $data->{description}, | ||||||
173 | 'pubdate' => $data->{pubdate}, | ||||||
174 | 'publisher' => $data->{publisher}, | ||||||
175 | 'binding' => $data->{binding}, | ||||||
176 | 'pages' => $data->{pages}, | ||||||
177 | 'html' => $html | ||||||
178 | }; | ||||||
179 | |||||||
180 | #use Data::Dumper; | ||||||
181 | #print STDERR "\n# book=".Dumper($bk); | ||||||
182 | |||||||
183 | 2 | 108 | $self->book($bk); | ||||
184 | 2 | 28 | $self->found(1); | ||||
185 | 2 | 17 | return $self->book; | ||||
186 | } | ||||||
187 | |||||||
188 | 1; | ||||||
189 | |||||||
190 | __END__ |