The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package POE::Component::Client::Whois::Smart;

use strict;
use warnings;

use Socket;
use POE;
use HTTP::Request;
use Net::Whois::Raw::Common;
use Net::Whois::Raw::Data;
use Storable;

use CLASS;

use Data::Dumper;

use utf8;

use Module::Pluggable::Ordered search_path => 'POE::Component::Client::Whois::Smart';
use UNIVERSAL::require;

our $VERSION = '0.187';
our $DEBUG;

our @local_ips = ();
our $local_ip_index;
our %servers_ban = ();

# HIJACK POE::Filter::HTTPChunk
{
    package # hide from PAUSE
	POE::Filter::HTTPChunk;

    use POE::Filter::HTTPChunk;

    no warnings 'once', 'redefine';

    *get_one_old = \&get_one;

    *get_one = sub {
        my $self = shift;

        my $retval = $self->get_one_old();

        if ( 
                $self->[CURRENT_STATE] & STATE_SIZE
            &&  join('', @$retval) 
                    =~
                m{\A <\?xml.*?\?> \s* <(\S+) .* </\1> \z}smx
        )
        {
            DEBUG and warn "HIJACKED: XML tags found";
            if (    scalar @{ $self->[FRAMING_BUFFER] }
                &&  $self->[FRAMING_BUFFER]->[0] =~ m/^0+\D/
            )
            {
                # my heart is skipping, skipping
                shift @{ $self->[FRAMING_BUFFER] };
            }
            # finish him!
            push @$retval, bless {}, 'HTTP::Headers';
        }

        return $retval;
    };
}


my $plugins_initialized;

# init whois query 
sub whois {
    my $class = shift;
    my %args = @_;

    if ( not $plugins_initialized ) {

	foreach my $plugin ($class->plugins) {
	    #warn $plugin;
	    eval {
		$plugin->require
		    or die "Cannot require plugin $plugin: $@";

		my $init = $plugin->can('initialize');

		$init && $init->($poe_kernel, \%args)
		    or die "Cannot initialize plugin $plugin: $@";
		
		if ( $DEBUG ) {
		    no strict 'refs';
		    no warnings 'redefine';
		    *{$plugin.'::DEBUG'} = sub { $DEBUG };
		}
	    };

	    warn $@ if $@;
	}

	$plugins_initialized = 1;
    }

    $args{session} = $args{session} || $poe_kernel->get_active_session();        
    #warn Dumper \%args;
    
    POE::Session->create(
        inline_states => {
            _start      => \&_start_manager,
            _query_done => \&_query_done,
        },
        args => [ \%args ],
    );
  
    undef;
}

# start manager, which manages all process and returns result to caller 
sub _start_manager {
    my ($heap, $session, $arg_ref) = @_[HEAP, SESSION, ARG0];
    my %args = %$arg_ref;

    my %params;

    $params{parent_session_id} = delete($args{session})->ID();

    foreach my $plugin ( CLASS->plugins ) {
	my %plugin_params = 
	    $plugin->can('plugin_params') ? $plugin->plugin_params() : ();
	
	foreach (keys %plugin_params) {
            if (not exists $params{$_}) {
                $params{$_} = exists $args{$_}  ? 
                              delete($args{$_}) : $plugin_params{$_};
            }
	    defined $params{$_} or delete $params{$_};
	}
    }

    $params{event}  = delete $args{event};

    $heap->{params} = \%params;

    $args{host}       = delete $args{server},
    $args{manager_id} = $session->ID();
    $args{event}      = "_query_done";
    $args{timeout}    = $args{timeout} || 30;

    $heap->{tasks}  = 0;
    $heap->{result} = {};
    
    if ( $args{local_ips} && "@{ $args{local_ips} }" ne "@local_ips" ) {
	@local_ips = @{$args{local_ips}} if $args{local_ips};
	$local_ip_index = 0;
    }
    
    delete $args{local_ips};

    $args{query}
	or return CLASS->check_if_done(@_[KERNEL, HEAP]);

    my (@query_list) = @{$args{query}};
    delete $args{query};
    
    my $iteration = 0;
    while ( @query_list && $iteration++ < 10 ) {
	CLASS->call_plugins(
	    'query', \@query_list,
	    $heap, \%args
	);
    }

    # it can be already finished for that time
    CLASS->check_if_done( @_[KERNEL, HEAP] );

    return;
}

