File Coverage

blib/lib/WWW/Scraper/ISBN/BookDepository_Driver.pm
Criterion Covered Total %
statement 79 79 100.0
branch 16 32 50.0
condition 9 21 42.8
subroutine 9 9 100.0
pod 1 1 100.0
total 114 142 80.2


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::BookDepository_Driver;
2              
3 6     6   113981 use strict;
  6         16  
  6         250  
4 6     6   27 use warnings;
  6         10  
  6         226  
5              
6 6     6   24 use vars qw($VERSION @ISA);
  6         13  
  6         598  
7             $VERSION = '0.12';
8              
9             #--------------------------------------------------------------------------
10              
11             =head1 NAME
12              
13             WWW::Scraper::ISBN::BookDepository_Driver - Search driver for The Book Depository 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 Book Depository online book catalog
22              
23             =cut
24              
25             #--------------------------------------------------------------------------
26              
27             ###########################################################################
28             # Inheritence
29              
30 6     6   33 use base qw(WWW::Scraper::ISBN::Driver);
  6         8  
  6         3191  
31              
32             ###########################################################################
33             # Modules
34              
35 6     6   9735 use WWW::Mechanize;
  6         821879  
  6         360  
36              
37             ###########################################################################
38             # Constants
39              
40 6     6   66 use constant REFERER => 'http://www.bookdepository.co.uk/';
  6         9  
  6         508  
41 6     6   26 use constant SEARCH => 'http://www.bookdepository.co.uk/search?search=search&searchTerm=';
  6         10  
  6         5899  
