File Coverage

blib/lib/WWW/Scraper/ISBN/AmazonUS_Driver.pm
Criterion Covered Total %
statement 94 95 98.9
branch 34 44 77.2
condition 25 42 59.5
subroutine 8 8 100.0
pod 1 1 100.0
total 162 190 85.2


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::AmazonUS_Driver;
2              
3 7     7   394725 use strict;
  7         68  
  7         197  
4 7     7   35 use warnings;
  7         14  
  7         222  
5              
6 7     7   36 use vars qw($VERSION);
  7         12  
  7         484  
7             $VERSION = '1.00';
8              
9             #--------------------------------------------------------------------------
10              
11             =head1 NAME
12              
13             WWW::Scraper::ISBN::AmazonUS_Driver - Search driver for Amazon.com
14              
15             =head1 SYNOPSIS
16              
17             See parent class documentation (L)
18              
19             =head1 DESCRIPTION
20              
21             Searches for book information from the (US) Amazon online catalog.
22              
23             =cut
24              
25             #--------------------------------------------------------------------------
26              
27             ###########################################################################
28             # Inheritence
29              
30 7     7   51 use base qw(WWW::Scraper::ISBN::Driver);
  7         24  
  7         2708  
31              
32             ###########################################################################
33             # Modules
34              
35 7     7   8057 use WWW::Mechanize;
  7         684657  
  7         292  
36 7     7   3985 use JSON;
  7         53192  
  7         42  
