| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WWW::Scraper::ISBN::BarnesNoble_Driver; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 6 |  |  | 6 |  | 288654 | use strict; | 
|  | 6 |  |  |  |  | 40 |  | 
|  | 6 |  |  |  |  | 146 |  | 
| 4 | 6 |  |  | 6 |  | 27 | use warnings; | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 177 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 6 |  |  | 6 |  | 29 | use vars qw($VERSION @ISA); | 
|  | 6 |  |  |  |  | 7 |  | 
|  | 6 |  |  |  |  | 463 |  | 
| 7 |  |  |  |  |  |  | $VERSION = '1.00'; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | #-------------------------------------------------------------------------- | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | =head1 NAME | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | WWW::Scraper::ISBN::BarnesNoble_Driver - Search driver for the Barnes and Noble 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 Barnes and Noble 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 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 2707 |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | ########################################################################### | 
| 33 |  |  |  |  |  |  | # Modules | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 6 |  |  | 6 |  | 9022 | use WWW::Mechanize; | 
|  | 6 |  |  |  |  | 753518 |  | 
|  | 6 |  |  |  |  | 6686 |  | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | ########################################################################### | 
| 38 |  |  |  |  |  |  | # Constants | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | my $REFERER = 'https://www.barnesandnoble.com/'; | 
| 41 |  |  |  |  |  |  | my $IN2MM   = 25.4;        # number of inches in a millimetre (mm) | 
| 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 |  |  |  |  |  |  | Barnes and Noble 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 |  |  |  |  |  |  | description | 
| 70 |  |  |  |  |  |  | pubdate | 
| 71 |  |  |  |  |  |  | publisher | 
| 72 |  |  |  |  |  |  | binding       (if known) | 
| 73 |  |  |  |  |  |  | pages         (if known) | 
| 74 |  |  |  |  |  |  | weight        (if known) (in grammes) | 
| 75 |  |  |  |  |  |  | width         (if known) (in millimetres) | 
| 76 |  |  |  |  |  |  | height        (if known) (in millimetres) | 
| 77 |  |  |  |  |  |  | depth         (if known) (in millimetres) | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | The book_link and image_link refer back to the Barnes and Noble 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 [$isbn]") | 
|  |  |  | 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( 'Linux Mozilla' ); | 
| 99 | 0 |  |  |  |  |  | $mech->add_header( 'Accept-Encoding' => undef ); | 
| 100 | 0 |  |  |  |  |  | $mech->add_header( 'Referer' => $REFERER ); | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 0 |  |  |  |  |  | my $url = $REFERER; | 
| 103 |  |  |  |  |  |  | #print STDERR "\n# ean=$ean, link=[$url]\n"; | 
| 104 |  |  |  |  |  |  |  | 
| 105 | 0 |  |  |  |  |  | eval { $mech->get( $url ) }; | 
|  | 0 |  |  |  |  |  |  | 
| 106 | 0 | 0 | 0 |  |  |  | return $self->handler("the Barnes and Noble website appears to be unavailable. [$@]") | 
|  |  |  | 0 |  |  |  |  | 
| 107 |  |  |  |  |  |  | if($@ || !$mech->success() || !$mech->content()); | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | # The Book page | 
| 110 | 0 |  |  |  |  |  | my $html = $mech->content(); | 
| 111 |  |  |  |  |  |  | #print STDERR "\n\n#\n#\n#\n\n"; | 
| 112 |  |  |  |  |  |  | #print STDERR "\n# GET html=[\n$html\n]\n"; | 
| 113 |  |  |  |  |  |  |  | 
| 114 | 0 |  |  |  |  |  | $mech->form_name('searchFormName'); | 
| 115 | 0 |  |  |  |  |  | $mech->field('Ntt',$ean); | 
| 116 | 0 |  |  |  |  |  | $mech->click; | 
| 117 | 0 |  |  |  |  |  | $html = $mech->content; | 
| 118 |  |  |  |  |  |  |  | 
| 119 | 0 | 0 |  |  |  |  | return $self->handler("Failed to find that book on the Barnes and Noble website. [$isbn]") | 
| 120 |  |  |  |  |  |  | if($html =~ m!Sorry. We did not find any results|Sorry, we could not find what you were looking for!si); | 
| 121 |  |  |  |  |  |  |  | 
| 122 | 0 |  |  |  |  |  | $html =~ s/&/&/g; | 
| 123 | 0 |  |  |  |  |  | $html =~ s/?39;/'/g; | 
| 124 | 0 |  |  |  |  |  | $html =~ s/ / /g; | 
| 125 | 0 |  |  |  |  |  | $html =~ s/–/-/g; | 
| 126 |  |  |  |  |  |  | #print STDERR "\n\n#\n#\n#\n\n"; | 
| 127 |  |  |  |  |  |  | #print STDERR "\n# POST html=[\n$html\n]\n"; | 
| 128 |  |  |  |  |  |  |  | 
| 129 | 0 |  |  |  |  |  | my $data; | 
| 130 | 0 |  |  |  |  |  | ($data->{isbn10})           = $self->convert_to_isbn10($ean); | 
| 131 | 0 |  |  |  |  |  | ($data->{isbn13})           = $html =~ m! | ISBN-13:.*? | (\d+)!si; | 
| 132 | 0 |  |  |  |  |  | ($data->{author})           = $html =~ m!(.*?)!si; | 
| 133 | 0 |  |  |  |  |  | ($data->{description})      = $html =~ m! | 
| 134 | 0 |  |  |  |  |  | ($data->{publisher})        = $html =~ m! | Publisher:.*? | .*?]+>([^<]+)!si; | 
| 135 | 0 |  |  |  |  |  | ($data->{pubdate})          = $html =~ m! | Publication date:.*? | ([^<]+)!si; | 
| 136 | 0 |  |  |  |  |  | ($data->{pages})            = $html =~ m! | Pages:.*? | (.*?)!si; | 
| 137 |  |  |  |  |  |  | ($data->{width},$data->{height},$data->{depth}) | 
| 138 | 0 |  |  |  |  |  | = $html =~ m! | Product dimensions:.*? | \s*([\d.]+)\s*\(w\)\s*x\s*([\d.]+)\s*\(h\)\s*x\s*([\d.]+)\s*\(d\)!si; | 
| 139 |  |  |  |  |  |  | ($data->{title},$data->{binding}) | 
| 140 | 0 |  |  |  |  |  | = $html =~ m!]*>!si; | 
| 141 | 0 |  |  |  |  |  | my ($image)                 = $html =~ m! ![]() ]*>!si; | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | # remove the author | 
| 144 | 0 |  |  |  |  |  | my ($author) = $data->{author} =~ m!([^<]+)!si; | 
| 145 | 0 |  |  |  |  |  | $data->{author} =~ s![^<]+!!si; | 
| 146 |  |  |  |  |  |  | #print STDERR "\n# author 1 = $author\n"; | 
| 147 |  |  |  |  |  |  | #print STDERR "\n# author 2 = $data->{author}\n"; | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | # currently not provided | 
| 150 | 0 |  |  |  |  |  | ($data->{weight})           = $html =~ m!Weight:\s*([^<]+)!s; | 
| 151 |  |  |  |  |  |  |  | 
| 152 | 0 | 0 |  |  |  |  | $data->{depth}  = int($data->{depth}  * $IN2MM)  if($data->{depth}); | 
| 153 | 0 | 0 |  |  |  |  | $data->{width}  = int($data->{width}  * $IN2MM)  if($data->{width}); | 
| 154 | 0 | 0 |  |  |  |  | $data->{height} = int($data->{height} * $IN2MM)  if($data->{height}); | 
| 155 | 0 | 0 |  |  |  |  | $data->{weight} = int($data->{weight})  if($data->{weight}); | 
| 156 |  |  |  |  |  |  |  | 
| 157 | 0 |  |  |  |  |  | for(qw(author publisher description)) { | 
| 158 | 0 | 0 |  |  |  |  | next    unless($data->{$_}); | 
| 159 | 0 |  |  |  |  |  | $data->{$_} =~ s![ \t\n\r]+! !g; | 
| 160 | 0 |  |  |  |  |  | $data->{$_} =~ s!<[^>]+>!!g; | 
| 161 |  |  |  |  |  |  | } | 
| 162 |  |  |  |  |  |  |  | 
| 163 | 0 | 0 |  |  |  |  | if($data->{author}) { | 
| 164 | 0 |  |  |  |  |  | $data->{author} =~ s!^\s*by\s*!!; | 
| 165 | 0 |  |  |  |  |  | $data->{author} =~ s!,\s*!, !g; | 
| 166 |  |  |  |  |  |  |  | 
| 167 | 0 |  |  |  |  |  | my (@authors) = split(/\s*,\s*/,$data->{author}); | 
| 168 | 0 |  |  |  |  |  | my %authors = map { $_ => 1 } @authors; | 
|  | 0 |  |  |  |  |  |  | 
| 169 | 0 |  |  |  |  |  | (@authors) = split(/\s*,\s*/,$author); | 
| 170 | 0 |  |  |  |  |  | for my $a (@authors) {  $authors{ $a } = 2 } | 
|  | 0 |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  |  | 
| 172 | 0 | 0 |  |  |  |  | @authors = sort { $authors{$b} <=> $authors{$a} or $a cmp $b } keys %authors; | 
|  | 0 |  |  |  |  |  |  | 
| 173 | 0 |  |  |  |  |  | $data->{author} = join(', ',@authors); | 
| 174 |  |  |  |  |  |  | } else { | 
| 175 | 0 |  |  |  |  |  | $data->{author} = $author; | 
| 176 |  |  |  |  |  |  | } | 
| 177 |  |  |  |  |  |  |  | 
| 178 | 0 | 0 |  |  |  |  | if($image) { | 
| 179 | 0 |  |  |  |  |  | $image =~ s!^//!$REFERER!; | 
| 180 | 0 |  |  |  |  |  | $data->{image} = $image; | 
| 181 | 0 |  |  |  |  |  | $data->{thumb} = $image; | 
| 182 |  |  |  |  |  |  | } | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | #use Data::Printer; | 
| 185 |  |  |  |  |  |  | #print STDERR "\n# data=" . p($data) . "\n"; | 
| 186 |  |  |  |  |  |  |  | 
| 187 | 0 | 0 |  |  |  |  | return $self->handler("Could not extract data from the Barnes and Noble result page.") | 
| 188 |  |  |  |  |  |  | unless(defined $data); | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | # trim top and tail | 
| 191 | 0 |  |  |  |  |  | foreach (keys %$data) { | 
| 192 | 0 | 0 |  |  |  |  | next unless(defined $data->{$_}); | 
| 193 | 0 |  |  |  |  |  | $data->{$_} =~ s/^\s+//; | 
| 194 | 0 |  |  |  |  |  | $data->{$_} =~ s/\s+$//; | 
| 195 |  |  |  |  |  |  | } | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 0 |  |  |  |  |  | $url = $mech->uri(); | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | my $bk = { | 
| 200 |  |  |  |  |  |  | 'ean13'         => $data->{isbn13}, | 
| 201 |  |  |  |  |  |  | 'isbn13'        => $data->{isbn13}, | 
| 202 |  |  |  |  |  |  | 'isbn10'        => $data->{isbn10}, | 
| 203 |  |  |  |  |  |  | 'isbn'          => $data->{isbn13}, | 
| 204 |  |  |  |  |  |  | 'author'        => $data->{author}, | 
| 205 |  |  |  |  |  |  | 'title'         => $data->{title}, | 
| 206 |  |  |  |  |  |  | 'book_link'     => $url, | 
| 207 |  |  |  |  |  |  | 'image_link'    => $data->{image}, | 
| 208 |  |  |  |  |  |  | 'thumb_link'    => $data->{thumb}, | 
| 209 |  |  |  |  |  |  | 'description'   => $data->{description}, | 
| 210 |  |  |  |  |  |  | 'pubdate'       => $data->{pubdate}, | 
| 211 |  |  |  |  |  |  | 'publisher'     => $data->{publisher}, | 
| 212 |  |  |  |  |  |  | 'binding'       => $data->{binding}, | 
| 213 |  |  |  |  |  |  | 'pages'         => $data->{pages}, | 
| 214 |  |  |  |  |  |  | 'weight'        => $data->{weight}, | 
| 215 |  |  |  |  |  |  | 'width'         => $data->{width}, | 
| 216 |  |  |  |  |  |  | 'height'        => $data->{height}, | 
| 217 |  |  |  |  |  |  | 'depth'         => $data->{depth}, | 
| 218 | 0 |  |  |  |  |  | 'html'          => $html | 
| 219 |  |  |  |  |  |  | }; | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | #use Data::Printer; | 
| 222 |  |  |  |  |  |  | #print STDERR "\n# book=".p($bk)."\n"; | 
| 223 |  |  |  |  |  |  |  | 
| 224 | 0 |  |  |  |  |  | $self->book($bk); | 
| 225 | 0 |  |  |  |  |  | $self->found(1); | 
| 226 | 0 |  |  |  |  |  | return $self->book; | 
| 227 |  |  |  |  |  |  | } | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | 1; | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | __END__ |