File Coverage

blib/lib/POE/Component/IRC/Plugin/Connector.pm

Criterion	Covered	Total	%
statement	78	108	72.2
branch	5	12	41.6
condition	4	9	44.4
subroutine	19	24	79.1
pod	2	11	18.1
total	108	164	65.8

package POE::Component::IRC::Plugin::Connector;
$POE::Component::IRC::Plugin::Connector::VERSION = '6.95';
use strict;
use warnings FATAL => 'all';
use Carp;
use POE;
use POE::Component::IRC::Plugin qw( :ALL );

sub new {
    my ($package) = shift;
    croak "$package requires an even number of arguments" if @_ & 1;
    my %args = @_;

    $args{ lc $_ } = delete $args{$_} for keys %args;
    $args{lag} = 0;
    return bless \%args, $package;
}

sub PCI_register {
    my ($self, $irc) = splice @_, 0, 2;

    $self->{irc} = $irc;
    POE::Session->create(
        object_states => [
            $self => [ qw(_start _auto_ping _reconnect _shutdown _start_ping _start_time_out _stop_ping _time_out) ],
        ],
    );

    $irc->raw_events(1);
    $irc->plugin_register( $self, 'SERVER', qw(connected disconnected 001 error socketerr pong raw) );

    return 1;
}

sub PCI_unregister {
    my ($self, $irc) = splice @_, 0, 2;
    delete $self->{irc};
    $poe_kernel->post( $self->{SESSION_ID} => '_shutdown' );
    $poe_kernel->refcount_decrement( $self->{SESSION_ID}, __PACKAGE__ );
    return 1;
}

sub S_connected {
    my ($self, $irc) = splice @_, 0, 2;
    $poe_kernel->post( $self->{SESSION_ID}, '_start_time_out' );
    return PCI_EAT_NONE;
}

sub S_001 {
    my ($self, $irc) = splice @_, 0, 2;
    $poe_kernel->post( $self->{SESSION_ID}, '_start_ping' );
    return PCI_EAT_NONE;
}

sub S_disconnected {
    my ($self, $irc) = splice @_, 0, 2;
    $poe_kernel->post( $self->{SESSION_ID}, '_stop_ping' );
    $poe_kernel->post( $self->{SESSION_ID}, '_reconnect' );
    return PCI_EAT_NONE;
}

sub S_error {
    my ($self, $irc) = splice @_, 0, 2;
    $poe_kernel->post( $self->{SESSION_ID}, '_stop_ping' );
    $poe_kernel->post( $self->{SESSION_ID}, '_reconnect' );
    return PCI_EAT_NONE;
}

sub S_socketerr {
    my ($self, $irc) = splice @_, 0, 2;
    $poe_kernel->post( $self->{SESSION_ID}, '_stop_ping' );
    $poe_kernel->post( $self->{SESSION_ID}, '_reconnect' );
    return PCI_EAT_NONE;
}

sub S_pong {
    my ($self, $irc) = splice @_, 0, 2;
    my $ping = shift @{ $self->{pings} };
    return PCI_EAT_NONE if !$ping;
    $self->{lag} = time() - $ping;
    $self->{seen_traffic} = 1;
    return PCI_EAT_NONE;
}

sub S_raw {
    my ($self,$irc) = splice @_, 0, 2;
    $self->{seen_traffic} = 1;
    return PCI_EAT_NONE;
}

sub lag {
    return $_[0]->{lag};
}

sub _start {
    my ($kernel, $self) = @_[KERNEL, OBJECT];

    $self->{SESSION_ID} = $_[SESSION]->ID();
    $kernel->refcount_increment( $self->{SESSION_ID}, __PACKAGE__ );
    $kernel->yield( '_start_ping' ) if $self->{irc}->connected();
    return;
}

sub _start_ping {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    $self->{pings} = [ ];
    $kernel->delay( '_time_out' => undef );
    $kernel->delay( '_auto_ping' => $self->{delay} || 300 );
    return;
}

