| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WWW::Scraper::ISBN::BookDepository_Driver; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 5 |  |  | 5 |  | 246198 | use strict; | 
|  | 5 |  |  |  |  | 32 |  | 
|  | 5 |  |  |  |  | 130 |  | 
| 4 | 5 |  |  | 5 |  | 23 | use warnings; | 
|  | 5 |  |  |  |  | 8 |  | 
|  | 5 |  |  |  |  | 166 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 5 |  |  | 5 |  | 27 | use vars qw($VERSION @ISA); | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 408 |  | 
| 7 |  |  |  |  |  |  | $VERSION = '0.13'; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | #-------------------------------------------------------------------------- | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | =head1 NAME | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | WWW::Scraper::ISBN::BookDepository_Driver - Search driver for The Book Depository 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 Book Depository online book catalog | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | =cut | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | #-------------------------------------------------------------------------- | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | ########################################################################### | 
| 28 |  |  |  |  |  |  | # Inheritence | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 5 |  |  | 5 |  | 31 | use base qw(WWW::Scraper::ISBN::Driver); | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 2273 |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | ########################################################################### | 
| 33 |  |  |  |  |  |  | # Modules | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 5 |  |  | 5 |  | 7893 | use WWW::Mechanize; | 
|  | 5 |  |  |  |  | 652065 |  | 
|  | 5 |  |  |  |  | 214 |  | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | ########################################################################### | 
| 38 |  |  |  |  |  |  | # Constants | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 5 |  |  | 5 |  | 45 | use constant    REFERER    => 'http://www.bookdepository.co.uk/'; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 300 |  | 
| 41 | 5 |  |  | 5 |  | 28 | use constant    SEARCH    => 'http://www.bookdepository.co.uk/search?search=search&searchTerm='; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 5513 |  | 
| 42 |  |  |  |  |  |  | my ($URL1,$URL2) = ('http://www.bookdepository.co.uk/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 |  |  |  |  |  |  | description | 
| 71 |  |  |  |  |  |  | pubdate | 
| 72 |  |  |  |  |  |  | publisher | 
| 73 |  |  |  |  |  |  | binding       (if known) | 
| 74 |  |  |  |  |  |  | pages         (if known) | 
| 75 |  |  |  |  |  |  | weight        (if known) (in grammes) | 
| 76 |  |  |  |  |  |  | width         (if known) (in millimetres) | 
| 77 |  |  |  |  |  |  | height        (if known) (in millimetres) | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | The book_link and image_link refer back to the The Book Depository website. | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | =back | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | =cut | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | sub search { | 
| 86 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 87 | 0 |  |  |  |  |  | my $isbn = shift; | 
| 88 | 0 |  |  |  |  |  | $self->found(0); | 
| 89 | 0 |  |  |  |  |  | $self->book(undef); | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | # validate and convert into EAN13 format | 
| 92 | 0 |  |  |  |  |  | my $ean = $self->convert_to_ean13($isbn); | 
| 93 | 0 | 0 | 0 |  |  |  | return $self->handler("Invalid ISBN specified") | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 94 |  |  |  |  |  |  | if(!$ean || (length $isbn == 13 && $isbn ne $ean) | 
| 95 |  |  |  |  |  |  | || (length $isbn == 10 && $isbn ne $self->convert_to_isbn10($ean))); | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 0 |  |  |  |  |  | my $mech = WWW::Mechanize->new(); | 
| 98 | 0 |  |  |  |  |  | $mech->agent_alias( 'Windows IE 6' ); | 
| 99 | 0 |  |  |  |  |  | $mech->add_header( 'Accept-Encoding' => undef ); | 
| 100 | 0 |  |  |  |  |  | $mech->add_header( 'Referer' => REFERER ); | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | #print STDERR "\n# search=[".SEARCH."$ean]\n"; | 
| 103 | 0 |  |  |  |  |  | eval { $mech->get( SEARCH . $ean ) }; | 
|  | 0 |  |  |  |  |  |  | 
| 104 | 0 | 0 | 0 |  |  |  | return $self->handler("The Book Depository website appears to be unavailable.") | 
|  |  |  | 0 |  |  |  |  | 
| 105 |  |  |  |  |  |  | if($@ || !$mech->success() || !$mech->content()); | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | # The Book page | 
| 108 | 0 |  |  |  |  |  | my $html = $mech->content(); | 
| 109 |  |  |  |  |  |  |  | 
| 110 | 0 | 0 |  |  |  |  | return $self->handler("Failed to find that book on The Book Depository website. [$isbn]") | 
| 111 |  |  |  |  |  |  | if($html =~ m!Sorry, there are no results for!si); | 
| 112 |  |  |  |  |  |  |  | 
| 113 | 0 |  |  |  |  |  | $html =~ s/&/&/g; | 
| 114 |  |  |  |  |  |  | #print STDERR "\n# content2=[\n$html\n]\n"; | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 0 |  |  |  |  |  | my $data; | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | # first pass wih metadata | 
| 119 |  |  |  |  |  |  | #($data->{isbn13})       = $html =~ m! | 
| 120 | 0 |  |  |  |  |  | ($data->{publisher})    = $html =~ m! | 
| 121 | 0 |  |  |  |  |  | ($data->{pubdate})      = $html =~ m! | 
| 122 | 0 |  |  |  |  |  | ($data->{title})        = $html =~ m! | 
| 123 | 0 |  |  |  |  |  | ($data->{author})       = $html =~ m! | 
| 124 | 0 |  |  |  |  |  | ($data->{description})  = $html =~ m! | 
| 125 | 0 |  |  |  |  |  | ($data->{image})        = $html =~ m! | 
| 126 | 0 |  |  |  |  |  | ($data->{url})          = $html =~ m! | 
| 127 | 0 |  |  |  |  |  | ($data->{pages})        = $html =~ m! | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | # second pass with page data | 
| 130 | 0 | 0 |  |  |  |  | ($data->{isbn13})       = $html =~ m!\s*(\d+)!si                          unless($data->{isbn13}); | 
| 131 | 0 | 0 |  |  |  |  | ($data->{publisher})    = $html =~ m!\s*]+>\s*]+>\s*]+>([^<]+)!si       unless($data->{publisher}); | 
| 132 | 0 | 0 |  |  |  |  | ($data->{pubdate})      = $html =~ m!\s*([^<]+)!si     unless($data->{pubdate}); | 
| 133 | 0 | 0 |  |  |  |  | ($data->{title})        = $html =~ m! ]*>([^<]+)!si                                               unless($data->{title}); | 
| 134 | 0 | 0 |  |  |  |  | ($data->{author})       = $html =~ m!]*>([^<]+)!si                                           unless($data->{author}); | 
| 135 | 0 | 0 |  |  |  |  | ($data->{pages})        = $html =~ m!(\d+) pages\s*!si                                unless($data->{pages}); | 
| 136 | 0 | 0 |  |  |  |  | ($data->{image})        = $html =~ m!"(https://\w+.cloudfront.net/assets/images/book/lrg/\d+/\d+/\d+.jpg)"!si               unless($data->{image}); | 
| 137 |  |  |  |  |  |  | ($data->{title},$data->{author}) | 
| 138 | 0 | 0 | 0 |  |  |  | = $html =~ m!(.*):\s+([^:]+)\s+:\s+\d+\s*!                                           unless($data->{title} && $data->{author}); | 
| 139 |  |  |  |  |  |  | ($data->{description})  = $html =~ m! \s*(.*?)\s*!si | 
| 140 | 0 | 0 |  |  |  |  | unless($data->{description}); | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | # other page data | 
| 143 | 0 |  |  |  |  |  | ($data->{isbn10})       = $html =~ m!\s*(\d+)!si; | 
| 144 | 0 |  |  |  |  |  | ($data->{binding})      = $html =~ m!\s*\s*([^\|]+)\|!si; | 
| 145 | 0 |  |  |  |  |  | ($data->{thumb})        = $html =~ m!"(https://\w+.cloudfare.net/assets/images/book/medium/\d+/\d+/\d+.jpg)"!si; | 
| 146 |  |  |  |  |  |  | ($data->{width},$data->{height},$data->{depth},$data->{weight}) | 
| 147 | 0 |  |  |  |  |  | = $html =~ m!\s*\s*([\d.]+)\s*x\s*([\d.]+)\s*x\s*([\d.]+)mm\s*\|\s*([\d.]+)g!; | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | # clean up | 
| 150 | 0 | 0 |  |  |  |  | $data->{publisher} =~ s/?39;/'/g     if($data->{publisher}); | 
| 151 | 0 | 0 |  |  |  |  | $data->{width}  = int($data->{width})   if($data->{width}); | 
| 152 | 0 | 0 |  |  |  |  | $data->{height} = int($data->{height})  if($data->{height}); | 
| 153 | 0 | 0 |  |  |  |  | $data->{weight} = int($data->{weight})  if($data->{weight}); | 
| 154 | 0 | 0 |  |  |  |  | unless($data->{thumb}) { | 
| 155 | 0 |  |  |  |  |  | $data->{thumb} = $data->{image}; | 
| 156 | 0 |  |  |  |  |  | $data->{thumb} =~ s!/large/!/medium/!; | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | #use Data::Dumper; | 
| 160 |  |  |  |  |  |  | #print STDERR "\n# " . Dumper($data); | 
| 161 |  |  |  |  |  |  |  | 
| 162 | 0 | 0 |  |  |  |  | return $self->handler("Could not extract data from The Book Depository result page.") | 
| 163 |  |  |  |  |  |  | unless(defined $data); | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | # trim top and tail | 
| 166 | 0 |  |  |  |  |  | foreach (keys %$data) { | 
| 167 | 0 | 0 |  |  |  |  | next unless(defined $data->{$_}); | 
| 168 | 0 |  |  |  |  |  | $data->{$_} =~ s! ! !g; | 
| 169 | 0 |  |  |  |  |  | $data->{$_} =~ s/^\s+//; | 
| 170 | 0 |  |  |  |  |  | $data->{$_} =~ s/\s+$//; | 
| 171 |  |  |  |  |  |  | } | 
| 172 |  |  |  |  |  |  |  | 
| 173 | 0 |  |  |  |  |  | my $url = $mech->uri(); | 
| 174 | 0 |  |  |  |  |  | $url =~ s/\?.*//; | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | my $bk = { | 
| 177 |  |  |  |  |  |  | 'ean13'       => $data->{isbn13}, | 
| 178 |  |  |  |  |  |  | 'isbn13'      => $data->{isbn13}, | 
| 179 |  |  |  |  |  |  | 'isbn10'      => $data->{isbn10}, | 
| 180 |  |  |  |  |  |  | 'isbn'        => $data->{isbn13}, | 
| 181 |  |  |  |  |  |  | 'author'      => $data->{author}, | 
| 182 |  |  |  |  |  |  | 'title'       => $data->{title}, | 
| 183 |  |  |  |  |  |  | 'book_link'   => "$url", | 
| 184 |  |  |  |  |  |  | 'image_link'  => $data->{image}, | 
| 185 |  |  |  |  |  |  | 'thumb_link'  => $data->{thumb}, | 
| 186 |  |  |  |  |  |  | 'description' => $data->{description}, | 
| 187 |  |  |  |  |  |  | 'pubdate'     => $data->{pubdate}, | 
| 188 |  |  |  |  |  |  | 'publisher'   => $data->{publisher}, | 
| 189 |  |  |  |  |  |  | 'binding'     => $data->{binding}, | 
| 190 |  |  |  |  |  |  | 'pages'       => $data->{pages}, | 
| 191 |  |  |  |  |  |  | 'weight'      => $data->{weight}, | 
| 192 |  |  |  |  |  |  | 'width'       => $data->{width}, | 
| 193 |  |  |  |  |  |  | 'height'      => $data->{height}, | 
| 194 |  |  |  |  |  |  | #        'html'        => $html | 
| 195 | 0 |  |  |  |  |  | }; | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | #use Data::Dumper; | 
| 198 |  |  |  |  |  |  | #print STDERR "\n# book=".Dumper($bk); | 
| 199 |  |  |  |  |  |  |  | 
| 200 | 0 |  |  |  |  |  | $self->book($bk); | 
| 201 | 0 |  |  |  |  |  | $self->found(1); | 
| 202 | 0 |  |  |  |  |  | return $self->book; | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | 1; | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | __END__ |