File Coverage

blib/lib/LWP/UserAgent/ProxyHopper/Base.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	32	32	100.0

package LWP::UserAgent::ProxyHopper::Base;

use warnings;
use strict;

our $VERSION = '0.003';

use Carp;
use Devel::TakeHashArgs;
use List::MoreUtils 'uniq';
use WWW::FreeProxyListsCom;
use WWW::Proxy4FreeCom;
use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors qw(
    proxify_list
    proxify_bad_list
    proxify_real_bad_list
    proxify_working_list
    proxify_schemes
    proxify_retries
    proxify_debug
    proxify_current
    _proxify_last_load_args
    _proxify_freeproxylists_obj
    _proxify_proxy4free_obj
);

sub proxify_load {
    my $self = shift;
    get_args_as_hash(\@_, \my %args, {
            freeproxylists  => 1,
            plan_b          => 1,
            proxy4free      => 0,
            timeout         => 20,
            debug           => 0,
            retries         => 5,
            extra_proxies   => [],
            schemes         => 'http',
            get_list_args   => {
                freeproxylists  => [ ],
                proxy4free      => [ ],
            },
        },
    ) or croak $@;

    $self->_proxify_last_load_args( \%args );

    my @proxies;

    if ( $args{freeproxylists} ) {
        my $obj = $self->_proxify_freeproxylists_obj(
            WWW::FreeProxyListsCom->new( timeout => $args{timeout} )
        );

        my $list_ref
        = $obj->get_list( @{$args{get_list_args}{freeproxylists}} );
        if ( defined $list_ref ) {
            push @proxies, map { "http://$_->{ip}:$_->{port}/" } @$list_ref;
        }
        else {
            $args{debug}
                and carp 'Failed while trying to get a proxy list from '
                            . 'http://freeproxylists.com: ' . $obj->error;
        }
    }

    if ( $args{proxy4free} or ( !@proxies and $args{plan_b} ) ) {
        my $obj = $self->_proxify_proxy4free_obj(
            WWW::Proxy4FreeCom->new( timeout => $args{timeout} )
        );

        my $list_ref = $obj->get_list( @{$args{get_list_args}{proxy4free}} );

        if ( defined $list_ref ) {
            push @proxies, map { "http://$_->{ip}:$_->{port}/" } @$list_ref;
        }
        else {
            $args{debug}
                and carp 'Failed while trying to get a proxy list from '
                            . 'http://proxy4free.com: ' . $obj->error;
        }
    }

    unshift @proxies, @{ $args{extra_proxies} };

    croak q|Don't have ANY proxy addresses :(|
        unless @proxies;

    @proxies = uniq @proxies;

    $args{debug}
        and carp "Got " . @proxies . " proxies in total";

    $self->proxify_retries( $args{retries} );
    $self->proxify_schemes( $args{schemes} );
    $self->proxify_debug(   $args{debug  } );
    $self->proxify_working_list( [] );
    $self->proxify_bad_list( [] );
    $self->proxify_real_bad_list( [] );

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

sub proxify_get { return shift->_proxify_try_request( 'get', \@_ ); }
sub proxify_post { return shift->_proxify_try_request( 'post', \@_ ); }
sub proxify_request { return shift->_proxify_try_request( 'request', \@_ ); }
sub proxify_head { return shift->_proxify_try_request( 'head', \@_ ); }
sub proxify_mirror { return shift->_proxify_try_request( 'mirror', \@_ ); }
sub proxify_simple_request {
    return shift->_proxify_try_request( 'simple_request', \@_ );
}

sub _proxify_try_request {
    my ( $self, $req_type, $args_ref ) = @_;

    my $current_proxy = $self->_proxify_set_proxy;
    my $tries;
    my $max_tries = $self->proxify_retries;
    TRY_REQ: {
        $tries++;

        my $response = $self->$req_type( @$args_ref );
        if ( $response->is_success ) {
            # a lot of proxies seem to be run by this company and it will
            # give us a 200 but display their page with timeout
            # all we need to do is redo the request
            if ( $response->content =~ /\Qcodeen.cs.princeton.edu">CoDeeN/ ) {
                redo TRY_REQ;
            }
            elsif ( not $self->_proxify_check_success($response->content) ) {
                push @{ $self->proxify_real_bad_list }, $current_proxy;
            }

            push @{ $self->proxify_working_list }, $self->proxify_current;
            return $response;

            redo TRY_REQ
                unless $tries > $max_tries;

            return $response;
        }
        else {
            $self->proxify_debug
                and carp 'Failed on proxify_get(): '
                    . $response->status_line;

            if ( $response->status_line =~ /500.+\Q$current_proxy/
                or $response->code == 400
                or $response->code == 504
                or $response->code == 502
            ) {
                # BAD PROXY!!! NO COOKIE!
                push @{ $self->proxify_real_bad_list }, $current_proxy;
            }
            else {
                push @{ $self->proxify_bad_list }, $current_proxy;
            }
            $current_proxy = $self->_proxify_set_proxy;

            redo TRY_REQ
                unless $tries > $max_tries;

            # if we got here $response is not successfull but that might have
            # nothing to do with proxies at all
            return $response;
        }
    } # TRY_GET:{}
    croak 'I should never get to this point. Please email this message '
            . 'to [e-mail]. Thank you very much';
}

sub _proxify_set_proxy {
    my $self = shift;

    my $proxy = $self->proxify_current( shift @{ $self->proxify_list } );

    unless ( defined $proxy ) {
        $self->proxify_debug
            and carp 'proxify_list() is exhausted, trying "working" list';

        $self->proxify_list( $self->proxify_working_list );
        $self->proxify_working_list([]);
        $proxy = $self->proxify_current( shift @{ $self->proxify_list } );
    }

    unless ( defined $proxy ) {
        $self->proxify_debug
           and carp 'proxify_working_list() is exhausted, trying "bad" list';

        $self->proxify_list( $self->proxify_bad_list );
        $self->proxify_bad_list([]);
        $proxy = $self->proxify_current( shift @{ $self->proxify_list } );
    }

    unless ( defined $proxy ) {
        $self->proxify_debug
           and carp 'lists are exhausted, trying to proxify_load now';

        $self->proxify_load( %{ $self->_proxify_last_load_args || {} });
        $proxy = $self->proxify_current( shift @{ $self->proxify_list } );

        defined $proxy
            or croak 'After trying so hard I still could not get any more'
                . ' proxies to play with :(';
    }

    $self->proxify_debug
        and carp "Using proxy $proxy";

    $self->proxy($self->proxify_schemes, $proxy );

    return $proxy;
}

sub _proxify_check_success {
    my ( $self, $content ) = @_;
    return 1 if length $content > 4000;
    if ( $content =~ m|\s*
\Qhttp/1.1 401 Unauthorized\E\s*
\QServer:\E\s*
.+?
\QWWW-Authenticate: Basic realm="ADSL Router \(ANNEX A\)"\E\s*
\QContent-Type: text/html\E\s*
\QConnection: close\E\s*
\s*
\Q\E\s*
\Q\E\s*
\Q\E\s*
\Q\E\s*
\Q\E\s*
\Q\E\s*
|xsm
    ) {
        return 0; # failed
    }

    if ( $content =~ m|ESPOCH Acceso denegado| ) {
        return 0; # failed
    }
    return 1; # success
}

1;
__END__