The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package LWP::UserAgent::Anonymous;

use warnings; use strict;

use Carp;
use Clone;
use Net::Telnet;
use Data::Dumper;
use List::Util qw/shuffle/;
use base qw/LWP::UserAgent Clone/;
use LWP::UserAgent::Anonymous::Proxy;

=head1 NAME

LWP::UserAgent::Anonymous - Interface to anonymous LWP::UserAgent.

=head1 VERSION

Version 0.04

=cut

our $VERSION = '0.04';

=head1 DESCRIPTION

It provides an anonymity to a user agent by  setting the proxy from the pool of 2329  proxies.
It tries to get a valid proxy from the default pool, however,if it can't get hold of any valid
after  trying  $DEFAULT_RETRY_COUNT times, it falls back to non-proxy mode. I have come across
quite  a  few  modules  available  on  CPAN  that  claims to be a frontrunner in this area but
unfortunately they all rely on external website that keeps changing with the time and breaking
the module in the end.I tried not to rely on the external website for proxy server but capture
all the information and keep it locally. Also we have safety net as  well just in case nothing
works.  I promise NOTE: There is no gurantee that you would get anonymous proxy. However there 
is a very good probability of getting one.

    use strict; use warnings; 
    use LWP::UserAgent::Anonymous;

    my $browser = LWP::UserAgent::Anonymous->new();

=cut

$| = 1;
our $DEBUG = 0;
our $DEFAULT_RETRY_COUNT = 3;

=head1 METHODS

=head2 anon_request()

This  is simply acts like proxy handler for user agent. It tries to get hold of  a valid proxy
server,  if  it can't then it simply takes the standard route. This method  behaves exactly as 
method  request()  for LWP::UserAgent  plus  sets  the proxy for you. You can get the internal 
details by switching the debug $LWP::UserAgent::Anonymous::DEBUG.

    use strict; use warnings;
    use LWP::UserAgent::Anonymous;

    my $browser  = LWP::UserAgent::Anonymous->new();
    my $request  = HTTP::Request->new(GET=>'http://www.google.com/');
    my $response = $browser->anon_request($request);

=cut

sub anon_request
{
    my $self  = shift;
    my $clone = $self->clone();
    my $retry = $DEFAULT_RETRY_COUNT;

    print "INFO: Max retry: [$retry]\n" if $DEBUG;
    while ($retry > 0)
    {
        my $proxy = $self->set_proxy();
        if (defined($proxy) && ($proxy =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\:\d{1,6}/))
        {
            $self->proxy(['http','ftp'], $proxy);
            my $response = $self->SUPER::request(@_);
            print {*STDOUT} "INFO: Status " . $response->status_line . "\n" if $DEBUG;
            return $response if (defined($response) && $response->is_success);
        }    
        $retry--;
    }

    print {*STDOUT} "WARN: Unable to get the proxy ... going no-proxy route now.\n" if $DEBUG;
    return $clone->SUPER::request(@_);
}

=head2 get_proxy()

This returns the proxy that was used last time.

    use strict; use warnings;
    use LWP::UserAgent::Anonymous;

    my $browser  = LWP::UserAgent::Anonymous->new();
    my $request  = HTTP::Request->new(GET=>'http://www.google.com/');
    my $response = $browser->anon_request($request);
    print "Proxy used last time : " . $browser->get_proxy(). "\n";

=cut

sub get_proxy
{
    my $self = shift;
    return $self->{_proxy} 
        if (exists($self->{_proxy}) && defined($self->{_proxy}));
    return 'N/A';    
}

=head2 is_it_ok()

This takes in a proxy and validates it by telneting it. Returns 1 on success and 0 on failure.
This is being called by method set_proxy(). 
Expects the proxy in the format of ddd.ddd.ddd.ddd:ddddd.

    use strict; use warnings;
    use LWP::UserAgent::Anonymous;

    my $browser = LWP::UserAgent::Anonymous->new();
    print "Valid proxy.\n" if $browser->is_it_ok('70.186.168.130:9090');

=cut

sub is_it_ok
{
    my $self  = shift;
    my $proxy = shift;

    return 0 unless defined($proxy);

    return 0 if (exists($self->{_buggy}) && exists($self->{_buggy}->{$proxy}));

    $proxy =~ /(.*)\:(.*)/;
    print {*STDOUT} "INFO: Telneting host [$1] on port [$2] ... " if $DEBUG;

    my $telnet = Net::Telnet->new();
    eval { $telnet->open(Host => $1, Port => $2); };
    if ($@)
    {
        $self->{_buggy}->{$proxy} = 1;
        print {*STDOUT} "[FAIL]\n" if $DEBUG;
        return 0;
    }
    my $error = $telnet->errmsg;
    if (defined($error) && ($error ne ''))
    {
        $self->{_buggy}->{$proxy} = 1;
        print {*STDOUT} "[FAIL]\n" if $DEBUG;
        return 0;
    }
    print {*STDOUT} "[OK]\n" if $DEBUG;
    return 1;
}

=head2 set_debug()

Turn debug on or off by passing 1 or 0 respectively.

    use strict; use warnings;
    use LWP::UserAgent::Anonymous;

    my $browser = LWP::UserAgent::Anonymous->new();
    $browser->set_debug(1);

=cut

sub set_debug
{
    my $self = shift;
    $DEBUG = shift;
}

=head2 set_retry()

Set retry count when fetching proxies. By default the count is 3.

    use strict; use warnings;
    use LWP::UserAgent::Anonymous;

    my $browser = LWP::UserAgent::Anonymous->new();
    $browser->set_retry(2);

=cut

sub set_retry
{
    my $self = shift;
    $DEFAULT_RETRY_COUNT = shift;
}

=head2 set_proxy()

This loads up the default list of proxies and shuffles it before picking up one from the list.
This  is  being called by method anon_request(). This *SHOULD* not be called directly, instead 
let method anon_request() handle the call for you.

    use strict; use warnings;
    use LWP::UserAgent::Anonymous;

    my $browser = LWP::UserAgent::Anonymous->new();
    $browser->set_proxy();

=cut

sub set_proxy
{
    my $self = shift;

    my ($proxy, @list);
    @list  = shuffle(@{$LWP::UserAgent::Anonymous::Proxy::DEFAULT});
    $proxy = shift(@list);

    if (defined $proxy)
    {
        return unless ($self->is_it_ok($proxy));

        print {*STDOUT} "INFO: Using proxy [$proxy] ...\n" if $DEBUG;
        $self->{_proxy} = sprintf("http://%s/", $proxy);

        return $self->{_proxy};
    }
    print {*STDOUT} "WARN: No proxy could be found.\n" if $DEBUG;
}

=head1 AUTHOR

Mohammad S Anwar, C<< <mohammad.anwar at yahoo.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-lwp-useragent-anonymous at rt.cpan.org>,or
 through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LWP-UserAgent-Anonymous>.
I will be notified and then you'll automatically be notified of progress on your bug as I make 
changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc LWP::UserAgent::Anonymous

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=LWP-UserAgent-Anonymous>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/LWP-UserAgent-Anonymous>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/LWP-UserAgent-Anonymous>

=item * Search CPAN

L<http://search.cpan.org/dist/LWP-UserAgent-Anonymous/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Mohammad S Anwar.

This  program  is  free  software; you can redistribute it and/or modify it under the terms of
either:  the  GNU  General Public License as published by the Free Software Foundation; or the 
Artistic License.

See http://dev.perl.org/licenses/ for more information.

=head1 DISCLAIMER

This  program  is  distributed  in  the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut

1; # End of LWP::UserAgent::Anonymous