File Coverage

blib/lib/WWW/Search/Coveralia.pm
Criterion Covered Total %
statement 35 35 100.0
branch 6 10 60.0
condition 3 8 37.5
subroutine 6 6 100.0
pod n/a
total 50 59 84.7


line stmt bran cond sub pod time code
1             package WWW::Search::Coveralia;
2              
3 1     1   360 use 5.014000;
  1         2  
  1         28  
4 1     1   4 use strict;
  1         1  
  1         22  
5 1     1   3 use warnings;
  1         1  
  1         29  
6 1     1   4 use parent qw/WWW::Search/;
  1         1  
  1         4  
7              
8             our $VERSION = '0.001';
9             our $MAINTAINER = 'Marius Gavrilescu ';
10              
11             sub DEFAULT_URL;
12             sub process_result;
13              
14             sub _native_setup_search{
15 2     2   2827 my ($self, $native_query, $options) = @_;
16 2         9 $self->agent_email('marius@ieval.ro');
17 2   50     19 $options //= {};
18 2   33     17 my $base_url = $options->{search_url} // $self->DEFAULT_URL;
19 2         9 $self->{search_debug} = $options->{search_debug};
20 2         6 $self->{_next_url} = "$base_url?bus=$native_query";
21 2         11 $self->user_agent->delay(10/60); # Crawl-Delay: 10 in robots.txt
22             }
23              
24             sub _parse_tree {
25 2     2   20507501 my ($self, $tree) = @_;
26 2         5 my $found = 0;
27              
28 2         13 my $result_table = $tree->look_down(class => 'mostrar');
29 2 100       2062 return unless $result_table;
30 1         6 my @results = $result_table->find('tbody')->find('tr');
31 1         252 for (@results) {
32 2         9 my $result = $self->process_result($_);
33 2         3 push @{$self->{cache}}, $result;
  2         4  
34 2 50       6 say STDERR 'Title: ', $result->title, ' URL: ', $result->url if $self->{search_debug};
35 2         3 $found++;
36             }
37              
38 1         5 my $url = $tree->look_down(rel => 'next');
39 1 50       1364 $self->{_next_url} = $self->absurl($self->{_prev_url}, $url->attr('href')) if defined $url;
40              
41 1 50       3 say STDERR "Found: $found" if $self->{search_debug};
42 1 50 33     7 say STDERR 'Next URL: ', $self->{_next_url} if $self->{search_debug} && $self->{_next_url};
43 1         4 $found
44             }
45              
46             1;
47             __END__