sub check_if_done {
    my ($self, $kernel, $heap) = @_;

    unless ($heap->{tasks}) {     
        my @result;

	CLASS->call_plugins( '_on_done', $heap );

	foreach my $query (keys %{$heap->{result}}) {            
	    my $num = $heap->{params}->{referral} == 0 ? 0 : -1;

	    my $result = $heap->{result}{ $query }->[ $num ];

	    my %res = (
		query  => $query,
		whois  => $result->{whois},
		server => $result->{server},
		error  => $result->{error},
	    );

	    $res{subqueries} = $heap->{result}->{$query}
		if $heap->{params}->{referral} == 2;
	    
	    push @result, \%res;
	}

        $kernel->post( $heap->{params}->{parent_session_id},
            $heap->{params}->{event}, \@result )
    }
}

# caches retrieved whois-info, return result if no more tasks
sub _query_done {
    my ($kernel, $heap, $session, $response) = @_[KERNEL, HEAP, SESSION, ARG0];

    #warn "$response->{query} done...\n";

    $heap->{tasks}--;
    return CLASS->check_if_done( $kernel, $heap );
}

sub next_local_ip {
    @local_ips or return 'default';
    $local_ip_index = ++$local_ip_index % @local_ips;
    return $local_ips[ $local_ip_index ];
}

sub local_ips {
    return @local_ips;
}

sub __next_local_ip {
    my ($server, $clientname, $rism) = @_;
    clean_bans();
    
    my $i = 0;
    while ($i <= @local_ips) {
        $i++;
        my $next_ip = shift @local_ips || 'localhost';
        push @local_ips, $next_ip
            unless $next_ip eq 'localhost';
        if (!$servers_ban{$server} || !$servers_ban{$server}->{$next_ip}) {
            return $next_ip;
        }
    }
    
    return undef;
}

sub clean_bans {
    foreach my $server (keys %servers_ban) {
        foreach my $ip (keys %{$servers_ban{$server}}) {
            #print $Net::Whois::Raw::Data::ban_time{$server}."\n";
            delete $servers_ban{$server}->{$ip}
                if time - $servers_ban{$server}->{$ip}
                    >=
                    (
                        $Net::Whois::Raw::Data::ban_time{$server}
                        || $Net::Whois::Raw::Data::default_ban_time
                    )
                ;
        }
        delete $servers_ban{$server} unless %{$servers_ban{$server}};
    }
}

sub unban_time {
    my ($server, $clientname, $rism) = @_;
    my $unban_time;
    
    my (@my_local_ips) = @local_ips || ('localhost');
    
    foreach my $ip (@my_local_ips) {
        my $ip_unban_time
            = (
                $Net::Whois::Raw::Data::ban_time{$server}
                || $Net::Whois::Raw::Data::default_ban_time
              )
            - (time - ($servers_ban{$server}->{$ip}||0) );
        $ip_unban_time = 0 if $ip_unban_time < 0;
        $unban_time = $ip_unban_time
            if !defined $unban_time || $unban_time > $ip_unban_time; 
    }

    return $unban_time+1;    
}


1;
__END__

=head1 NAME

POE::Component::Client::Whois::Smart - Provides very quick WHOIS queries with smart features.

=head1 DESCRIPTION

POE::Component::Client::Whois::Smart provides a very quick WHOIS queries
with smart features to other POE sessions and components.
The component will attempt to guess the appropriate whois server to connect
to. Supports cacheing, HTTP-queries to some servers, stripping useless information, using more then one local IP, handling server's bans.

B<WARNING>: This module changes body of POE::Filter::HTTPChunk to work correctly with DirectI SSL connection. See code for details.