sub _auto_ping {
    my ($kernel, $self) = @_[KERNEL, OBJECT];

    if (!$self->{seen_traffic}) {
        my $time = time();
        $self->{irc}->yield( 'ping' => $time );
        push @{ $self->{pings} }, $time;
    }

    $self->{seen_traffic} = 0;
    $kernel->yield( '_start_ping' );
    return;
}

sub _stop_ping {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    delete $self->{pings};
    $kernel->delay( '_auto_ping' => undef );
    $kernel->delay( '_time_out' => undef );
    return;
}

sub _shutdown {
    my ($kernel,$self) = @_[KERNEL, OBJECT];

    $kernel->yield( '_stop_ping' );
    $kernel->delay('_reconnect');
    return;
}

sub _reconnect {
    my ($kernel, $self, $session, $sender) = @_[KERNEL, OBJECT, SESSION, SENDER];

    my %args;
    if (ref $self->{servers} eq 'ARRAY' && @{ $self->{servers} }) {
        @args{qw(Server Port)} = @{ $self->{servers}->[0] };
        push @{ $self->{servers} }, shift @{ $self->{servers} };
    }

    if ($sender eq $session) {
        $self->{irc}->yield('connect' => %args);
    }
    else {
        $kernel->delay( '_reconnect' => $self->{reconnect} || 60 );
    }

    return;
}

sub _start_time_out {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    $kernel->delay( '_time_out' => $self->{timeout} || 60 );
    return;
}

sub _time_out {
    my ($kernel, $self) = @_[KERNEL, OBJECT];
    $self->{irc}->disconnect();
    return;
}

1;

=encoding utf8

=head1 NAME

POE::Component::IRC::Plugin::Connector - A PoCo-IRC plugin that deals with the
messy business of staying connected to an IRC server

=head1 SYNOPSIS

 use POE qw(Component::IRC Component::IRC::Plugin::Connector);

 my $irc = POE::Component::IRC->spawn();

 POE::Session->create(
     package_states => [
         main => [ qw(_start lag_o_meter) ],
     ],
 );

 $poe_kernel->run();

 sub _start {
     my ($kernel, $heap) = @_[KERNEL ,HEAP];
     $irc->yield( register => 'all' );

     $heap->{connector} = POE::Component::IRC::Plugin::Connector->new();

     $irc->plugin_add( 'Connector' => $heap->{connector} );

     $irc->yield ( connect => { Nick => 'testbot', Server => 'someserver.com' } );

     $kernel->delay( 'lag_o_meter' => 60 );
     return;
 }

 sub lag_o_meter {
     my ($kernel,$heap) = @_[KERNEL,HEAP];
     print 'Time: ' . time() . ' Lag: ' . $heap->{connector}->lag() . "\n";
     $kernel->delay( 'lag_o_meter' => 60 );
     return;
 }

=head1 DESCRIPTION

POE::Component::IRC::Plugin::Connector is a L
plugin that deals with making sure that your IRC bot stays connected to the IRC
network of your choice. It implements the general algorithm as demonstrated at
L.

=head1 METHODS

=head2 C

Takes two optional arguments:

B<'delay'>, the frequency, in seconds, at which the plugin will ping the IRC
server. Defaults to 300.

B<'reconnect'>, the time in seconds, to wait before trying to reconnect to
the server. Defaults to 60.

B<'servers'>, an array reference of IRC servers to consider. Each element should
be an array reference containing a server host and (optionally) a port number.
The plugin will cycle through this list of servers whenever it reconnects.

Returns a plugin object suitable for use in
L's C method.

=head2 C

Returns the current 'lag' in seconds between sending PINGs to the IRC server
and getting PONG responses. Probably not likely to be wholely accurate.

=head1 AUTHOR

Chris "BinGOs" Williams

=head1 SEE ALSO

L

L

=cut