File Coverage

blib/lib/WWW/Proxy4FreeCom.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	9	22	40.9
condition	2	8	25.0
subroutine	10	11	90.9
pod	2	2	100.0
total	81	107	75.7

package WWW::Proxy4FreeCom;

use warnings;
use strict;

our $VERSION = '1.004001'; # VERSION

use Carp;
use URI;
use LWP::UserAgent;
use Mojo::DOM;

use base 'Class::Accessor::Grouped';
__PACKAGE__->mk_group_accessors( simple => qw/
    list
    error
    ua
    debug
/);

sub new {
    my $self = bless {}, shift;

    croak "Must have even number of arguments to new()"
        if @_ & 1;
    my %args = @_;
    $args{ +lc } = delete $args{ $_ } for keys %args;

    $args{timeout} ||= 30;

    $args{ua} ||= LWP::UserAgent->new(
            timeout => $args{timeout},
            agent   => 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:26.0)'
                        .' Gecko/20100101 Firefox/26.0',
    );

    $self->ua( $args{ua} );
    $self->debug( $args{debug} );

    return $self;
}

sub get_list {
    my $self = shift;
    my $custom_pages = shift;

    $self->$_(undef) for qw(list error);

    my @pages_list
        = defined $custom_pages
        ?  ( ref $custom_pages ? @$custom_pages : $custom_pages )
        : ( 1 );

    return $self->_set_error('Page number can only be 1..14')
        if grep { $_ < 1 or $_ > 14 } @pages_list;

    my $ua = $self->ua;
    my @proxies;
    for ( @pages_list ) {
        my $response = $ua->get(
            'http://www.proxy4free.com/list/webproxy' . $_ . '.html'
        );

        if ( $response->is_success ) {
            my $parse = $self->_parse_proxy_list(
                $response->decoded_content
            ) or return; ## parse error; error is already set

            push @proxies, @$parse;
        }
        else {
            $self->debug
                and carp "Page $_: " . $response->status_line;
        }
    }

    return $self->list( \@proxies );
}

sub _parse_proxy_list {
    my ( $self, $content ) = @_;

    my $dom = Mojo::DOM->new( $content );
    my @proxies;
    eval {
        for my $tr ( $dom->find('.proxy-list tbody tr')->each ) {
            my %tds;
            @tds{qw/domain  features_hian  features_ssl/}
            = ( $tr->find('td')->each )[1, 9, 10];

            @tds{qw/
                rating  country  access_time
                uptime  online_since  last_test
            /} = map "$_", map $_->text, ( $tr->find('td')->each )[ 3..8 ];

            $tds{domain} = $tds{domain}->find('a')->map('text')->join;
            $tds{ $_ } = $tds{ $_ } =~ /on/ ? 1 : 0
                for qw/features_hian  features_ssl/;

            $_ = "$_" for values %tds;

            push @proxies, +{ %tds };
        }
    };

    $@ and return $self->_set_error("Parser error: $@");

    return \@proxies;
}

sub _set_error {
    my ( $self, $error_or_response, $type ) = @_;
    if ( defined $type and $type eq 'net' ) {
        $self->error( 'Network error: ' . $error_or_response->status_line );
    }
    else {
        $self->error( $error_or_response );
    }
    return;
}

1;
__END__