File Coverage

blib/lib/WWW/Scraper/ISBN/AmazonUS_Driver.pm
Criterion Covered Total %
statement 97 98 98.9
branch 34 44 77.2
condition 24 42 57.1
subroutine 9 9 100.0
pod 1 1 100.0
total 165 194 85.0


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::AmazonUS_Driver;
2              
3 7     7   109078 use strict;
  7         14  
  7         296  
4 7     7   60 use warnings;
  7         8  
  7         248  
5              
6 7     7   31 use vars qw($VERSION);
  7         6  
  7         502  
7             $VERSION = '0.41';
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   33 use base qw(WWW::Scraper::ISBN::Driver);
  7         9  
  7         3637  
31              
32             ###########################################################################
33             # Modules
34              
35 7     7   10725 use WWW::Mechanize;
  7         886756  
  7         251  
36 7     7   3336 use JSON;
  7         44635  
  7         37  
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 2     2 1 7386 my $self = shift;
91 2         3 my $isbn = shift;
92 2         7 $self->found(0);
93 2         28 $self->book(undef);
94              
95             # validate and convert into EAN13 format
96 2         23 my $ean = $self->convert_to_ean13($isbn);
97 2 50 66     76 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 2         40 my $mech = WWW::Mechanize->new();
102 2         12519 $mech->agent_alias( 'Linux Mozilla' );
103              
104 2         116 my $search = sprintf $AMA_SEARCH, $ean;
105              
106 2         3 eval { $mech->get( $search ) };
  2         7  
107 2 50 33     1612222 return $self->handler("Amazon US website appears to be unavailable.")
      33        
108             if($@ || !$mech->success() || !$mech->content());
109              
110 2         124 my $content = $mech->content();
111 2         303 my ($link) = $content =~ m!($AMA_URL)!s;
112 2 50       12 return $self->handler("Failed to find that book on Amazon US website.")
113             unless($link);
114              
115 2         4 eval { $mech->get( $link ) };
  2         14  
116 2 50 33     2446602 return $self->handler("Amazon US website appears to be unavailable.")
      33        
