package POE::Component::IRC::Plugin::Connector; our $AUTHORITY = 'cpan:HINRIK'; $POE::Component::IRC::Plugin::Connector::VERSION = '6.93'; 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