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


line stmt bran cond sub pod time code
1             package POE::Component::IRC::Plugin::Connector;
2             our $AUTHORITY = 'cpan:HINRIK';
3             $POE::Component::IRC::Plugin::Connector::VERSION = '6.93';
4 3     3   2952 use strict;
  3         15  
  3         109  
5 3     3   14 use warnings FATAL => 'all';
  3         5  
  3         161  
6 3     3   26 use Carp;
  3         5  
  3         205  
7 3     3   17 use POE;
  3         16  
  3         20  
8 3     3   1316 use POE::Component::IRC::Plugin qw( :ALL );
  3         13  
  3         4673  
9              
10             sub new {
11 2     2 1 2741 my ($package) = shift;
12 2 50       11 croak "$package requires an even number of arguments" if @_ & 1;
13 2         10 my %args = @_;
14              
15 2         13 $args{ lc $_ } = delete $args{$_} for keys %args;
16 2         17 $args{lag} = 0;
17 2         27 return bless \%args, $package;
18             }
19              
20             sub PCI_register {
21 2     2 0 974 my ($self, $irc) = splice @_, 0, 2;
22              
23 2         21 $self->{irc} = $irc;
24 2         20 POE::Session->create(
25             object_states => [
26             $self => [ qw(_start _auto_ping _reconnect _shutdown _start_ping _start_time_out _stop_ping _time_out) ],
27             ],
28             );
29              
30 2         268 $irc->raw_events(1);
31 2         14 $irc->plugin_register( $self, 'SERVER', qw(connected disconnected 001 error socketerr pong raw) );
32              
33 2         137 return 1;
34             }
35              
36             sub PCI_unregister {
37 2     2 0 1317 my ($self, $irc) = splice @_, 0, 2;
38 2         8 delete $self->{irc};
39 2         11 $poe_kernel->post( $self->{SESSION_ID} => '_shutdown' );
40 2         224 $poe_kernel->refcount_decrement( $self->{SESSION_ID}, __PACKAGE__ );
41 2         103 return 1;
42             }
43              
44             sub S_connected {
45 2     2 0 148 my ($self, $irc) = splice @_, 0, 2;
46 2         15 $poe_kernel->post( $self->{SESSION_ID}, '_start_time_out' );
47 2         368 return PCI_EAT_NONE;
48             }
49              
50             sub S_001 {
51 2     2 0 86 my ($self, $irc) = splice @_, 0, 2;
52 2         14 $poe_kernel->post( $self->{SESSION_ID}, '_start_ping' );
53 2         309 return PCI_EAT_NONE;
54             }
55              
56             sub S_disconnected {
57 1     1 0 47 my ($self, $irc) = splice @_, 0, 2;
58 1         6 $poe_kernel->post( $self->{SESSION_ID}, '_stop_ping' );
59 1         111 $poe_kernel->post( $self->{SESSION_ID}, '_reconnect' );
60 1         97 return PCI_EAT_NONE;
61             }
62              
63             sub S_error {
64 2     2 0 84 my ($self, $irc) = splice @_, 0, 2;
65 2         11 $poe_kernel->post( $self->{SESSION_ID}, '_stop_ping' );
66 2         257 $poe_kernel->post( $self->{SESSION_ID}, '_reconnect' );
67 2         206 return PCI_EAT_NONE;
68             }
69              
70             sub S_socketerr {
71 0     0 0 0 my ($self, $irc) = splice @_, 0, 2;
72 0         0 $poe_kernel->post( $self->{SESSION_ID}, '_stop_ping' );
73 0         0 $poe_kernel->post( $self->{SESSION_ID}, '_reconnect' );
74 0         0 return PCI_EAT_NONE;
75             }
76              
77             sub S_pong {
78 0     0 0 0 my ($self, $irc) = splice @_, 0, 2;
79 0         0 my $ping = shift @{ $self->{pings} };
  0         0  
80 0 0       0 return PCI_EAT_NONE if !$ping;
81 0         0 $self->{lag} = time() - $ping;
82 0         0 $self->{seen_traffic} = 1;
83 0         0 return PCI_EAT_NONE;
84             }
85              
86             sub S_raw {
87 25     25 0 1051 my ($self,$irc) = splice @_, 0, 2;
88 25         48 $self->{seen_traffic} = 1;
89 25         58 return PCI_EAT_NONE;
90             }
91              
92             sub lag {
93 0     0 1 0 return $_[0]->{lag};
94             }
95              
96             sub _start {
97 2     2   497 my ($kernel, $self) = @_[KERNEL, OBJECT];
98              
99 2         10 $self->{SESSION_ID} = $_[SESSION]->ID();
100 2         17 $kernel->refcount_increment( $self->{SESSION_ID}, __PACKAGE__ );
101 2 50       88 $kernel->yield( '_start_ping' ) if $self->{irc}->connected();
102 2         7 return;
103             }
104              
105             sub _start_ping {
106 2     2   1581 my ($kernel, $self) = @_[KERNEL, OBJECT];
107 2         10 $self->{pings} = [ ];
108 2         12 $kernel->delay( '_time_out' => undef );
109 2   50     370 $kernel->delay( '_auto_ping' => $self->{delay} || 300 );
110 2         395 return;
111             }
112              
113             sub _auto_ping {
114 0     0   0 my ($kernel, $self) = @_[KERNEL, OBJECT];
115              
116 0 0       0 if (!$self->{seen_traffic}) {
117 0         0 my $time = time();
118 0         0 $self->{irc}->yield( 'ping' => $time );
119 0         0 push @{ $self->{pings} }, $time;
  0         0  
120             }
121              
122 0         0 $self->{seen_traffic} = 0;
123 0         0 $kernel->yield( '_start_ping' );
124 0         0 return;
125             }
126              
127             sub _stop_ping {
128 5     5   2270 my ($kernel, $self) = @_[KERNEL, OBJECT];
129 5         14 delete $self->{pings};
130 5         17 $kernel->delay( '_auto_ping' => undef );
131 5         444 $kernel->delay( '_time_out' => undef );
132 5         295 return;
133             }
134              
135             sub _shutdown {
136 2     2   585 my ($kernel,$self) = @_[KERNEL, OBJECT];
137              
138 2         11 $kernel->yield( '_stop_ping' );
139 2         151 $kernel->delay('_reconnect');
140 2         201 return;
141             }
142              
143             sub _reconnect {
144 4     4   2003248 my ($kernel, $self, $session, $sender) = @_[KERNEL, OBJECT, SESSION, SENDER];
145              
146 4         12 my %args;
147 4 50 33     26 if (ref $self->{servers} eq 'ARRAY' && @{ $self->{servers} }) {
  0         0  
148 0         0 @args{qw(Server Port)} = @{ $self->{servers}->[0] };
  0         0  
149 0         0 push @{ $self->{servers} }, shift @{ $self->{servers} };
  0         0  
  0         0  
150             }
151              
152 4 100       26 if ($sender eq $session) {
153 1         28 $self->{irc}->yield('connect' => %args);
154             }
155             else {
156 3   50     14 $kernel->delay( '_reconnect' => $self->{reconnect} || 60 );
157             }
158              
159 4         884 return;
160             }
161              
162             sub _start_time_out {
163 2     2   391 my ($kernel, $self) = @_[KERNEL, OBJECT];
164 2   50     12 $kernel->delay( '_time_out' => $self->{timeout} || 60 );
165 2         327 return;
166             }
167              
168             sub _time_out {
169 0     0     my ($kernel, $self) = @_[KERNEL, OBJECT];
170 0           $self->{irc}->disconnect();
171 0           return;
172             }
173              
174             1;
175              
176             =encoding utf8
177              
178             =head1 NAME
179              
180             POE::Component::IRC::Plugin::Connector - A PoCo-IRC plugin that deals with the
181             messy business of staying connected to an IRC server
182              
183             =head1 SYNOPSIS
184              
185             use POE qw(Component::IRC Component::IRC::Plugin::Connector);
186              
187             my $irc = POE::Component::IRC->spawn();
188              
189             POE::Session->create(
190             package_states => [
191             main => [ qw(_start lag_o_meter) ],
192             ],
193             );
194              
195             $poe_kernel->run();
196              
197             sub _start {
198             my ($kernel, $heap) = @_[KERNEL ,HEAP];
199             $irc->yield( register => 'all' );
200              
201             $heap->{connector} = POE::Component::IRC::Plugin::Connector->new();
202              
203             $irc->plugin_add( 'Connector' => $heap->{connector} );
204              
205             $irc->yield ( connect => { Nick => 'testbot', Server => 'someserver.com' } );
206              
207             $kernel->delay( 'lag_o_meter' => 60 );
208             return;
209             }
210              
211             sub lag_o_meter {
212             my ($kernel,$heap) = @_[KERNEL,HEAP];
213             print 'Time: ' . time() . ' Lag: ' . $heap->{connector}->lag() . "\n";
214             $kernel->delay( 'lag_o_meter' => 60 );
215             return;
216             }
217              
218             =head1 DESCRIPTION
219              
220             POE::Component::IRC::Plugin::Connector is a L
221             plugin that deals with making sure that your IRC bot stays connected to the IRC
222             network of your choice. It implements the general algorithm as demonstrated at
223             L.
224              
225             =head1 METHODS
226              
227             =head2 C
228              
229             Takes two optional arguments:
230              
231             B<'delay'>, the frequency, in seconds, at which the plugin will ping the IRC
232             server. Defaults to 300.
233              
234             B<'reconnect'>, the time in seconds, to wait before trying to reconnect to
235             the server. Defaults to 60.
236              
237             B<'servers'>, an array reference of IRC servers to consider. Each element should
238             be an array reference containing a server host and (optionally) a port number.
239             The plugin will cycle through this list of servers whenever it reconnects.
240              
241             Returns a plugin object suitable for use in
242             L's C method.
243              
244             =head2 C
245              
246             Returns the current 'lag' in seconds between sending PINGs to the IRC server
247             and getting PONG responses. Probably not likely to be wholely accurate.
248              
249             =head1 AUTHOR
250              
251             Chris "BinGOs" Williams
252              
253             =head1 SEE ALSO
254              
255             L
256              
257             L
258              
259             =cut