File Coverage

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   136827 use strict;
  6         17  
  6         276  
4 6     6   33 use warnings;
  6         40  
  6         266  
5              
6 6     6   35 use vars qw($VERSION @ISA);
  6         14  
  6         551  
7             $VERSION = '0.16';
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   34 use base qw(WWW::Scraper::ISBN::Driver);
  6         6  
  6         4129  
31              
32             ###########################################################################
33             # Modules
34              
35 6     6   12414 use WWW::Mechanize;
  6         1051985  
  6         6949  
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 10074 my $self = shift;
83 2         4 my $isbn = shift;
84 2         16 $self->found(0);
85 2         43 $self->book(undef);
86              
87             # validate and convert into EAN13 format
88 2         24 my $ean = $self->convert_to_ean13($isbn);
89 2 50 66     101 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         44 my $mech = WWW::Mechanize->new();
94 2         21344 $mech->agent_alias( 'Windows IE 6' );
95 2         182 $mech->add_header( 'Accept-Encoding' => undef );
96              
97 2         29 eval { $mech->get( $REFERER ) };
  2         11  
98 2 50 33     2905931 return $self->handler("The Foyles website appears to be unavailable.")
      33        
99             if($@ || !$mech->success() || !$mech->content());
100              
101 2         160 my @forms = $mech->forms;
102 2         578960 my %forms = map {$_->attr('name') => 1} @forms;
  2         12  
103              
104 2 50       33 return $self->handler("The Foyles website appears to be broken [".join(',',keys %forms)."].")
105             unless($forms{$FORMNAME});
106              
107 2         10 $mech->form_name( $FORMNAME );
108 2         50 $mech->field( 'ctl00$txtTerm', $ean );
109 2         122 $mech->field( '__EVENTTARGET', 'ctl00$LinkBtnQuickSearchBy' );
110 2         56 $mech->field( '__EVENTARGUMENT', '' );
111              
112 2         64 eval { $mech->submit(); };
  2         9  
113 2 50 33     5246414 return $self->handler("The Foyles website appears to be unavailable.")
      33        
114             if($@ || !$mech->success() || !$mech->content());
115              
116             # The Book page
117 2         153 my $html = $mech->content();
118              
119 2 50       12450 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       13191 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         1565 $html =~ s/&/&/g;
126 2         1625 $html =~ s/ / /g;
127             #print STDERR "\n# content2=[\n$html\n]\n";
128              
129 2         7 my $data;
130 2         4254 ($data->{title}) = $html =~ m!
\s*([^<]+)!si;
131 2         5192 ($data->{author}) = $html =~ m!
\s*([^<]+)!si;
132 2         4869 ($data->{binding}) = $html =~ m!Type: ([^<]+)!si;
133 2         4985 ($data->{publisher}) = $html =~ m!Publisher: ([^<]+)!si;
134 2         9289 ($data->{pubdate}) = $html =~ m!Publication Date: ([^<]+)!si;
135 2         35629 ($data->{isbn13}) = $html =~ m!ISBN-13: !si;
136 2         4297 ($data->{description}) = $html =~ m!([^<]+)!si;
137 2         103 ($data->{image}) = $html =~ m!
\s*]+>!;
138              
139 2         9 $data->{thumb} = $data->{image};
140 2         45 $data->{isbn10} = $self->convert_to_isbn10($ean);
141 2         144 $data->{isbn13} = $ean;
142              
143 2         42 for(qw(publisher)) {
144 2 50       13 next unless($data->{$_});
145 2         12 $data->{$_} =~ s/�?39;/'/g;
146             }
147              
148             #use Data::Dumper;
149             #print STDERR "\n# " . Dumper($data);
150              
151 2 50       8 return $self->handler("Could not extract data from the Foyles result page.")
152             unless(defined $data);
153              
154             # trim top and tail
155 2         18 foreach (keys %$data) {
156 20 50       39 next unless(defined $data->{$_});
157 20         41 $data->{$_} =~ s! ! !g;
158 20         36 $data->{$_} =~ s/^\s+//;
159 20         100 $data->{$_} =~ s/\s+$//;
160             }
161              
162 2         25 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         122 $self->book($bk);
184 2         72 $self->found(1);
185 2         18 return $self->book;
186             }
187              
188             1;
189              
190             __END__