File Coverage

blib/lib/WWW/Scraper/ISBN/AmazonDE_Driver.pm
Criterion Covered Total %
statement 65 68 95.5
branch 6 10 60.0
condition n/a
subroutine 11 11 100.0
pod 1 1 100.0
total 83 90 92.2


line stmt bran cond sub pod time code
1             package WWW::Scraper::ISBN::AmazonDE_Driver;
2              
3 4     4   74231 use warnings;
  4         8  
  4         140  
4 4     4   22 use strict;
  4         6  
  4         138  
5              
6 4     4   12796 use WWW::Scraper::ISBN::Driver;
  4         1766  
  4         100  
7 4     4   20 use base qw(WWW::Scraper::ISBN::Driver);
  4         6  
  4         368  
8 4     4   2770 use WWW::Mechanize;
  4         561088  
  4         152  
9 4     4   2386 use Web::Scraper;
  4         211395  
  4         25  
10              
11 4     4   235 use constant AMAZON => 'http://www.amazon.de/';
  4         7  
  4         261  
12 4     4   27 use constant SEARCH => 'http://www.amazon.de/';
  4         15  
  4         183  
13 4     4   17 use constant DIRECT => 'http://www.amazon.de/gp/product/';
  4         4  
  4         2498  
14              
15             our $DEBUG = $ENV{ISBN_DRIVER_DEBUG};
16              
17             # ABSTRACT: [DEPRECATED] Search driver for the (DE) Amazon online catalog.
18              
19             our $VERSION = '0.28';
20              
21              
22             sub search {
23 1     1 1 211 my ($self,$isbn) = @_;
24            
25 1         5 $self->found(0);
26 1         17 $self->book(undef);
27              
28 1         11 my $mechanize = WWW::Mechanize->new();
29 1         16552 $mechanize->agent_alias( 'Linux Mozilla' );
30              
31             # $mechanize->get( SEARCH );
32             # return $self->handler('Error loading amazon.de form web page (unreachable?)')
33             # unless($mechanize->success());
34             #
35 1         64 my ($index,$input) = (0,0);
36              
37             # $mechanize->form_name('site-search')
38             # or return $self->handler('Error parsing amazon.de form');
39              
40             # my $keyword ='search-alias=stripbooks';
41             # $mechanize->set_fields(
42             # 'field-keywords' => $isbn,
43             # 'url' => $keyword
44             # );
45             # $mechanize->submit();
46              
47             # return $self->handler('Error about form submission (form changed?)')
48             # unless($mechanize->success());
49              
50 1         4 (my $norm_isbn = $isbn) =~ s/[^0-9]//g;
51 1         3 my $url = DIRECT . $norm_isbn;
52 1         3 $mechanize->get( $url );
53              
54 1 50       1447086 return $self->handler( "No success when trying to get $url" )
55             unless $mechanize->success;
56              
57 1         31 my $content = $mechanize->content();
58              
59             #$DEBUG and warn $content;
60            
61             my $scraper = scraper {
62 1     1   706148 process "title" , title => 'TEXT';
63 1         98046 process "meta[name=\"description\"]" , content => '@content';
64             process 'script' , 'scripts[]' => sub {
65 67         97592 my $script = join '', @{$_->content_array_ref};
  67         89  
66 67 50       458 $script =~ /registerImage\("original_image"/ ? $script : ();
67 1         293061 };
68 1         42 };
69            
70 1         15 my $sresult = $scraper->scrape( $content );
71            
72 1         19784 my ($thumb,$image) = $sresult->{scripts}->[0] =~ /original_image","([^"]+)"\s*,\s*"
73 1         129 my ($pub) = $content =~ m{
  • Verlag:\s*(.*?)
  • }msx;
    74              
    75 1         12 my $data = {
    76             content => $sresult->{content},
    77             thumb_link => $thumb,
    78             image_link => $image,
    79             published => $pub,
    80             title => $sresult->{title},
    81             };
    82              
    83 1 50       5 return $self->handler("Could not extract data from amazon.de result page.")
    84             unless(defined $data);
    85              
    86             # trim top and tail
    87 1         6 foreach (keys %$data) {
    88 5 100       12 next unless defined $data->{$_};
    89 3         8 $data->{$_} =~ s/^\s+//;
    90 3         14 $data->{$_} =~ s/\s+$//;
    91             }
    92              
    93             # ($data->{title},$data->{author}) =
    94             # ($data->{content} =~
    95             # /
    96             # Amazon.de\s*:\s*
    97             # (.+?)
    98             # \s*:\s*([^:]+)\s*:
    99             # /x);
    100             # #\s*(?:(?:English\sBooks?)|Bücher|Bücher|Bücher).*
    101             # #$data->{title} =~ s!\(.*?\)$!!;
    102              
    103 1         8 my @tmp_info = map{ s{\A\s*}{}; $_ }split /:/, $data->{content};
      1         5  
      1         20  
    104 1         4 @{ $data }{ qw/title author/ } = @tmp_info[0,-2];
      1         3  
    105              
    106 1 50       99 if ( $data->{author} =~ /\A\d+/ ) {
    107 0         0 my ($index) = grep{ $tmp_info[$_] eq $data->{author} } reverse ( 0 .. $#tmp_info );
      0         0  
    108 0         0 $data->{author} = $tmp_info[$index-1];
    109             }
    110              
    111             #my @tmp_info = split /:/, $data->{content};
    112             #@{ $data }{ qw/title author/ } = map{ s/^\s*//; $_ }@tmp_info[0,-3];
    113              
    114 1         19 ($data->{publisher},$data->{pubdate}) =
    115             ($data->{published} =~ /\s*(.*?)(?:;.*?)?\s+\(([^)]*)/);
    116              
    117 1         11 my $bk = {
    118             'isbn' => $isbn,
    119             'author' => $data->{author},
    120             'title' => $data->{title},
    121             'image_link' => $data->{image_link},
    122             'thumb_link' => $data->{thumb_link},
    123             'publisher' => $data->{publisher},
    124             'pubdate' => $data->{pubdate},
    125             'book_link' => $mechanize->uri()
    126             };
    127            
    128 1         55 $self->book($bk);
    129 1         21 $self->found(1);
    130 1         9 return $self->book;
    131             }
    132              
    133              
    134             1; # End of WWW::Scraper::ISBN::AmazonDE_Driver
    135              
    136             __END__