File Coverage

blib/lib/WWW/FreeProxyListsCom.pm

Criterion	Covered	Total	%
statement	78	102	76.4
branch	20	48	41.6
condition	9	15	60.0
subroutine	12	14	85.7
pod	3	3	100.0
total	122	182	67.0

package WWW::FreeProxyListsCom;

use warnings;
use strict;

our $VERSION = '1.001';

use Carp;
use URI;
use WWW::Mechanize;
use HTML::TokeParser::Simple;
use HTML::Entities;
use Devel::TakeHashArgs;
use base 'Class::Accessor::Grouped';
__PACKAGE__->mk_group_accessors( simple => qw/
    error
    mech
    debug
    list
    filtered_list
/);

sub new {
    my $self = bless {}, shift;
    get_args_as_hash(\@_, \my %args, { timeout => 30 } )
        or croak $@;

    $args{mech} ||= WWW::Mechanize->new(
        timeout => $args{timeout},
        agent   => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.8.1.12)'
                    .' Gecko/20080207 Ubuntu/7.10 (gutsy) Firefox/2.0.0.12',
    );

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

    return $self;
}

sub get_list {
    my $self = shift;

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

    get_args_as_hash(\@_, \my %args, {
            type        => 'elite',
            max_pages   => 1,
        }
    ) or croak $@;

    my %page_for = (
        non_anonymous   => 'non-anonymous',
        map { $_ => $_ } qw(
            elite
            anonymous
            https
            standard
            us
            socks
        ),
    );

    exists $page_for{ $args{type} }
        or croak 'Invalid `type` argument was passed to fetch(). '
            . 'Must be one of' . join q|, |, keys %page_for;

    my $mech = $self->mech;
    my $page_type = $page_for{ $args{type} };
    my $uri = URI->new(
        "http://www.freeproxylists.com/$page_type.html"
    );

    $mech->get($uri)->is_success
        or return $self->_set_error($mech,'net');

    $page_type eq 'anonymous'
        and $page_type = 'anon';
    $page_type eq 'non-anonymous'
        and $page_type = 'nonanon';

    # little tweaking to get the URI to the file normally loaded with AJAX
    my @links = map {
        "http://www.freeproxylists.com/load_${page_type}_" .
            ($_->url =~ m|([^/]+$)|)[0]
    } $mech->find_all_links(text_regex => qr/^detailed list #\d+/i);

    $args{max_pages}
        and @links = splice @links, 0, $args{max_pages};

    $self->debug
        and print "Going to fetch data from: \n" . join "\n", @links,'';

    my @proxies;
    for ( @links ) {
        unless ( $mech->get($_)->is_success ) {
            $self->debug
                and carp 'Network error: ' . $mech->res->status_line;
            next;
        }

        my $list_ref = $self->_parse_list( $mech->res->content )
            or next;

        push @proxies, @$list_ref;
    }

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

sub filter {
    my $self = shift;

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

    get_args_as_hash( \@_, \my %args)
        or croak $@;

    my %valid_filters;
    @valid_filters{ qw(ip  port  is_https  country  last_test  latency) }
    = (1) x 5;

    grep { not exists $valid_filters{$_} } keys %args
        and return $self->_set_error(
            'Invalid filter specified, valid ones are: '.
                join q|, |, keys %valid_filters
        );

    my $list_ref = $self->list
        or return $self->_set_error(
           'Proxy list seems to be undefined, did you call get_list() first?'
        );

    my @filtered;
    foreach my $proxy_ref ( @$list_ref ) {
        my $is_good = 0;
        for ( keys %args ) {
            if ( ref $args{$_} eq 'Regexp' ) {
                $proxy_ref->{$_} =~ /$args{$_}/
                    and $is_good++;
            }
            else {
                $proxy_ref->{$_} eq $args{$_}
                    and $is_good++;
            }
        }

        $is_good == keys %args
            and push @filtered, { %$proxy_ref };
    }
    return $self->filtered_list( \@filtered );
}


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

    # EVIL EVIL EVIL!! WEEE \o/
    ( $content ) = $content =~ m|(.+?)|s;
    decode_entities $content;

    my $parser = HTML::TokeParser::Simple->new( \$content );

    my %cells;
    @cells{ 1..6 } = qw(ip port is_https latency last_test country);
    my %nav;
    @nav{ qw(get_data level data_cell) } = (0) x 3;

    my @data;
    my %current;
    while ( my $t = $parser->get_token ) {
        if ( $t->is_start_tag('tr') ) {
            @nav{ qw(get_data level) } = (1, 1);
        }
        elsif ( $nav{get_data} == 1 and $t->is_start_tag('td') ) {
            $nav{level} = 2;
            $nav{data_cell}++;
        }
        elsif ( $nav{data_cell} and $t->is_text ) {
            $current{ $cells{ $nav{data_cell} } } = $t->as_is;
        }
        elsif ( $t->is_end_tag('tr') ) {
            @nav{ qw(level get_data data_cell) } = ( 3, 0, 0 );

            next unless keys %current;

            $current{ $_ } = 'N/A'
                for grep { !defined $current{$_} or !length $current{$_} }
                    values %cells;

            push @data, { %current };
            %current = ();
        }
    }

    shift @data; # quick and dirty fix to rid of bad data.
    return \@data;
}

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

1;
__END__