File Coverage

blib/lib/WWW/Scraper/ISBN/AmazonUK_Driver.pm
Criterion Covered Total %
statement 85 92 92.3
branch 35 48 72.9
condition 13 24 54.1
subroutine 8 8 100.0
pod 1 1 100.0
total 142 173 82.0


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::AmazonUK_Driver;
2              
3 6     6   212819 use strict;
  6         29  
  6         169  
4 6     6   30 use warnings;
  6         12  
  6         202  
5              
6 6     6   30 use vars qw($VERSION);
  6         14  
  6         382  
7             $VERSION = '1.00';
8              
9             #--------------------------------------------------------------------------
10              
11             =head1 NAME
12              
13             WWW::Scraper::ISBN::AmazonUK_Driver - Search driver for Amazon.co.uk
14              
15             =head1 SYNOPSIS
16              
17             See parent class documentation (L)
18              
19             =head1 DESCRIPTION
20              
21             Searches for book information from the (UK) Amazon online catalog.
22              
23             =cut
24              
25             #--------------------------------------------------------------------------
26              
27             ###########################################################################
28             # Inheritence
29              
30 6     6   35 use base qw(WWW::Scraper::ISBN::Driver);
  6         32  
  6         1392  
31              
32             ###########################################################################
33             # Modules
34              
35 6     6   3081 use WWW::Mechanize;
  6         253992  
  6         184  
36 6     6   1653 use JSON;
  6         22447  
  6         37  
