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

package WWW::Scraper::ISBN::AmazonDE_Driver;

use warnings;
use strict;

use WWW::Scraper::ISBN::Driver;
use base qw(WWW::Scraper::ISBN::Driver);
use WWW::Mechanize;
use Web::Scraper;

use constant    AMAZON => 'http://www.amazon.de/';
use constant    SEARCH => 'http://www.amazon.de/';
use constant    DIRECT => 'http://www.amazon.de/gp/product/';

our $DEBUG = $ENV{ISBN_DRIVER_DEBUG};

# ABSTRACT: Search driver for the (DE) Amazon online catalog.

our $VERSION = '0.25';


sub search {
    my ($self,$isbn) = @_;

    $self->found(0);
    $self->book(undef);

    my $mechanize = WWW::Mechanize->new();
    $mechanize->agent_alias( 'Linux Mozilla' );

#    $mechanize->get( SEARCH );
#    return    $self->handler('Error loading amazon.de form web page (unreachable?)')
#        unless($mechanize->success());
#
    my ($index,$input) = (0,0);

#    $mechanize->form_name('site-search')
#        or return $self->handler('Error parsing amazon.de form');

#    my $keyword ='search-alias=stripbooks';
#    $mechanize->set_fields(
#        'field-keywords' => $isbn,
#        'url'            => $keyword
#    );
#    $mechanize->submit();

#    return    $self->handler('Error about form submission (form changed?)')
#        unless($mechanize->success());

    (my $norm_isbn = $isbn) =~ s/[^0-9]//g;
    my $url = DIRECT . $norm_isbn;
    $mechanize->get( $url );

    return $self->handler( "No success when trying to get $url" )
        unless $mechanize->success;

    my $content = $mechanize->content();

    #$DEBUG and warn $content;

    my $scraper = scraper {
        process "title"                    , title       => 'TEXT';
        process "meta[name=\"description\"]" , content     => '@content';
        process 'script'                   , 'scripts[]' => sub {
                my $script = join '', @{$_->content_array_ref};
                $script =~ /registerImage\("original_image"/ ? $script : ();
            };
    };

    my $sresult = $scraper->scrape( $content );

    my ($thumb,$image) = $sresult->{scripts}->[0] =~ /original_image","([^"]+)"\s*,\s*"
    my ($pub) = $content =~ m{Verlag:\s*(.*?)}msx;

    my $data = {
        content    => $sresult->{content},
        thumb_link => $thumb,
        image_link => $image,
        published  => $pub,
        title      => $sresult->{title},
    };

    return $self->handler("Could not extract data from amazon.de result page.")
        unless(defined $data);

    # trim top and tail
    foreach (keys %$data) {
        next unless defined $data->{$_};
        $data->{$_} =~ s/^\s+//;
        $data->{$_} =~ s/\s+$//;
    }

#    ($data->{title},$data->{author}) =
#        ($data->{content} =~
#                  /
#                  Amazon.de\s*:\s*
#                  (.+?)
#                  \s*:\s*([^:]+)\s*:
#                  /x);
#                  #\s*(?:(?:English\sBooks?)|Bücher|Bücher|Bücher).*
#    #$data->{title} =~ s!\(.*?\)$!!;

     my @tmp_info = map{ s{\A\s*}{}; $_ }split /:/, $data->{content};
     @{ $data }{ qw/title author/ } = @tmp_info[0,-2];

     if ( $data->{author} =~ /\A\d+/ ) {
         my ($index) = grep{ $tmp_info[$_] eq $data->{author} } reverse ( 0 .. $#tmp_info );
         $data->{author} = $tmp_info[$index-1];
     }

     #my @tmp_info = split /:/, $data->{content};
     #@{ $data }{ qw/title author/ } = map{ s/^\s*//; $_ }@tmp_info[0,-3];

    ($data->{publisher},$data->{pubdate}) =
        ($data->{published} =~ /\s*(.*?)(?:;.*?)?\s+\(([^)]*)/);

    my $bk = {
        'isbn'        => $isbn,
        'author'      => $data->{author},
        'title'       => $data->{title},
        'image_link'  => $data->{image_link},
        'thumb_link'  => $data->{thumb_link},
        'publisher'   => $data->{publisher},
        'pubdate'     => $data->{pubdate},
        'book_link'   => $mechanize->uri()
    };

    $self->book($bk);
    $self->found(1);
    return $self->book;
}


1; # End of WWW::Scraper::ISBN::AmazonDE_Driver

__END__