=head1 SYNOPSIS

    use strict; 
    use warnings;
    use POE qw(Component::Client::Whois::Smart);
    
    my @queries = qw(
        google.com
        yandex.ru
        84.45.68.23
        REGRU-REG-RIPN        
    );
    
    POE::Session->create(
	package_states => [
	    'main' => [ qw(_start _response) ],
	],
    );
    
    $poe_kernel->run();
    exit 0;
    
    sub _start {
        POE::Component::Client::Whois::Smart->whois(
            query => \@queries,
            event => '_response',
        );
    }
    
    sub _response {
        my $all_results = $_[ARG0];
        foreach my $result ( @{$all_results} ) {
            my $query = $result->{query} if $result;
            if ($result->{error}) {
                print "Can't resolve WHOIS-info for ".$result->{query}."\n";
            } else {
                print "QUERY: ".$result->{query}."\n";
                print "SERVER: ".$result->{server}."\n";
                print "WHOIS: ".$result->{whois}."\n\n";
            };
        }                            
    }

=head1 Constructor

=over

=item whois()

Creates a POE::Component::Client::Whois session. Takes two mandatory arguments and a number of optional:

=back

=over 2

=item query

query is an arrayref of domains, IPs or registaras to send to
whois server. Required.

=item event

The event name to call on success/failure. Required.

=item session

A session or alias to send the above 'event' to, defaults to calling session. Optional.

=item server

Specify server to connect. Defaults try to be determined by the component. Optional.

=item referral

Optional.

0 - make just one query, do not follow if redirections can be done;

1 - follow redirections if possible, return last response from server; # default

2 - follow redirections if possible, return all responses;


Exapmle:
   
    #...
    POE::Component::Client::Whois->whois(
        query    => [ 'google.com', 'godaddy.com' ],
        event    => '_response',
        referral => 2,
    );
    #...
    sub _response {
        my $all_results = $_[ARG0];
        
        foreach my $result ( @{$all_results} ) {
            my $query = $result->{query} if $result;
            if ($result->{error}) {
                print "Can't resolve WHOIS-info for ".$result->{query}."\n";
            } else {
                print "Query for: ".$result->{query}."\n";
                # process all subqueries
                my $count = scalar @{$result->{subqueries}};
                print "There were $count subqueries:\n";
                foreach my $subquery (@{$result->{subqueries}}) {
                    print "\tTo server ".$subquery->{server}."\n";
                    # print "\tQuery: ".$subquery->{query}."\n";
                    # print "\tResponse:\n".$subquery->{whois}."\n";
                }
            }
        }                            
    }    
    #...

=item omit_msg

0 - give the whole response.

1 - attempt to strip several known copyright messages and disclaimers.

2 - will try some additional stripping rules if some are known for the spcific server.

Default is 2;

=item use_cnames

Use whois-servers.net to get the whois server name when possible.
Default is to use the hardcoded defaults.

=item timeout

Cancel the request if connection is not made within a specific number of seconds.
Default 30 sec.

=item local_ips

List of local IP addresses to use for WHOIS queries.

=item cache_dir

Whois information will be cached in this directory. Default is no cache.

=item cache_time

Number of minutes to save cache. 1 minute by default.

=item exceed_wait

If exceed_wait true, will wait for for 1 minute and requery server in case if your IP banned for excessive querying.
By default return 'Connection rate exceeded' in $result->{error};

=head1 OUTPUT

ARG0 will be an array of hashrefs, which contains replies.
See example above.

=head1 AUTHOR

=over 2

=item * Pavel Boldin   <davinchi@cpan.org>

=item * Sergey Kotenko <graykot@gmail.com>

=back

This module is based on the Net::Whois::Raw L<http://search.cpan.org/perldoc?Net::Whois::Raw>
and POE::Component::Client::Whois L<http://search.cpan.org/perldoc?POE::Component::Client::Whois>

Some corrects by Odintsov Pavel E<lt>nrg[at]cpan.orgE<gt>

=head1 SEE ALSO

RFC 812 L<http://www.faqs.org/rfcs/rfc812.html>.