37              
38             ###########################################################################
39             # Variables
40              
41             my $AMA_SEARCH = 'http://www.amazon.co.uk/s/ref=nb_sb_noss?url=search-alias%3Daps&x=18&y=16&field-keywords=';
42             my $AMA_URL = 'http://www.amazon.co.uk/[^/]+/dp/[\dX]+/ref=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 (UK) 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 (UK) website.
84              
85             =back
86              
87             =cut
88              
89             sub search {
90 4     4 1 2741 my $self = shift;
91 4         18 my $isbn = shift;
92 4         12 $self->found(0);
93 4         52 $self->book(undef);
94              
95             # validate and convert into EAN13 format
96 4         40 my $ean = $self->convert_to_ean13($isbn);
97 4 50 66     175 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         102 my $mech = WWW::Mechanize->new();
102 4         14603 $mech->agent_alias( 'Linux Mozilla' );
103              
104 4         257 my $search = $AMA_SEARCH . $ean;
105              
106 4         8 eval { $mech->get( $search ) };
  4         11  
107 4 100 66     76 return $self->handler("Amazon UK website appears to be unavailable.")
      100        
108             if($@ || !$mech->success() || !$mech->content());
109              
110 2         30 my $content = $mech->content();
111             #print STDERR "\n# content=[$content]\n";
112 2         110 my ($link) = $content =~ m!($AMA_URL)!s;
113 2 100       20 return $self->handler("Failed to find that book on Amazon UK website.")
114             unless($link);
115              
116 1         1 eval { $mech->get( $link ) };
  1         3  
117 1 50 33     14 return $self->handler("Amazon UK website appears to be unavailable.")
      33        
118             if($@ || !$mech->success() || !$mech->content());
119              
120 1         12 return $self->_parse($mech);
121             }
122              
123             sub _parse {
124 3     3   1201 my $self = shift;
125 3         5 my $mech = shift;
126              
127             # The Book page
128 3         8 my $html = $mech->content;
129 3         428 my $data = {};
130              
131             #print STDERR "\n# html=[$html]\n";
132              
133 3         74 my @size = $html =~ m!
  • \s*Product Dimensions:\s*\s*([\d.]+) x ([\d.]+) x ([\d.]+) (cm)\s*
  • !si;
    134 3 100       11 @size = $html =~ m!
  • \s*Product Dimensions:\s*\s*([\d.]+) x ([\d.]+) x ([\d.]+) (inches)\s*
  • !si unless(@size);
    135 3 100       9 if(@size) {
    136 1         3 my $type = pop @size;
    137 1         5 ($data->{depth},$data->{width},$data->{height}) = sort @size;
    138 1 50       4 if($type eq 'cm') {
        0          
    139 1         10 $data->{$_} = int($data->{$_} * 10) for(qw( height width depth ));
    140             } elsif($type eq 'inches') {
    141 0         0 $data->{$_} = int($data->{$_} / $IN2MM) for(qw( height width depth ));
    142             }
    143             }
    144              
    145 3         32 ($data->{binding},$data->{pages}) = $html =~ m!
  • (Paperback|Hardcover):\s*([\d.]+)\s*pages
  • !si;
    146 3         24 ($data->{weight}) = $html =~ m!
  • Shipping Weight:\s*([\d.]+)\s*ounces
  • !si;
    147 3         23 ($data->{published}) = $html =~ m!
  • Publisher:\s*(.*?)
  • !si;
    148 3         24 ($data->{isbn10}) = $html =~ m!
  • ISBN-10:\s*(.*?)
  • !si;
    149 3         29 ($data->{isbn13}) = $html =~ m!
  • ISBN-13:\s*(.*?)
  • !si;
    150 3         16 ($data->{content}) = $html =~ m!
    151 3         36 ($data->{description}) = $html =~ m!From the Back Cover\s*
    \s*

    (.*?)

    152 3 100       11 ($data->{description}) = $html =~ m!
    ]*>.*?
    153              
    154 3 100       9 $data->{weight} = int($data->{weight} / $OZ2G) if($data->{weight});
    155              
    156 3 100       16 if($data->{description}) {
    157 1         6 $data->{description} =~ s!<[^>]+>!!g;
    158 1         41 $data->{description} =~ s! +! !g;
    159             }
    160              
    161             # The images
    162 3         29 my ($json) = $html =~ /var colorImages = ([^;]+);/si;
    163 3 50       8 if($json) {
    164 0         0 my $code = decode_json($json);
    165 0         0 my @order = grep {$_} $code->{initial}[0]{thumb}, $code->{initial}[0]{landing}, @{$code->{initial}[0]{main}}, $code->{initial}[0]{large};
      0         0  
      0         0  
    166 0 0       0 $data->{thumb_link} = $order[0] if(@order);
    167 0 0       0 $data->{image_link} = $order[-1] if(@order);
    168              
    169             #use Data::Dumper;
    170             #print STDERR "\n# code=[".Dumper($code)."]\n";
    171             } else {
    172 3         16 my ($code) = $html =~ /'imageGalleryData'\s*:\s*([^;]+);/si;
    173 3 100       8 if($code) {
    174 1         6 ($data->{thumb_link}) = $code =~ /"thumbUrl":\s*"([^+]+)"/;
    175 1         5 ($data->{image_link}) = $code =~ /"mainUrl":\s*"([^+]+)"/;
    176             }
    177             #use Data::Dumper;
    178             #print STDERR "\n# code=[".Dumper($code)."]\n";
    179             }
    180              
    181              
    182             # {\"initial\":[{\"large\":\"http://ecx.images-amazon.com/images/I/31cLTIXHKgL.jpg\",\"landing\":[\"http://ecx.images-amazon.com/images/I/31cLTIXHKgL._SY300_.jpg\"],\"thumb\":\"http://ecx.images-amazon.com/images/I/31cLTIXHKgL._SS40_.jpg\",\"main\":[\"http://ecx.images-amazon.com/images/I/31cLTIXHKgL._SX342_.jpg\",\"http://ecx.images-amazon.com/images/I/31cLTIXHKgL._SX385_.jpg\"]}]};
    183              
    184 3 100       10 if($data->{content}) {
    185 1         3 $data->{content} =~ s/Amazon\.co\.uk.*?://i;
    186 1         2 $data->{content} =~ s/: Books.*//i;
    187 1         7 ($data->{title},$data->{author}) = split(/\s+by\s+/,$data->{content});
    188 1 50       5 $data->{title} =~ s/^Buy\s+// if($data->{title});
    189 1 50       6 $data->{author} =~ s/\s*\(.*// if($data->{author});
    190             }
    191              
    192 3 100       14 ($data->{publisher},$data->{pubdate}) = ($data->{published} =~ /\s*(.*?)(?:;.*?)?\s+\((.*?)\)/) if($data->{published});
    193 3 100       10 $data->{isbn10} =~ s/[^\dX]+//g if($data->{isbn10});
    194 3 100       10 $data->{isbn13} =~ s/\D+//g if($data->{isbn13});
    195 3 100       9 $data->{pubdate} =~ s/^.*?\(// if($data->{pubdate});
    196              
    197             return $self->handler("Could not extract data from Amazon UK result page.")
    198 3 100       18 unless(defined $data->{isbn13});
    199              
    200             # trim top and tail
    201 1 50       5 foreach (keys %$data) { next unless(defined $data->{$_});$data->{$_} =~ s/^\s+//;$data->{$_} =~ s/\s+$//; }
      17         26  
      17         26  
      17         46  
    202              
    203             #use Data::Dumper;
    204             #print STDERR "\n# data=[".Dumper($data)."]\n";
    205              
    206             my $bk = {
    207             'ean13' => $data->{isbn13},
    208             'isbn13' => $data->{isbn13},
    209             'isbn10' => $data->{isbn10},
    210             'isbn' => $data->{isbn13},
    211             'author' => $data->{author},
    212             'title' => $data->{title},
    213             'image_link' => $data->{image_link},
    214             'thumb_link' => $data->{thumb_link},
    215             'publisher' => $data->{publisher},
    216             'pubdate' => $data->{pubdate},
    217             'book_link' => $mech->uri(),
    218             'content' => $data->{content},
    219             'binding' => $data->{binding},
    220             'pages' => $data->{pages},
    221             'weight' => $data->{weight},
    222             'width' => $data->{width},
    223             'height' => $data->{height},
    224             'depth' => $data->{depth},
    225             'description' => $data->{description},
    226 1         8 'html' => $html
    227             };
    228 1         29 $self->book($bk);
    229 1         12 $self->found(1);
    230 1         9 return $self->book;
    231             }
    232              
    233             q{currently reading: 'Torn Apart: The Life of Ian Curtis' by Mick Middles and Lindsay Reade};
    234              
    235             __END__