File Coverage

blib/lib/WWW/Search/KacurCZ.pm
Criterion Covered Total %
statement 65 71 91.5
branch 2 6 33.3
condition n/a
subroutine 14 14 100.0
pod n/a
total 81 91 89.0


line stmt bran cond sub pod time code
1             package WWW::Search::KacurCZ;
2              
3 4     4   1077166 use base qw(WWW::Search);
  4         11  
  4         2214  
4 4     4   382485 use strict;
  4         13  
  4         99  
5 4     4   17 use warnings;
  4         23  
  4         328  
6              
7 4     4   1320 use Encode qw(decode_utf8);
  4         42896  
  4         492  
8 4     4   33 use LWP::UserAgent;
  4         6  
  4         150  
9 4     4   2581 use Perl6::Slurp qw(slurp);
  4         8340  
  4         29  
10 4     4   2325 use Readonly;
  4         14989  
  4         255  
11 4     4   2137 use Text::Iconv;
  4         12235  
  4         222  
12 4     4   2245 use Web::Scraper;
  4         187515  
  4         37  
13              
14             # Constants.
15             Readonly::Scalar our $MAINTAINER => 'Michal Josef Spacek ';
16             Readonly::Scalar my $KACUR_CZ => 'http://kacur.cz/';
17             Readonly::Scalar my $KACUR_CZ_ACTION1 => '/search.asp?doIt=search&menu=675&'.
18             'kategorie=&nazev=&rok=&dosearch=Vyhledat';
19              
20             our $VERSION = 0.02;
21              
22             # Setup.
23             sub _native_setup_search {
24 1     1   203 my ($self, $query) = @_;
25              
26             $self->{'_def'} = scraper {
27             process '//div[@class="productItemX"]', 'books[]' => scraper {
28 9         103648 process '//div/h3/a', 'title' => 'TEXT';
29 9         24882 process '//div/h3/a', 'url' => '@href';
30 9         22825 process '//img', 'cover_url' => '@src';
31 9         11651 process '//p', 'author_publisher[]' => 'TEXT';
32 9         14052 process '//span[@class="price"]', 'price' => 'TEXT';
33 9         35491 return;
34 1     1   140093 };
35 1         505 return;
36 1         8 };
37 1         7 $self->{'_query'} = $query;
38              
39 1         3 return 1;
40             }
41              
42             # Get data.
43             sub _native_retrieve_some {
44 1     1   41 my $self = shift;
45              
46 1 50       4 if (defined $self->{search_from_file}) {
47 1         6 my $content = slurp($self->{search_from_file});
48 1         352 $self->_process_content($content);
49             } else {
50             # Query.
51 0         0 my $i1 = Text::Iconv->new('utf-8', 'windows-1250');
52 0         0 my $query = $i1->convert(decode_utf8($self->{'_query'}));
53              
54             # Get content.
55 0         0 my $ua = LWP::UserAgent->new(
56             'agent' => "WWW::Search::KacurCZ/$VERSION",
57             );
58 0         0 my $response = $ua->get($KACUR_CZ.$KACUR_CZ_ACTION1."&autor=$query");
59              
60             # Process.
61 0 0       0 if ($response->is_success) {
62 0         0 $self->_process_content($response->content);
63             }
64             }
65              
66 1         7 return;
67             }
68              
69             # Fix URL to absolute path.
70             sub _fix_url {
71 18     18   37 my ($book_hr, $url) = @_;
72              
73 18 50       47 if (exists $book_hr->{$url}) {
74 18         45 $book_hr->{$url} = $KACUR_CZ.$book_hr->{$url};
75             }
76              
77 18         33 return;
78             }
79              
80             sub _process_content {
81 1     1   2 my ($self, $content) = @_;
82              
83 1         459 my $i2 = Text::Iconv->new('windows-1250', 'utf-8');
84 1         241 my $utf8_content = $i2->convert($content);
85              
86             # Get books structure.
87 1         24 my $books_hr = $self->{'_def'}->scrape($utf8_content);
88              
89             # Process each book.
90 1         10536 foreach my $book_hr (@{$books_hr->{'books'}}) {
  1         6  
91 9         33 _fix_url($book_hr, 'url');
92 9         21 _fix_url($book_hr, 'cover_url');
93             $book_hr->{'author'}
94 9         28 = $book_hr->{'author_publisher'}->[0];
95 9         39 $book_hr->{'author'} =~ s/\N{U+00A0}$//ms;
96             $book_hr->{'publisher'}
97 9         22 = $book_hr->{'author_publisher'}->[1];
98 9         25 $book_hr->{'publisher'} =~ s/\N{U+00A0}$//ms;
99 9         39 delete $book_hr->{'author_publisher'};
100             ($book_hr->{'old_price'}, $book_hr->{'price'})
101 9         38 = split m/\s*\*\s*/ms, $book_hr->{'price'};
102 9         14 push @{$self->{'cache'}}, $book_hr;
  9         31  
103             }
104              
105 1         16 return;
106             }
107              
108             1;
109              
110             __END__