line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::Proxy4FreeCom; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
222158
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
49
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '1.003'; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
65
|
|
9
|
1
|
|
|
1
|
|
4
|
use URI; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
10
|
1
|
|
|
1
|
|
5
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
77
|
|
11
|
1
|
|
|
1
|
|
4
|
use Mojo::DOM; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
4
|
use base 'Class::Accessor::Grouped'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
766
|
|
14
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors( simple => qw/ |
15
|
|
|
|
|
|
|
list |
16
|
|
|
|
|
|
|
error |
17
|
|
|
|
|
|
|
ua |
18
|
|
|
|
|
|
|
debug |
19
|
|
|
|
|
|
|
/); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
1
|
|
|
1
|
1
|
322
|
my $self = bless {}, shift; |
23
|
|
|
|
|
|
|
|
24
|
1
|
50
|
|
|
|
4
|
croak "Must have even number of arguments to new()" |
25
|
|
|
|
|
|
|
if @_ & 1; |
26
|
1
|
|
|
|
|
5
|
my %args = @_; |
27
|
1
|
|
|
|
|
9
|
$args{ +lc } = delete $args{ $_ } for keys %args; |
28
|
|
|
|
|
|
|
|
29
|
1
|
|
50
|
|
|
4
|
$args{timeout} ||= 30; |
30
|
|
|
|
|
|
|
|
31
|
1
|
|
33
|
|
|
14
|
$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
|
|
|
|
|
2725
|
$self->ua( $args{ua} ); |
38
|
1
|
|
|
|
|
295
|
$self->debug( $args{debug} ); |
39
|
|
|
|
|
|
|
|
40
|
1
|
|
|
|
|
155
|
return $self; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub get_list { |
44
|
1
|
|
|
1
|
1
|
1640
|
my $self = shift; |
45
|
1
|
|
|
|
|
3
|
my $custom_pages = shift; |
46
|
|
|
|
|
|
|
|
47
|
1
|
|
|
|
|
6
|
$self->$_(undef) for qw(list error); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my @pages_list |
50
|
1
|
0
|
|
|
|
315
|
= defined $custom_pages |
|
|
50
|
|
|
|
|
|
51
|
|
|
|
|
|
|
? ( ref $custom_pages ? @$custom_pages : $custom_pages ) |
52
|
|
|
|
|
|
|
: ( 1 ); |
53
|
|
|
|
|
|
|
|
54
|
1
|
50
|
|
|
|
10
|
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
|
|
|
|
|
3
|
my $ua = $self->ua; |
58
|
1
|
|
|
|
|
2
|
my @proxies; |
59
|
1
|
|
|
|
|
2
|
for ( @pages_list ) { |
60
|
1
|
|
|
|
|
7
|
my $response = $ua->get( |
61
|
|
|
|
|
|
|
'http://www.proxy4free.com/list/webproxy' . $_ . '.html' |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
1
|
50
|
|
|
|
459532
|
if ( $response->is_success ) { |
65
|
1
|
50
|
|
|
|
27
|
my $parse = $self->_parse_proxy_list( |
66
|
|
|
|
|
|
|
$response->decoded_content |
67
|
|
|
|
|
|
|
) or return; ## parse error; error is already set |
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
51
|
push @proxies, @$parse; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
0
|
0
|
|
|
|
0
|
$self->debug |
73
|
|
|
|
|
|
|
and carp "Page $_: " . $response->status_line; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
1
|
|
|
|
|
12
|
return $self->list( \@proxies ); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub _parse_proxy_list { |
81
|
1
|
|
|
1
|
|
11655
|
my ( $self, $content ) = @_; |
82
|
|
|
|
|
|
|
|
83
|
1
|
|
|
|
|
14
|
my $dom = Mojo::DOM->new( $content ); |
84
|
1
|
|
|
|
|
152660
|
my @proxies; |
85
|
1
|
|
|
|
|
4
|
eval { |
86
|
1
|
|
|
|
|
8
|
for my $tr ( $dom->find('.proxy-list tbody tr')->each ) { |
87
|
30
|
|
|
|
|
33361
|
my %tds; |
88
|
30
|
|
|
|
|
121
|
@tds{qw/domain features_hian features_ssl/} |
89
|
|
|
|
|
|
|
= ( $tr->find('td')->each )[1, 9, 10]; |
90
|
|
|
|
|
|
|
|
91
|
30
|
|
|
|
|
46116
|
@tds{qw/ |
92
|
|
|
|
|
|
|
rating country access_time |
93
|
|
|
|
|
|
|
uptime online_since last_test |
94
|
|
|
|
|
|
|
/} = map "$_", map $_->text, ( $tr->find('td')->each )[ 3..8 ]; |
95
|
|
|
|
|
|
|
|
96
|
30
|
|
|
|
|
94848
|
$tds{domain} = $tds{domain}->find('a')->text; |
97
|
|
|
|
|
|
|
$tds{ $_ } = $tds{ $_ } =~ /on/ ? 1 : 0 |
98
|
30
|
100
|
|
|
|
17198
|
for qw/features_hian features_ssl/; |
99
|
|
|
|
|
|
|
|
100
|
30
|
|
|
|
|
8981
|
$_ = "$_" for values %tds; |
101
|
|
|
|
|
|
|
|
102
|
30
|
|
|
|
|
1200
|
push @proxies, +{ %tds }; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
}; |
105
|
|
|
|
|
|
|
|
106
|
1
|
50
|
|
|
|
32
|
$@ and return $self->_set_error("Parser error: $@"); |
107
|
|
|
|
|
|
|
|
108
|
1
|
|
|
|
|
903
|
return \@proxies; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub _set_error { |
112
|
0
|
|
|
0
|
|
|
my ( $self, $error_or_response, $type ) = @_; |
113
|
0
|
0
|
0
|
|
|
|
if ( defined $type and $type eq 'net' ) { |
114
|
0
|
|
|
|
|
|
$self->error( 'Network error: ' . $error_or_response->status_line ); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
else { |
117
|
0
|
|
|
|
|
|
$self->error( $error_or_response ); |
118
|
|
|
|
|
|
|
} |
119
|
0
|
|
|
|
|
|
return; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
1; |
123
|
|
|
|
|
|
|
__END__ |