File Coverage

blib/lib/WWW/Scraper/ISBN/BarnesNoble_Driver.pm
Criterion Covered Total %
statement 15 88 17.0
branch 0 26 0.0
condition 0 18 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 21 139 15.1


.*?!si; .*?.*?!si; .*?!si; .*?!si;
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+)
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:([^<]+)
136 0           ($data->{pages}) = $html =~ m!Pages:(.*?)
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\)
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!
145 0           $data->{author} =~ s!
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__