File Coverage

blib/lib/WWW/Scraper/ISBN/WHSmith_Driver.pm
Criterion Covered Total %
statement 24 81 29.6
branch 0 24 0.0
condition 0 21 0.0
subroutine 8 9 88.8
pod 1 1 100.0
total 33 136 24.2


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::WHSmith_Driver;
2              
3 5     5   287982 use strict;
  5         42  
  5         150  
4 5     5   30 use warnings;
  5         10  
  5         178  
5              
6 5     5   37 use vars qw($VERSION @ISA);
  5         10  
  5         467  
7             $VERSION = '0.09';
8              
9             #--------------------------------------------------------------------------
10              
11             =head1 NAME
12              
13             WWW::Scraper::ISBN::WHSmith_Driver - Search driver for the WHSmith 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 WHSmith online book catalog
22              
23             =cut
24              
25             #--------------------------------------------------------------------------
26              
27             ###########################################################################
28             # Inheritence
29              
30 5     5   38 use base qw(WWW::Scraper::ISBN::Driver);
  5         19  
  5         2683  
31              
32             ###########################################################################
33             # Modules
34              
35 5     5   9469 use WWW::Mechanize;
  5         768030  
  5         268  
36              
37             ###########################################################################
38             # Constants
39              
40 5     5   51 use constant REFERER => 'http://www.whsmith.co.uk';
  5         14  
  5         385  
41 5     5   33 use constant SEARCH => 'http://www.whsmith.co.uk/pws/ProductDetails.ice?ProductID=%s&keywords=%s&redirect=true';
  5         13  
  5         284  
42 5     5   33 use constant PRODUCT => '/products/[^/]+/product/';
  5         13  
  5         5212  
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             WHSmith 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 WHSmith 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           $isbn = $ean;
98             #print STDERR "\n# isbn=[\n$isbn\n]\n";
99              
100 0           my $mech = WWW::Mechanize->new();
101 0           $mech->agent_alias( 'Linux Mozilla' );
102 0           $mech->add_header( 'Accept-Encoding' => undef );
103 0           $mech->add_header( 'Referer' => REFERER );
104              
105 0           my $search = sprintf SEARCH, $isbn, $isbn;
106             #print STDERR "\n# search=[$search]\n";
107 0           eval { $mech->get( $search ) };
  0            
108 0 0 0       return $self->handler("the WHSmith website appears to be unavailable.")
      0        
109             if($@ || !$mech->success() || !$mech->content());
110              
111             # The Book page
112 0           my $html = $mech->content();
113 0 0 0       return $self->handler("Failed to find that book on the WHSmith website. [$isbn]")
114             if($html =~ m!Sorry, no products were found!si ||
115             $html !~ m!!si); # sometimes the WHSmith site only sends back a small portion of the page :(
116              
117 0           my $url = $mech->uri();
118 0 0         return $self->handler("Failed to find that book on the WHSmith website. [$isbn]")
119             if($url =~ m!Error.aspx!si);
120              
121 0           $html =~ s/&/&/g;
122 0           $html =~ s/�?39;/'/g;
123 0           $html =~ s/ / /g;
124              
125             #print STDERR "\n# html=[\n$html\n]\n";
126              
127 0           my $data;
128 0           ($data->{isbn13}) = $html =~ m!
  • \s*ISBN13:\s*(.*?)
  • !si;
    129 0           ($data->{isbn10}) = $html =~ m!
  • \s*ISBN10:\s*(.*?)
  • !si;
    130 0           ($data->{publisher}) = $html =~ m!Publisher:\s*([^<]+)!si;
    131 0           ($data->{pubdate}) = $html =~ m!!si;
    132 0           ($data->{title}) = $html =~ m!

    ([^<]*)

    !si;
    133 0           ($data->{binding}) = $html =~ m!
    .*?([^<]+)
    !si;
    134 0 0         ($data->{binding}) = $html =~ m!
  • \s*Format:\s*(.*?)
  • !si unless($data->{binding});
    135 0           ($data->{pages}) = $html =~ m!
  • \s*Number Of Pages:\s*(.*?)
  • !si;
    136 0           ($data->{author}) = $html =~ m!By:(.*?)!si;
    137 0           ($data->{image}) = $html =~ m!!si;
    138 0           ($data->{description}) = $html =~ m!

    Description

    \s*([^<]*)!si;
    139              
    140 0 0         if($data->{image}) {
    141 0           $data->{thumb} = $data->{image};
    142 0           $data->{thumb} =~ s!/x?large/!/small/!;
    143             }
    144              
    145             # currently not provided
    146 0           ($data->{width}) = $html =~ m!Width:\s*([^<]+)!si;
    147 0           ($data->{height}) = $html =~ m!Height:\s*([^<]+)!si;
    148 0           ($data->{weight}) = $html =~ m!
  • \s*weight:\s*(.*?)
  • !s;
    149              
    150 0 0         $data->{width} = int($data->{width}) if($data->{width});
    151 0 0         $data->{height} = int($data->{height}) if($data->{height});
    152 0 0         $data->{weight} = int($data->{weight}) if($data->{weight});
    153              
    154 0 0         if($data->{author}) {
    155 0           $data->{author} =~ s/<[^>]*>//g;
    156 0           $data->{author} =~ s/\(author\)/ /g;
    157 0           $data->{author} =~ s/\s+/ /g;
    158 0           $data->{author} =~ s/\s+,\s+/, /g;
    159             }
    160              
    161             #use Data::Dumper;
    162             #print STDERR "\n# data=" . Dumper($data);
    163              
    164 0 0         return $self->handler("Could not extract data from The WHSmith result page.")
    165             unless(defined $data);
    166              
    167             # trim top and tail
    168 0           foreach (keys %$data) {
    169 0 0         next unless(defined $data->{$_});
    170 0           $data->{$_} =~ s/^\s+//;
    171 0           $data->{$_} =~ s/\s+$//;
    172             }
    173              
    174             my $bk = {
    175             'ean13' => $data->{isbn13},
    176             'isbn13' => $data->{isbn13},
    177             'isbn10' => $data->{isbn10},
    178             'isbn' => $data->{isbn13},
    179             'author' => $data->{author},
    180             'title' => $data->{title},
    181             'book_link' => $url,
    182             'image_link' => $data->{image},
    183             'thumb_link' => $data->{thumb},
    184             'description' => $data->{description},
    185             'pubdate' => $data->{pubdate},
    186             'publisher' => $data->{publisher},
    187             'binding' => $data->{binding},
    188             'pages' => $data->{pages},
    189             'weight' => $data->{weight},
    190             'width' => $data->{width},
    191             'height' => $data->{height},
    192 0           'html' => $html
    193             };
    194              
    195             #use Data::Dumper;
    196             #print STDERR "\n# book=".Dumper($bk);
    197              
    198 0           $self->book($bk);
    199 0           $self->found(1);
    200 0           return $self->book;
    201             }
    202              
    203             1;
    204              
    205             __END__