| 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__ |