117             if($@ || !$mech->success() || !$mech->content());
118              
119 2         156 return $self->_parse($mech);
120             }
121              
122             sub _parse {
123 4     4   8361 my $self = shift;
124 4         8 my $mech = shift;
125              
126             # The Book page
127 4         15 my $html = $mech->content;
128 4         413 my $data = {};
129              
130             #print STDERR "\n# html=[$html]\n";
131              
132 4         57 my @patterns = (
133             qr/ 134             qr/ 135             qr/ 136             qr/ 137             qr/ 138             );
139              
140 4         13 for my $pattern (@patterns) {
141 8         5307 my ($title,$author) = $html =~ $pattern;
142 8   66     51 $data->{title} ||= $title;
143 8   66     30 $data->{author} ||= $author;
144             #print STDERR "\n# title=[$data->{title}], author=[$data->{author}] pattern=[$pattern]\n";
145              
146 8 100 66     39 last if($data->{title} && $data->{author});
147             }
148              
149 4         21997 ($data->{binding},$data->{pages}) = $html =~ m!
  • (Paperback|Hardcover):\s*([\d.]+)\s*pages
  • !si;
    150 4         22126 ($data->{published}) = $html =~ m!
  • Publisher:\s*(.*?)
  • !si;
    151 4         22279 ($data->{isbn10}) = $html =~ m!
  • ISBN-10:\s*(.*?)
  • !si;
    152 4         22283 ($data->{isbn13}) = $html =~ m!
  • ISBN-13:\s*(.*?)
  • !si;
    153 4         4619 ($data->{content}) = $html =~ m!
    154              
    155 4         101 @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 4         11 for my $pattern (@patterns) {
    164 16     1   165282 my ($desc) = $html =~ $pattern;
      1         15  
      1         2  
      1         20  
    165 16 100       35329 $desc =~ s/\s+$//s if($desc);
    166 16   66     103 $data->{description} ||= $desc;
    167              
    168 16 100       61 last if($data->{description});
    169             }
    170              
    171 4         11 for my $key (qw(description)) {
    172 4 100       13 next unless($data->{$key});
    173 3         112 $data->{$key} =~ s/<[^>]*>//gs;
    174             }
    175              
    176             # amazon use both ounces and pounds
    177 4         8 my $weight;
    178 4         21401 ($data->{weight},$weight) = $html =~ m!
  • Shipping Weight:\s*([\d.]+)\s*(ounces|pounds)!si;
  • 179 4 100 100     42 $data->{weight} = int($data->{weight} / $OZ2G) if($data->{weight} && $weight eq 'ounces');
    180 4 100 100     39 $data->{weight} = int($data->{weight} / $LB2G) if($data->{weight} && $weight eq 'pounds');
    181              
    182             # amazon change this regularly
    183 4         85027 my @size = $html =~ m!
  • \s*Product Dimensions:\s*\s*([\d.]+) x ([\d.]+) x ([\d.]+) (cm)\s*
  • !si;
    184 4 50       68947 @size = $html =~ m!
  • \s*Product Dimensions:\s*\s*([\d.]+) x ([\d.]+) x ([\d.]+) (inches)\s*
  • !si unless(@size);
    185 4 100       22 if(@size) {
    186 3         9 my $type = pop @size;
    187 3         27 ($data->{depth},$data->{width},$data->{height}) = sort @size;
    188 3 50       21 if($type eq 'cm') {
        50          
    189 0         0 $data->{$_} = int($data->{$_} * 10) for(qw( height width depth ));
    190             } elsif($type eq 'inches') {
    191 3         45 $data->{$_} = int($data->{$_} / $IN2MM) for(qw( height width depth ));
    192             }
    193             }
    194              
    195             # The images
    196 4         25719 my ($json) = $html =~ /var colorImages = ([^;]+);/si;
    197 4 100       18 if($json) {
    198 1         9 my $code = decode_json($json);
    199 1         4 my @order = grep {$_} $code->{initial}[0]{thumb}, $code->{initial}[0]{landing}, @{$code->{initial}[0]{main}}, $code->{initial}[0]{large};
      5         6  
      1         4  
    200 1 50       4 $data->{thumb_link} = $order[0] if(@order);
    201 1 50       6 $data->{image_link} = $order[-1] if(@order);
    202             } else {
    203 3         199 ($data->{thumb_link}) = $html =~ m!imageGalleryData.*?thumbUrl":"([^"]+)"!;
    204 3         245 ($data->{image_link}) = $html =~ m!imageGalleryData.*?mainUrl":"([^"]+)"!;
    205             }
    206              
    207 4 100       70 ($data->{publisher},$data->{pubdate}) = ($data->{published} =~ /\s*(.*?)(?:;.*?)?\s+\((.*?)\)/) if($data->{published});
    208 4 100       23 $data->{isbn10} =~ s/[^\dX]+//g if($data->{isbn10});
    209 4 100       28 $data->{isbn13} =~ s/\D+//g if($data->{isbn13});
    210              
    211              
    212 4 100       26 return $self->handler("Could not extract data from Amazon US result page.")
    213             unless(defined $data->{isbn13});
    214              
    215             # trim top and tail
    216 3 50       22 foreach (keys %$data) { next unless(defined $data->{$_});$data->{$_} =~ s/^\s+//;$data->{$_} =~ s/\s+$//; }
      51         77  
      51         85  
      51         185  
    217              
    218 3         38 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             'html' => $html
    239             };
    240 3         131 $self->book($bk);
    241 3         59 $self->found(1);
    242 3         26 return $self->book;
    243             }
    244              
    245             q{currently reading: 'Soul Music' by Terry Pratchett};
    246              
    247             __END__