File Coverage

blib/lib/WWW/Search/AntikvariatJudaicaCZ.pm
Criterion Covered Total %
statement 21 52 40.3
branch 0 4 0.0
condition n/a
subroutine 7 11 63.6
pod 2 2 100.0
total 30 69 43.4


line stmt bran cond sub pod time code
1             package WWW::Search::AntikvariatJudaicaCZ;
2              
3             # Pragmas.
4 3     3   30753 use base qw(WWW::Search);
  3         5  
  3         2338  
5 3     3   301793 use strict;
  3         6  
  3         102  
6 3     3   14 use warnings;
  3         9  
  3         93  
7              
8             # Modules.
9 3     3   14 use LWP::UserAgent;
  3         4  
  3         49  
10 3     3   1977 use Readonly;
  3         8509  
  3         181  
11 3     3   1708 use Web::Scraper;
  3         141556  
  3         24  
12 3     3   220 use WWW::Search qw(generic_option);
  3         36  
  3         1707  
13              
14             # Constants.
15             Readonly::Scalar our $MAINTAINER => 'Michal Spacek ';
16             Readonly::Scalar my $BASE_URL => 'http://antikvariat-judaica.cz/';
17             Readonly::Scalar my $ACTION1 => 'search/node/';
18              
19             # Version.
20             our $VERSION = 0.01;
21              
22             # Setup.
23             sub native_setup_search {
24 0     0 1   my ($self, $query) = @_;
25             $self->{'_def'} = scraper {
26             process '//div[@class="content"]/dl/div', 'books[]' => scraper {
27 0           process '//h2/a', 'title' => 'TEXT';
28 0           process '//h2/a', 'url' => '@href';
29 0           process '//img[@class="imagecache '.
30             'imagecache-product_list"]',
31             'cover_url' => '@src';
32 0           process '//div[@class="field sell-price"]',
33             'price' => 'TEXT';
34 0           process '//div[@class="field '.
35             'field-type-content-taxonomy '.
36             'field-field-author"]',
37             'author' => 'TEXT';
38 0           return;
39 0     0     };
40 0           return;
41 0           };
42 0           $self->{'_query'} = $query;
43 0           return 1;
44             }
45              
46             # Get data.
47             sub native_retrieve_some {
48 0     0 1   my $self = shift;
49              
50             # Get content.
51 0           my $ua = LWP::UserAgent->new(
52             'agent' => "WWW::Search::AntikvariatJudaicaCZ/$VERSION",
53             );
54 0           my $response = $ua->get($BASE_URL.$ACTION1.$self->{'_query'});
55              
56             # Process.
57 0 0         if ($response->is_success) {
58 0           my $content = $response->content;
59              
60             # Get books structure.
61 0           my $books_hr = $self->{'_def'}->scrape($content);
62              
63             # Process each book.
64 0           foreach my $book_hr (@{$books_hr->{'books'}}) {
  0            
65 0           _fix_url($book_hr, 'url');
66 0           $book_hr->{'price'} =~ s/\N{U+00A0}/ /ms;
67 0           $book_hr->{'price'} =~ s/^\s*Cena:\s*//ms;
68 0           $book_hr->{'author'} =~ s/^\s*Autor:\s*//ms;
69 0           push @{$self->{'cache'}}, $book_hr;
  0            
70             }
71             }
72              
73 0           return;
74             }
75              
76             # Fix URL to absolute path.
77             sub _fix_url {
78 0     0     my ($book_hr, $url) = @_;
79 0 0         if (exists $book_hr->{$url}) {
80 0           $book_hr->{$url} = $BASE_URL.$book_hr->{$url};
81             }
82 0           return;
83             }
84              
85             1;
86              
87             __END__