File Coverage

blib/lib/WWW/Proxy4FreeCom.pm
Criterion Covered Total %
statement 58 65 89.2
branch 9 22 40.9
condition 2 8 25.0
subroutine 10 11 90.9
pod 2 2 100.0
total 81 108 75.0


line stmt bran cond sub pod time code
1             package WWW::Proxy4FreeCom;
2              
3 1     1   313700 use warnings;
  1         1  
  1         26  
4 1     1   3 use strict;
  1         1  
  1         31  
5              
6             our $VERSION = '1.004002'; # VERSION
7              
8 1     1   4 use Carp;
  1         0  
  1         51  
9 1     1   4 use URI;
  1         1  
  1         13  
10 1     1   2 use LWP::UserAgent;
  1         2  
  1         21  
11 1     1   3 use Mojo::DOM;
  1         1  
  1         17  
12              
13 1     1   4 use base 'Class::Accessor::Grouped';
  1         2  
  1         550  
14             __PACKAGE__->mk_group_accessors( simple => qw/
15             list
16             error
17             ua
18             debug
19             /);
20              
21             sub new {
22 1     1 1 183 my $self = bless {}, shift;
23              
24 1 50       5 croak "Must have even number of arguments to new()"
25             if @_ & 1;
26 1         5 my %args = @_;
27 1         7 $args{ +lc } = delete $args{ $_ } for keys %args;
28              
29 1   50     3 $args{timeout} ||= 30;
30              
31 1   33     17 $args{ua} ||= LWP::UserAgent->new(
32             timeout => $args{timeout},
33             agent => 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:26.0)'
34             .' Gecko/20100101 Firefox/26.0',
35             );
36              
37 1         1843 $self->ua( $args{ua} );
38 1         207 $self->debug( $args{debug} );
39              
40 1         100 return $self;
41             }
42              
43             sub get_list {
44 1     1 1 753 my $self = shift;
45 1         2 my $custom_pages = shift;
46              
47 1         6 $self->$_(undef) for qw(list error);
48              
49             my @pages_list
50 1 0       206 = defined $custom_pages
    50          
51             ? ( ref $custom_pages ? @$custom_pages : $custom_pages )
52             : ( 1 );
53              
54 1 50       7 return $self->_set_error('Page number can only be 1..14')
55 1 50       3 if grep { $_ < 1 or $_ > 14 } @pages_list;
56              
57 1         4 my $ua = $self->ua;
58 1         1 my @proxies;
59 1         2 for ( @pages_list ) {
60 1         6 my $response = $ua->get(
61             'http://www.proxy4free.com/list/webproxy' . $_ . '.html'
62             );
63              
64 1 50       463112 if ( $response->is_success ) {
65 1 50       20 my $parse = $self->_parse_proxy_list(
66             $response->decoded_content
67             ) or return; ## parse error; error is already set
68              
69 1         40 push @proxies, @$parse;
70             }
71             else {
72 0 0       0 $self->debug
73             and carp "Page $_: " . $response->status_line;
74 0         0 return $self->_set_error(
75             'Network error: ' . $response->status_line
76             );
77             }
78             }
79              
80 1         10 return $self->list( \@proxies );
81             }
82              
83             sub _parse_proxy_list {
84 1     1   7344 my ( $self, $content ) = @_;
85              
86 1         8 my $dom = Mojo::DOM->new( $content );
87 1         64999 my @proxies;
88 1         2 eval {
89 1         5 for my $tr ( $dom->find('.proxy-list tbody tr')->each ) {
90 30         13859 my %tds;
91              
92 30         69 @tds{qw/
93             country rating access_time
94             uptime online_since last_test
95             /} = map "$_", map $_->text, ( $tr->find('td')->each )[ 3..8 ];
96              
97 30         27336 @tds{qw/domain features_hian features_ssl/}
98             = ( $tr->find('td')->each )[1, 9, 10];
99              
100 30         15883 $tds{domain} = $tds{domain}->find('a')->map('text')->join;
101             $tds{ $_ } = $tds{ $_ } =~ /on/ ? 1 : 0
102 30 100       5650 for qw/features_hian features_ssl/;
103              
104 30         3621 $_ = "$_" for values %tds;
105              
106 30         338 push @proxies, +{ %tds };
107             }
108             };
109              
110 1 50       23 $@ and return $self->_set_error("Parser error: $@");
111              
112 1         873 return \@proxies;
113             }
114              
115             sub _set_error {
116 0     0     my ( $self, $error_or_response, $type ) = @_;
117 0 0 0       if ( defined $type and $type eq 'net' ) {
118 0           $self->error( 'Network error: ' . $error_or_response->status_line );
119             }
120             else {
121 0           $self->error( $error_or_response );
122             }
123 0           return;
124             }
125              
126             1;
127             __END__