42             my ($URL1,$URL2) = ('http://www.bookdepository.co.uk/book/','/[^?]+\?b=\-3\&t=\-26\#Bibliographicdata\-26');
43              
44             #--------------------------------------------------------------------------
45              
46             ###########################################################################
47             # Public Interface
48              
49             =head1 METHODS
50              
51             =over 4
52              
53             =item C
54              
55             Creates a query string, then passes the appropriate form fields to the
56             Book Depository server.
57              
58             The returned page should be the correct catalog page for that ISBN. If not the
59             function returns zero and allows the next driver in the chain to have a go. If
60             a valid page is returned, the following fields are returned via the book hash:
61              
62             isbn (now returns isbn13)
63             isbn10
64             isbn13
65             ean13 (industry name)
66             author
67             title
68             book_link
69             image_link
70             description
71             pubdate
72             publisher
73             binding (if known)
74             pages (if known)
75             weight (if known) (in grammes)
76             width (if known) (in millimetres)
77             height (if known) (in millimetres)
78              
79             The book_link and image_link refer back to the The Book Depository website.
80              
81             =back
82              
83             =cut
84              
85             sub search {
86 2     2 1 10498 my $self = shift;
87 2         3 my $isbn = shift;
88 2         9 $self->found(0);
89 2         27 $self->book(undef);
90              
91             # validate and convert into EAN13 format
92 2         17 my $ean = $self->convert_to_ean13($isbn);
93 2 50 66     89 return $self->handler("Invalid ISBN specified")
      33        
      66        
      33        
94             if(!$ean || (length $isbn == 13 && $isbn ne $ean)
95             || (length $isbn == 10 && $isbn ne $self->convert_to_isbn10($ean)));
96              
97 2         56 my $mech = WWW::Mechanize->new();
98 2         14124 $mech->agent_alias( 'Windows IE 6' );
99 2         142 $mech->add_header( 'Accept-Encoding' => undef );
100 2         27 $mech->add_header( 'Referer' => REFERER );
101              
102             #print STDERR "\n# search=[".SEARCH."$ean]\n";
103 2         17 eval { $mech->get( SEARCH . $ean ) };
  2         12  
104 2 50 33     975684 return $self->handler("The Book Depository website appears to be unavailable.")
      33        
105             if($@ || !$mech->success() || !$mech->content());
106              
107             # The Book page
108 2         117 my $html = $mech->content();
109              
110 2 50   1   1884 return $self->handler("Failed to find that book on The Book Depository website. [$isbn]")
  1         8  
  1         2  
  1         13  
111             if($html =~ m!Sorry, there are no results for!si);
112            
113 2         23907 $html =~ s/&/&/g;
114             #print STDERR "\n# content2=[\n$html\n]\n";
115              
116 2         6 my $data;
117              
118             # first pass wih metadata
119 2         1768 ($data->{isbn13}) = $html =~ m!
120 2         2014 ($data->{publisher}) = $html =~ m!
121 2         2146 ($data->{pubdate}) = $html =~ m!
122 2         1801 ($data->{title}) = $html =~ m!
123 2         1830 ($data->{author}) = $html =~ m!
124 2         2010 ($data->{description}) = $html =~ m!
125 2         1835 ($data->{image}) = $html =~ m!
126 2         1935 ($data->{url}) = $html =~ m!
127 2         2349 ($data->{pages}) = $html =~ m!
128              
129             # second pass with page data
130 2 50       16 ($data->{isbn13}) = $html =~ m!ISBN 13:([^<]+)!si unless($data->{isbn13});
131 2 50       9 ($data->{publisher}) = $html =~ m!
  • Publisher: ]+>([^<]+)
  • !si unless($data->{publisher});
    132 2 50       10 ($data->{pubdate}) = $html =~ m!Publication date:\s*([^<]+)!si unless($data->{pubdate});
    133 2 50       8 ($data->{pages}) = $html =~ m!\s*(\d+) pages!si unless($data->{pages});
    134 2 50       6 ($data->{image}) = $html =~ m!"(http://\w+.bdcdn.net/assets/images/book/large/\d+/\d+/\d+.jpg)"!si unless($data->{image});
    135 2 50 33     18 ($data->{title},$data->{author})
    136             = $html =~ m!(.*):\s+([^:]+)\s+:\s+\d+\s*! unless($data->{title} && $data->{author});
    137              
    138             # other page data
    139 2         1115 ($data->{isbn10}) = $html =~ m!
  • ISBN 10:\s*([^<]+)
  • !si;
    140 2         1035 ($data->{binding}) = $html =~ m!Format:\s*([^<]+)!si;
    141 2         933 ($data->{thumb}) = $html =~ m!"(http://\w+.bdcdn.net/assets/images/book/medium/\d+/\d+/\d+.jpg)"!si;
    142 2         49 ($data->{width},$data->{height},$data->{depth},$data->{weight})
    143             = $html =~ m!Dimensions:\s*(\d+)mm\s*x\s*(\d+)mm\s*x\s*(\d+)mm\s*\|\s*(\d+)g!;
    144              
    145             # clean up
    146 2 50       21 $data->{publisher} =~ s/�?39;/'/g if($data->{publisher});
    147 2 50       15 $data->{width} = int($data->{width}) if($data->{width});
    148 2 50       11 $data->{height} = int($data->{height}) if($data->{height});
    149 2 50       6 $data->{weight} = int($data->{weight}) if($data->{weight});
    150 2 50       8 unless($data->{thumb}) {
    151 2         6 $data->{thumb} = $data->{image};
    152 2         12 $data->{thumb} =~ s!/large/!/medium/!;
    153             }
    154              
    155             #use Data::Dumper;
    156             #print STDERR "\n# " . Dumper($data);
    157              
    158 2 50       8 return $self->handler("Could not extract data from The Book Depository result page.")
    159             unless(defined $data);
    160              
    161             # trim top and tail
    162 2         16 foreach (keys %$data) {
    163 32 50       47 next unless(defined $data->{$_});
    164 32         41 $data->{$_} =~ s! ! !g;
    165 32         42 $data->{$_} =~ s/^\s+//;
    166 32         94 $data->{$_} =~ s/\s+$//;
    167             }
    168              
    169 2         19 my $url = $mech->uri();
    170 2         92 $url =~ s/\?.*//;
    171              
    172 2         21 my $bk = {
    173             'ean13' => $data->{isbn13},
    174             'isbn13' => $data->{isbn13},
    175             'isbn10' => $data->{isbn10},
    176             'isbn' => $data->{isbn13},
    177             'author' => $data->{author},
    178             'title' => $data->{title},
    179             'book_link' => "$url",
    180             'image_link' => $data->{image},
    181             'thumb_link' => $data->{thumb},
    182             'description' => $data->{description},
    183             'pubdate' => $data->{pubdate},
    184             'publisher' => $data->{publisher},
    185             'binding' => $data->{binding},
    186             'pages' => $data->{pages},
    187             'weight' => $data->{weight},
    188             'width' => $data->{width},
    189             'height' => $data->{height},
    190             'html' => $html
    191             };
    192              
    193             #use Data::Dumper;
    194             #print STDERR "\n# book=".Dumper($bk);
    195              
    196 2         44 $self->book($bk);
    197 2         37 $self->found(1);
    198 2         14 return $self->book;
    199             }
    200              
    201             1;
    202              
    203             __END__