37              
38             ###########################################################################
39             # Variables
40              
41             my $AMA_SEARCH = 'http://www.amazon.com/s/ref=nb_sb_noss?url=search-alias=us-stripbooks-tree&field-keywords=%s';
42             my $AMA_URL = 'http://www.amazon.com/[^/]+/dp/[\dX]+/ref=sr_1_1.*?sr=1-1';
43             my $IN2MM = 0.0393700787; # number of inches in a millimetre (mm)
44             my $LB2G = 0.00220462; # number of pounds (lbs) in a gram
45             my $OZ2G = 0.035274; # number of ounces (oz) in a gram
46              
47             #--------------------------------------------------------------------------
48              
49             ###########################################################################
50             # Public Interface
51              
52             =head1 METHODS
53              
54             =over 4
55              
56             =item C
57              
58             Creates a query string, then passes the appropriate form fields to the
59             Amazon (US) server.
60              
61             The returned page should be the correct catalog page for that ISBN. If not the
62             function returns zero and allows the next driver in the chain to have a go. If
63             a valid page is returned, the following fields are returned via the book hash:
64              
65             isbn (now returns isbn13)
66             isbn10
67             isbn13
68             ean13 (industry name)
69             author
70             title
71             book_link
72             thumb_link
73             image_link
74             pubdate
75             publisher
76             binding (if known)
77             pages (if known)
78             weight (if known) (in grams)
79             width (if known) (in millimetres)
80             height (if known) (in millimetres)
81             depth (if known) (in millimetres)
82              
83             The book_link, thumb_link and image_link refer back to the Amazon (US) website.
84              
85             =back
86              
87             =cut
88              
89             sub search {
90 4     4 1 2665 my $self = shift;
91 4         6 my $isbn = shift;
92 4         12 $self->found(0);
93 4         53 $self->book(undef);
94              
95             # validate and convert into EAN13 format
96 4         41 my $ean = $self->convert_to_ean13($isbn);
97 4 50 66     207 return $self->handler("Invalid ISBN specified [$isbn]")
      33        
      66        
      33        
98             if(!$ean || (length $isbn == 13 && $isbn ne $ean)
99             || (length $isbn == 10 && $isbn ne $self->convert_to_isbn10($ean)));
100              
101 4         115 my $mech = WWW::Mechanize->new();
102 4         14514 $mech->agent_alias( 'Linux Mozilla' );
103              
104 4         269 my $search = sprintf $AMA_SEARCH, $ean;
105              
106 4         9 eval { $mech->get( $search ) };
  4         13  
107 4 100 66     75 return $self->handler("Amazon US website appears to be unavailable.")
      100        
108             if($@ || !$mech->success() || !$mech->content());
109              
110 2         29 my $content = $mech->content();
111 2         49 my ($link) = $content =~ m!($AMA_URL)!s;
112 2 100       8 return $self->handler("Failed to find that book on Amazon US website.")
113             unless($link);
114              
115 1         2 eval { $mech->get( $link ) };
  1         3  
116 1 50 33     15 return $self->handler("Amazon US website appears to be unavailable.")
      33        
117             if($@ || !$mech->success() || !$mech->content());
118              
119 1         13 return $self->_parse($mech);
120             }
121              
122             sub _parse {
123 3     3   1264 my $self = shift;
124 3         7 my $mech = shift;
125              
126             # The Book page
127 3         9 my $html = $mech->content;
128 3         404 my $data = {};
129              
130             #print STDERR "\n# html=[$html]\n";
131              
132 3         28 my @patterns = (
133             qr/ 134             qr/ 135             qr/ 136             qr/ 137             qr/ 138             );
139              
140 3         11 for my $pattern (@patterns) {
141 11         45 my ($title,$author) = $html =~ $pattern;
142 11   66     75 $data->{title} ||= $title;
143 11   66     36 $data->{author} ||= $author;
144             #print STDERR "\n# title=[$data->{title}], author=[$data->{author}] pattern=[$pattern]\n";
145              
146 11 50 66     35 last if($data->{title} && $data->{author});
147             }
148              
149 3         28 ($data->{binding},$data->{pages}) = $html =~ m!
  • (Paperback|Hardcover):\s*([\d.]+)\s*pages
  • !si;
    150 3         31 ($data->{published}) = $html =~ m!
  • Publisher:\s*(.*?)
  • !si;
    151 3         23 ($data->{isbn10}) = $html =~ m!
  • ISBN-10:\s*(.*?)
  • !si;
    152 3         22 ($data->{isbn13}) = $html =~ m!
  • ISBN-13:\s*(.*?)
  • !si;
    153 3         14 ($data->{content}) = $html =~ m!
    154              
    155 3         35 @patterns = (
    156             qr!

    Book Description

    .*?
    ]+>\s*]*>\s*

    \s*(.*?)\s*

    \s*
    157             qr!

    Book Description

    .*?
    ]+>\s*]*>\s*(.*?)\s*
    158             qr!

    (?:Product Description|From the Back Cover)

    \s*
    \s*

    ([^<]+)!si,

    159             qr!

    (?:Product Description|From the Back Cover)

    \s*
    \s*(.*?)
    160             qr!
    ]+>\s*]*>.*?\s*!si
    161             );
    162              
    163 3         9 for my $pattern (@patterns) {
    164 11         84 my ($desc) = $html =~ $pattern;
    165 11 100       37 $desc =~ s/\s+$//s if($desc);
    166 11   66     40 $data->{description} ||= $desc;
    167              
    168 11 100       22 last if($data->{description});
    169             }
    170              
    171 3         7 for my $key (qw(description)) {
    172 3 100       10 next unless($data->{$key});
    173 1         4 $data->{$key} =~ s/<[^>]*>//gs;
    174             }
    175              
    176             # amazon use both ounces and pounds
    177 3         6 my $weight;
    178 3         22 ($data->{weight},$weight) = $html =~ m!
  • Shipping Weight:\s*([\d.]+)\s*(ounces|pounds)!si;
  • 179 3 100 66     24 $data->{weight} = int($data->{weight} / $OZ2G) if($data->{weight} && $weight eq 'ounces');
    180 3 50 66     15 $data->{weight} = int($data->{weight} / $LB2G) if($data->{weight} && $weight eq 'pounds');
    181              
    182             # amazon change this regularly
    183 3         57 my @size = $html =~ m!
  • \s*Product Dimensions:\s*\s*([\d.]+) x ([\d.]+) x ([\d.]+) (cm)\s*
  • !si;
    184 3 50       55 @size = $html =~ m!
  • \s*Product Dimensions:\s*\s*([\d.]+) x ([\d.]+) x ([\d.]+) (inches)\s*
  • !si unless(@size);
    185 3 100       8 if(@size) {
    186 1         4 my $type = pop @size;
    187 1         9 ($data->{depth},$data->{width},$data->{height}) = sort @size;
    188 1 50       6 if($type eq 'cm') {
        50          
    189 0         0 $data->{$_} = int($data->{$_} * 10) for(qw( height width depth ));
    190             } elsif($type eq 'inches') {
    191 1         9 $data->{$_} = int($data->{$_} / $IN2MM) for(qw( height width depth ));
    192             }
    193             }
    194              
    195             # The images
    196 3         15 my ($json) = $html =~ /var colorImages = ([^;]+);/si;
    197 3 100       17 if($json) {
    198 1         12 my $code = decode_json($json);
    199 1         3 my @order = grep {$_} $code->{initial}[0]{thumb}, $code->{initial}[0]{landing}, @{$code->{initial}[0]{main}}, $code->{initial}[0]{large};
      5         9  
      1         5  
    200 1 50       5 $data->{thumb_link} = $order[0] if(@order);
    201 1 50       6 $data->{image_link} = $order[-1] if(@order);
    202             } else {
    203 2         8 ($data->{thumb_link}) = $html =~ m!imageGalleryData.*?thumbUrl":"([^"]+)"!;
    204 2         7 ($data->{image_link}) = $html =~ m!imageGalleryData.*?mainUrl":"([^"]+)"!;
    205             }
    206              
    207 3 100       17 ($data->{publisher},$data->{pubdate}) = ($data->{published} =~ /\s*(.*?)(?:;.*?)?\s+\((.*?)\)/) if($data->{published});
    208 3 100       10 $data->{isbn10} =~ s/[^\dX]+//g if($data->{isbn10});
    209 3 100       11 $data->{isbn13} =~ s/\D+//g if($data->{isbn13});
    210              
    211              
    212             return $self->handler("Could not extract data from Amazon US result page.")
    213 3 100       21 unless(defined $data->{isbn13});
    214              
    215             # trim top and tail
    216 1 50       6 foreach (keys %$data) { next unless(defined $data->{$_});$data->{$_} =~ s/^\s+//;$data->{$_} =~ s/\s+$//; }
      17         25  
      17         28  
      17         43  
    217              
    218             my $bk = {
    219             'ean13' => $data->{isbn13},
    220             'isbn13' => $data->{isbn13},
    221             'isbn10' => $data->{isbn10},
    222             'isbn' => $data->{isbn13},
    223             'author' => $data->{author},
    224             'title' => $data->{title},
    225             'image_link' => $data->{image_link},
    226             'thumb_link' => $data->{thumb_link},
    227             'publisher' => $data->{publisher},
    228             'pubdate' => $data->{pubdate},
    229             'book_link' => $mech->uri(),
    230             'content' => $data->{content},
    231             'binding' => $data->{binding},
    232             'pages' => $data->{pages},
    233             'weight' => $data->{weight},
    234             'width' => $data->{width},
    235             'height' => $data->{height},
    236             'depth' => $data->{depth},
    237             'description' => $data->{description},
    238 1         8 'html' => $html
    239             };
    240 1         21 $self->book($bk);
    241 1         13 $self->found(1);
    242 1         11 return $self->book;
    243             }
    244              
    245             q{currently reading: 'Happy Hour In Hell' by Tad Williams};
    246              
    247             __END__