File Coverage

blib/lib/POE/Component/IRC.pm
Criterion Covered Total %
statement 441 719 61.3
branch 144 338 42.6
condition 46 135 34.0
subroutine 63 84 75.0
pod 27 51 52.9
total 721 1327 54.3


line stmt bran cond sub pod time code
1             package POE::Component::IRC;
2             our $AUTHORITY = 'cpan:HINRIK';
3             $POE::Component::IRC::VERSION = '6.93';
4 79     79   6791712 use strict;
  79         572  
  79         2739  
5 79     79   433 use warnings FATAL => 'all';
  79         167  
  79         3335  
6 79     79   472 use Carp;
  79         158  
  79         5739  
7 79         556 use POE qw(Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW
8 79     79   3375 Filter::Line Filter::Stream Filter::Stackable);
  79         224954  
9 79     79   1993629 use POE::Filter::IRCD;
  79         156739  
  79         2744  
10 79     79   44676 use POE::Filter::IRC::Compat;
  79         245  
  79         3136  
11 79     79   40702 use POE::Component::IRC::Constants qw(:ALL);
  79         383  
  79         12609  
12 79     79   31406 use POE::Component::IRC::Plugin qw(:ALL);
  79         204  
  79         8437  
13 79     79   46602 use POE::Component::IRC::Plugin::DCC;
  79         250  
  79         3323  
14 79     79   45829 use POE::Component::IRC::Plugin::ISupport;
  79         242  
  79         3195  
15 79     79   42508 use POE::Component::IRC::Plugin::Whois;
  79         278  
  79         3273  
16 79     79   929 use Socket qw(AF_INET SOCK_STREAM unpack_sockaddr_in inet_ntoa inet_aton);
  79         176  
  79         5455  
17 79     79   818 use base qw(POE::Component::Syndicator);
  79         171  
  79         53776  
18              
19             our ($GOT_SSL, $GOT_CLIENT_DNS, $GOT_SOCKET6, $GOT_ZLIB);
20              
21             BEGIN {
22 79     79   868174 eval {
23 79         15000 require POE::Component::SSLify;
24 0         0 import POE::Component::SSLify qw( Client_SSLify SSLify_ContextCreate );
25 0         0 $GOT_SSL = 1;
26             };
27 79         445 eval {
28 79         48637 require POE::Component::Client::DNS;
29 79 50       5350989 $GOT_CLIENT_DNS = 1 if $POE::Component::Client::DNS::VERSION >= 0.99;
30             };
31 79         702 eval {
32 79         16550 require POE::Filter::Zlib::Stream;
33 0 0       0 $GOT_ZLIB = 1 if $POE::Filter::Zlib::Stream::VERSION >= 1.96;
34             };
35             # Socket6 provides AF_INET6 where earlier Perls' Socket don't.
36 79         703 eval {
37 79         13096 Socket->import(qw(AF_INET6 unpack_sockaddr_in6 inet_ntop));
38 79         2152 $GOT_SOCKET6 = 1;
39             };
40 79 50       860493 if (!$GOT_SOCKET6) {
41 0         0 eval {
42 0         0 require Socket6;
43 0         0 Socket6->import(qw(AF_INET6 unpack_sockaddr_in6 inet_ntop));
44 0         0 $GOT_SOCKET6 = 1;
45             };
46 0 0       0 if (!$GOT_SOCKET6) {
47             # provide a dummy sub so code compiles
48 0         0 *AF_INET6 = sub { ~0 };
  0         0  
49             }
50             }
51             }
52              
53             # BINGOS: I have bundled up all the stuff that needs changing
54             # for inherited classes into _create. This gets called from 'spawn'.
55             # $self->{OBJECT_STATES_ARRAYREF} contains event mappings to methods that have
56             # the same name, gets passed to POE::Session->create as $self => [ ];
57             # $self->{OBJECT_STATES_HASHREF} contains event mappings to methods, where the
58             # event and the method have diferent names.
59             # $self->{IRC_CMDS} contains the traditional %irc_commands, mapping commands
60             # to events and the priority that the command has.
61             sub _create {
62 115     115   317 my ($self) = @_;
63              
64             $self->{IRC_CMDS} = {
65 115         6973 rehash => [ PRI_HIGH, 'noargs', ],
66             die => [ PRI_HIGH, 'noargs', ],
67             restart => [ PRI_HIGH, 'noargs', ],
68             quit => [ PRI_NORMAL, 'oneoptarg', ],
69             version => [ PRI_HIGH, 'oneoptarg', ],
70             time => [ PRI_HIGH, 'oneoptarg', ],
71             trace => [ PRI_HIGH, 'oneoptarg', ],
72             admin => [ PRI_HIGH, 'oneoptarg', ],
73             info => [ PRI_HIGH, 'oneoptarg', ],
74             away => [ PRI_HIGH, 'oneoptarg', ],
75             users => [ PRI_HIGH, 'oneoptarg', ],
76             lusers => [ PRI_HIGH, 'oneoptarg', ],
77             locops => [ PRI_HIGH, 'oneoptarg', ],
78             operwall => [ PRI_HIGH, 'oneoptarg', ],
79             wallops => [ PRI_HIGH, 'oneoptarg', ],
80             motd => [ PRI_HIGH, 'oneoptarg', ],
81             who => [ PRI_HIGH, 'oneoptarg', ],
82             nick => [ PRI_HIGH, 'onlyonearg', ],
83             oper => [ PRI_HIGH, 'onlytwoargs', ],
84             invite => [ PRI_HIGH, 'onlytwoargs', ],
85             squit => [ PRI_HIGH, 'onlytwoargs', ],
86             kill => [ PRI_HIGH, 'onlytwoargs', ],
87             privmsg => [ PRI_NORMAL, 'privandnotice', ],
88             privmsglo => [ PRI_NORMAL+1, 'privandnotice', ],
89             privmsghi => [ PRI_NORMAL-1, 'privandnotice', ],
90             notice => [ PRI_NORMAL, 'privandnotice', ],
91             noticelo => [ PRI_NORMAL+1, 'privandnotice', ],
92             noticehi => [ PRI_NORMAL-1, 'privandnotice', ],
93             squery => [ PRI_NORMAL, 'privandnotice', ],
94             join => [ PRI_HIGH, 'oneortwo', ],
95             summon => [ PRI_HIGH, 'oneortwo', ],
96             sconnect => [ PRI_HIGH, 'oneandtwoopt', ],
97             whowas => [ PRI_HIGH, 'oneandtwoopt', ],
98             stats => [ PRI_HIGH, 'spacesep', ],
99             links => [ PRI_HIGH, 'spacesep', ],
100             mode => [ PRI_HIGH, 'spacesep', ],
101             servlist => [ PRI_HIGH, 'spacesep', ],
102             cap => [ PRI_HIGH, 'spacesep', ],
103             part => [ PRI_HIGH, 'commasep', ],
104             names => [ PRI_HIGH, 'commasep', ],
105             list => [ PRI_HIGH, 'commasep', ],
106             whois => [ PRI_HIGH, 'commasep', ],
107             ctcp => [ PRI_HIGH, 'ctcp', ],
108             ctcpreply => [ PRI_HIGH, 'ctcp', ],
109             ping => [ PRI_HIGH, 'oneortwo', ],
110             pong => [ PRI_HIGH, 'oneortwo', ],
111             };
112              
113 5290         9876 my %event_map = map {($_ => $self->{IRC_CMDS}->{$_}->[CMD_SUB])}
114 115         501 keys %{ $self->{IRC_CMDS} };
  115         1011  
115              
116             $self->{OBJECT_STATES_HASHREF} = {
117 115         2369 %event_map,
118             quote => 'sl',
119             };
120              
121 115         1121 $self->{OBJECT_STATES_ARRAYREF} = [qw(
122             syndicator_started
123             _parseline
124             _sock_down
125             _sock_failed
126             _sock_up
127             _socks_proxy_connect
128             _socks_proxy_response
129             debug
130             connect
131             _resolve_addresses
132             _do_connect
133             _quit_timeout
134             _send_login
135             _got_dns_response
136             ison
137             kick
138             remove
139             nickserv
140             shutdown
141             sl
142             sl_login
143             sl_high
144             sl_delayed
145             sl_prioritized
146             topic
147             userhost
148             )];
149              
150 115         706 return;
151             }
152              
153             # BINGOS: the component can now configure itself via _configure() from
154             # either spawn() or connect()
155             ## no critic (Subroutines::ProhibitExcessComplexity)
156             sub _configure {
157 205     205   584 my ($self, $args) = @_;
158 205         431 my $spawned = 0;
159              
160 205 50 33     946 if (ref $args eq 'HASH' && keys %{ $args }) {
  205         1042  
161 205         540 $spawned = delete $args->{spawned};
162 205         785 $self->{use_localaddr} = delete $args->{localaddr};
163 205         423 @{ $self }{ keys %{ $args } } = values %{ $args };
  205         611  
  205         462  
  205         557  
164             }
165              
166 205 50       900 if ($ENV{POCOIRC_DEBUG}) {
167 0         0 $self->{debug} = 1;
168 0         0 $self->{plugin_debug} = 1;
169             }
170              
171 205 50       673 if ($self->{debug}) {
172 0         0 $self->{ircd_filter}->debug(1);
173 0         0 $self->{ircd_compat}->debug(1);
174             }
175              
176 205 50 33     831 if ($self->{useipv6} && !$GOT_SOCKET6) {
177 0         0 warn "'useipv6' option specified, but Socket6 was not found\n";
178             }
179              
180 205 50 33     761 if ($self->{usessl} && !$GOT_SSL) {
181 0         0 warn "'usessl' option specified, but POE::Component::SSLify was not found\n";
182             }
183              
184 205 100       733 $self->{dcc}->nataddr($self->{nataddr}) if exists $self->{nataddr};
185 205 50       663 $self->{dcc}->dccports($self->{dccports}) if exists $self->{dccports};
186              
187 205 100       769 $self->{port} = 6667 if !$self->{port};
188 205 100       687 $self->{msg_length} = 450 if !defined $self->{msg_length};
189              
190 205 50       632 if ($self->{use_localaddr}) {
191             $self->{localaddr} = $self->{use_localaddr}
192 0 0       0 . ($self->{localport} ? (':'.$self->{localport}) : '');
193             }
194              
195             # Make sure that we have reasonable defaults for all the attributes.
196             # The "IRC*" variables are ircII environment variables.
197 205 100       670 if (!defined $self->{nick}) {
198             $self->{nick} = $ENV{IRCNICK} || eval { scalar getpwuid($>) }
199 115   0     614 || $ENV{USER} || $ENV{LOGNAME} || 'WankerBot';
200             }
201              
202 205 100       1000 if (!defined $self->{username}) {
203             $self->{username} = eval { scalar getpwuid($>) } || $ENV{USER}
204 115   0     294 || $ENV{LOGNAME} || 'foolio';
205             }
206              
207 205 100       833 if (!defined $self->{ircname}) {
208 115   50     644 $self->{ircname} = $ENV{IRCNAME} || eval { (getpwuid $>)[6] }
209             || 'Just Another Perl Hacker';
210             }
211              
212 205 50 66     1284 if (!defined $self->{server} && !$spawned) {
213 0 0       0 die "No IRC server specified\n" if !$ENV{IRCSERVER};
214 0         0 $self->{server} = $ENV{IRCSERVER};
215             }
216              
217 205 50       754 if (defined $self->{webirc}) {
218 0 0       0 if (!ref $self->{webirc} ne 'HASH') {
219 0         0 die "webirc param expects a hashref";
220             }
221 0         0 for my $expect_key (qw(pass user host ip)) {
222 0 0       0 if (!exists $self->{webirc}{$expect_key}) {
223 0         0 die "webirc value is missing key '$expect_key'";
224             }
225             }
226             }
227              
228 205         562 return;
229             }
230              
231             sub debug {
232 0     0 1 0 my ($self, $switch) = @_[OBJECT, ARG0];
233              
234 0         0 $self->{debug} = $switch;
235 0         0 $self->{ircd_filter}->debug( $switch );
236 0         0 $self->{ircd_compat}->debug( $switch );
237 0         0 return;
238             }
239              
240             # Parse a message from the IRC server and generate the appropriate
241             # event(s) for listening sessions.
242             sub _parseline {
243 2544     2544   144330 my ($session, $self, $ev) = @_[SESSION, OBJECT, ARG0];
244              
245 2544 50       6862 return if !$ev->{name};
246 2544 100       6195 $self->send_event(irc_raw => $ev->{raw_line} ) if $self->{raw};
247              
248             # record our nickname
249 2544 100       17893 if ( $ev->{name} eq '001' ) {
250 90         814 $self->{INFO}{RealNick} = ( split / /, $ev->{raw_line} )[2];
251             }
252              
253 2544         6404 $ev->{name} = 'irc_' . $ev->{name};
254 2544         4385 $self->send_event( $ev->{name}, @{$ev->{args}} );
  2544         10020  
255              
256 2544 100       328062 if ($ev->{name} =~ /^irc_ctcp_(.+)$/) {
257 12         37 $self->send_event(irc_ctcp => $1 => @{$ev->{args}});
  12         44  
258             }
259              
260 2544         8145 return;
261             }
262              
263             # Internal function called when a socket is closed.
264             sub _sock_down {
265 90     90   36235 my ($kernel, $self) = @_[KERNEL, OBJECT];
266              
267             # Destroy the RW wheel for the socket.
268 90         540 delete $self->{socket};
269 90         25478 delete $self->{localaddr};
270 90         247 $self->{connected} = 0;
271              
272             # Stop any delayed sends.
273 90         347 $self->{send_queue} = [ ];
274 90         228 $self->{send_time} = 0;
275 90         511 $kernel->delay( sl_delayed => undef );
276              
277             # Reset the filters if necessary
278 90         7929 $self->_compress_uplink( 0 );
279 90         489 $self->_compress_downlink( 0 );
280 90         600 $self->{ircd_compat}->chantypes( [ '#', '&' ] );
281 90         411 $self->{ircd_compat}->identifymsg(0);
282              
283             # post a 'irc_disconnected' to each session that cares
284 90         418 $self->send_event(irc_disconnected => $self->{server} );
285 90         10903 return;
286             }
287              
288             sub disconnect {
289 0     0 1 0 my ($self) = @_;
290 0         0 $self->yield('_sock_down');
291 0         0 return;
292             }
293              
294             # Internal function called when a socket fails to be properly opened.
295             sub _sock_failed {
296 1     1   439 my ($self, $op, $errno, $errstr) = @_[OBJECT, ARG0..ARG2];
297              
298 1         4 delete $self->{socketfactory};
299 1         25 $self->send_event(irc_socketerr => "$op error $errno: $errstr" );
300 1         104 return;
301             }
302              
303             # Internal function called when a connection is established.
304             sub _sock_up {
305 90     90   146843 my ($kernel, $self, $session, $socket) = @_[KERNEL, OBJECT, SESSION, ARG0];
306              
307             # We no longer need the SocketFactory wheel. Scrap it.
308 90         592 delete $self->{socketfactory};
309              
310             # Remember what IP address we're connected through, for multihomed boxes.
311 90         2227 my $localaddr;
312 90 50       376 if ($GOT_SOCKET6) {
313 90         198 eval {
314 90         2412 $localaddr = (unpack_sockaddr_in6( getsockname $socket ))[1];
315 0         0 $localaddr = inet_ntop( AF_INET6, $localaddr );
316             };
317             }
318              
319 90 50       1019 if ( !$localaddr ) {
320 90         1177 $localaddr = (unpack_sockaddr_in( getsockname $socket ))[1];
321 90         631 $localaddr = inet_ntoa($localaddr);
322             }
323              
324 90         354 $self->{localaddr} = $localaddr;
325              
326 90 50       385 if ( $self->{socks_proxy} ) {
327 0         0 $self->{socket} = POE::Wheel::ReadWrite->new(
328             Handle => $socket,
329             Driver => POE::Driver::SysRW->new(),
330             Filter => POE::Filter::Stream->new(),
331             InputEvent => '_socks_proxy_response',
332             ErrorEvent => '_sock_down',
333             );
334              
335 0 0       0 if ( !$self->{socket} ) {
336 0         0 $self->send_event(irc_socketerr =>
337             "Couldn't create ReadWrite wheel for SOCKS socket" );
338 0         0 return;
339             }
340              
341 0         0 my $packet;
342 0 0       0 if ( _ip_is_ipv4( $self->{server} ) ) {
343             # SOCKS 4
344             $packet = pack ('CCn', 4, 1, $self->{port}) .
345 0   0     0 inet_aton($self->{server}) . ($self->{socks_id} || '') . (pack 'x');
346             }
347             else {
348             # SOCKS 4a
349             $packet = pack ('CCn', 4, 1, $self->{port}) .
350             inet_aton('0.0.0.1') . ($self->{socks_id} || '') . (pack 'x') .
351 0   0     0 $self->{server} . (pack 'x');
352             }
353              
354 0         0 $self->{socket}->put( $packet );
355 0         0 return;
356             }
357              
358             # ssl!
359 90 0 33     350 if ($GOT_SSL and $self->{usessl}) {
360 0         0 eval {
361 0         0 my ($ctx);
362              
363 0 0 0     0 if( $self->{sslctx} )
    0          
364             {
365 0         0 $ctx = $self->{sslctx};
366             }
367             elsif( $self->{sslkey} && $self->{sslcert} )
368             {
369 0         0 $ctx = SSLify_ContextCreate( $self->{sslkey}, $self->{sslcert} );
370             }
371             else
372             {
373 0         0 $ctx = undef;
374             }
375              
376 0         0 $socket = Client_SSLify($socket, undef, undef, $ctx);
377             };
378              
379 0 0       0 if ($@) {
380 0         0 chomp $@;
381 0         0 warn "Couldn't use an SSL socket: $@\n";
382 0         0 $self->{usessl} = 0;
383             }
384             }
385              
386 90 50       373 if ( $self->{compress} ) {
387 0         0 $self->_compress_uplink(1);
388 0         0 $self->_compress_downlink(1);
389             }
390              
391             # Create a new ReadWrite wheel for the connected socket.
392             $self->{socket} = POE::Wheel::ReadWrite->new(
393             Handle => $socket,
394             Driver => POE::Driver::SysRW->new(),
395             InputFilter => $self->{srv_filter},
396             OutputFilter => $self->{out_filter},
397 90         632 InputEvent => '_parseline',
398             ErrorEvent => '_sock_down',
399             );
400              
401 90 50       32793 if ($self->{socket}) {
402 90         300 $self->{connected} = 1;
403             }
404             else {
405 0         0 $self->send_event(irc_socketerr => "Couldn't create ReadWrite wheel for IRC socket");
406 0         0 return;
407             }
408              
409             # Post a 'irc_connected' event to each session that cares
410 90         468 $self->send_event(irc_connected => $self->{server} );
411              
412             # CONNECT if we're using a proxy
413 90 50       12496 if ($self->{proxy}) {
414             # The original proxy code, AFAIK, did not actually work
415             # with an HTTP proxy.
416             $self->call(
417             'sl_login',
418 0         0 'CONNECT ' . $self->{server} . ':' . $self->{port} . " HTTP/1.0\n\n",
419             );
420              
421             # KLUDGE: Also, the original proxy code assumes the connection
422             # is instantaneous Since this is not always the case, mess with
423             # the queueing so that the sent text is delayed...
424 0         0 $self->{send_time} = time() + 10;
425             }
426              
427 90         415 $kernel->yield('_send_login');
428 90         7512 return;
429             }
430              
431             sub _socks_proxy_response {
432 0     0   0 my ($kernel, $self, $session, $input) = @_[KERNEL, OBJECT, SESSION, ARG0];
433              
434 0 0       0 if (length $input != 8) {
435 0         0 $self->send_event(
436             'irc_socks_failed',
437             'Mangled response from SOCKS proxy',
438             $input,
439             );
440 0         0 $self->disconnect();
441 0         0 return;
442             }
443              
444 0         0 my @resp = unpack 'CCnN', $input;
445 0 0 0     0 if (@resp != 4 || $resp[0] ne '0' || $resp[1] !~ /^(?:90|91|92|93)$/) {
      0        
446 0         0 $self->send_event(
447             'irc_socks_failed',
448             'Mangled response from SOCKS proxy',
449             $input,
450             );
451 0         0 $self->disconnect();
452 0         0 return;
453             }
454              
455 0 0       0 if ( $resp[1] eq '90' ) {
456 0         0 $kernel->call($session => '_socks_proxy_connect');
457 0         0 $self->{connected} = 1;
458 0         0 $self->send_event( 'irc_connected', $self->{server} );
459 0         0 $kernel->yield('_send_login');
460             }
461             else {
462             $self->send_event(
463             'irc_socks_rejected',
464             $resp[1],
465             $self->{socks_proxy},
466             $self->{socks_port},
467             $self->{socks_id},
468 0         0 );
469 0         0 $self->disconnect();
470             }
471              
472 0         0 return;
473             }
474              
475             sub _socks_proxy_connect {
476 0     0   0 my ($kernel, $self) = @_[KERNEL, OBJECT];
477 0         0 $self->{socket}->event( InputEvent => '_parseline' );
478 0         0 $self->{socket}->set_input_filter( $self->{srv_filter} );
479 0         0 $self->{socket}->set_output_filter( $self->{out_filter} );
480 0         0 return;
481             }
482              
483             sub _send_login {
484 90     90   25109 my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];
485              
486             # Now that we're connected, attempt to log into the server.
487              
488             # for servers which support CAP, it's customary to start with that
489 90         473 $kernel->call($session, 'sl_login', 'CAP REQ :identify-msg');
490 90         846 $kernel->call($session, 'sl_login', 'CAP REQ :multi-prefix');
491 90         781 $kernel->call($session, 'sl_login', 'CAP LS');
492 90         721 $kernel->call($session, 'sl_login', 'CAP END');
493              
494             # If we were told to use WEBIRC to spoof our host/IP, do so:
495 90 50       880 if (defined $self->{webirc}) {
496             $kernel->call($session => sl_login => 'WEBIRC '
497 0         0 . join " ", @{$self->{webirc}}{qw(pass user ip host)}
  0         0  
498             );
499             }
500              
501 90 100       378 if (defined $self->{password}) {
502 1         14 $kernel->call($session => sl_login => 'PASS ' . $self->{password});
503             }
504 90         624 $kernel->call($session => sl_login => 'NICK ' . $self->{nick});
505             $kernel->call(
506             $session,
507             'sl_login',
508             'USER ' .
509             join(' ', $self->{username},
510             (defined $self->{bitmode} ? $self->{bitmode} : 8),
511             '*',
512             ':' . $self->{ircname}
513 90 50       1454 ),
514             );
515              
516             # If we have queued data waiting, its flush loop has stopped
517             # while we were disconnected. Start that up again.
518 90         807 $kernel->delay(sl_delayed => 0);
519              
520 90         14902 return;
521             }
522              
523             # Set up the component's IRC session.
524             sub syndicator_started {
525 115     115 1 209139 my ($kernel, $session, $sender, $self, $alias)
526             = @_[KERNEL, SESSION, SENDER, OBJECT, ARG0, ARG1 .. $#_];
527              
528             # Send queue is used to hold pending lines so we don't flood off.
529             # The count is used to track the number of lines sent at any time.
530 115         398 $self->{send_queue} = [ ];
531 115         503 $self->{send_time} = 0;
532              
533 115         1774 $self->{ircd_filter} = POE::Filter::IRCD->new(debug => $self->{debug});
534 115         4397 $self->{ircd_compat} = POE::Filter::IRC::Compat->new(debug => $self->{debug});
535              
536             my $srv_filters = [
537             POE::Filter::Line->new(
538             InputRegexp => '\015?\012',
539             OutputLiteral => '\015\012',
540             ),
541             $self->{ircd_filter},
542             $self->{ircd_compat},
543 115         1344 ];
544              
545 115         9173 $self->{srv_filter} = POE::Filter::Stackable->new(Filters => $srv_filters);
546 115         2767 $self->{out_filter} = POE::Filter::Stackable->new(Filters => [
547             POE::Filter::Line->new( OutputLiteral => "\015\012" ),
548             ]);
549              
550             # Plugin 'irc_whois' and 'irc_whowas' support
551 115         6799 $self->plugin_add('Whois_' . $self->session_id(),
552             POE::Component::IRC::Plugin::Whois->new()
553             );
554              
555 115         24189 $self->{isupport} = POE::Component::IRC::Plugin::ISupport->new();
556 115         516 $self->plugin_add('ISupport_' . $self->session_id(), $self->{isupport});
557 115         15810 $self->{dcc} = POE::Component::IRC::Plugin::DCC->new();
558 115         554 $self->plugin_add('DCC_' . $self->session_id(), $self->{dcc});
559              
560 115         14359 return 1;
561             }
562              
563             # The handler for commands which have N arguments, separated by commas.
564             sub commasep {
565 9     9 0 2096 my ($kernel, $self, $state, @args) = @_[KERNEL, OBJECT, STATE, ARG0 .. $#_];
566 9         22 my $args;
567              
568 9 50 66     125 if ($state eq 'whois' and @args > 1 ) {
    50 66        
569 0         0 $args = shift @args;
570 0         0 $args .= ' ' . join ',', @args;
571             }
572             elsif ( $state eq 'part' and @args > 1 ) {
573 0 0       0 my $chantypes = join('', @{ $self->isupport('CHANTYPES') || ['#', '&']});
  0         0  
574 0         0 my $message;
575 0 0 0     0 if ($args[-1] =~ / +/ || $args[-1] !~ /^[$chantypes]/) {
576 0         0 $message = pop @args;
577             }
578 0         0 $args = join(',', @args);
579 0 0       0 $args .= " :$message" if defined $message;
580             }
581             else {
582 9         38 $args = join ',', @args;
583             }
584              
585 9         35 my $pri = $self->{IRC_CMDS}->{$state}->[CMD_PRI];
586 9         27 $state = uc $state;
587 9 50       38 $state .= " $args" if defined $args;
588 9         66 $kernel->yield(sl_prioritized => $pri, $state );
589              
590 9         898 return;
591             }
592              
593             # Get variables in order for openning a connection
594             sub connect {
595 91     91 1 5209197 my ($kernel, $self, $session, $sender, $args)
596             = @_[KERNEL, OBJECT, SESSION, SENDER, ARG0];
597              
598 91 100       410 if ($args) {
599 90         214 my %arg;
600 90 50       376 %arg = @{ $args } if ref $args eq 'ARRAY';
  0         0  
601 90 50       344 %arg = %{ $args } if ref $args eq 'HASH';
  90         680  
602 90         872 $arg{ lc $_ } = delete $arg{$_} for keys %arg;
603 90         411 $self->_configure( \%arg );
604             }
605              
606 91 50 33     975 if ( $self->{resolver} && $self->{res_addresses}
      33        
607 0         0 && @{ $self->{res_addresses} } ) {
608 0         0 push @{ $self->{res_addresses} }, $self->{server};
  0         0  
609 0         0 $self->{resolved_server} = shift @{ $self->{res_addresses} };
  0         0  
610             }
611              
612             # try and use non-blocking resolver if needed
613 91 50 33     872 if ( $self->{resolver} && !_ip_get_version( $self->{server} )
      33        
614             && !$self->{nodns} ) {
615             $kernel->yield(
616             '_resolve_addresses',
617             $self->{server},
618 0 0 0     0 ( $self->{useipv6} && $GOT_SOCKET6 ? 'AAAA' : 'A' ),
619             );
620             }
621             else {
622 91         570 $kernel->yield('_do_connect');
623             }
624              
625 91         9702 $self->{INFO}{RealNick} = $self->{nick};
626 91         361 return;
627             }
628              
629             sub _resolve_addresses {
630 0     0   0 my ($kernel, $self, $hostname, $type) = @_[KERNEL, OBJECT, ARG0 .. ARG1];
631              
632             my $response = $self->{resolver}->resolve(
633 0         0 event => '_got_dns_response',
634             host => $hostname,
635             type => $type,
636             context => { },
637             );
638              
639 0 0       0 $kernel->yield(_got_dns_response => $response) if $response;
640 0         0 return;
641             }
642              
643             # open the connection
644             sub _do_connect {
645 91     91   23465 my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];
646 91         240 my $domain = AF_INET;
647              
648             # Disconnect if we're already logged into a server.
649 91 50       422 $kernel->call($session => 'quit') if $self->{socket};
650              
651 91 50 33     431 if ($self->{socks_proxy} && !$self->{socks_port}) {
652 0         0 $self->{socks_port} = 1080;
653             }
654              
655 91         302 for my $address (qw(socks_proxy proxy server resolved_server use_localaddr)) {
656 455 50 66     1536 next if !$self->{$address} || !_ip_is_ipv6( $self->{$address} );
657 0 0       0 if (!$GOT_SOCKET6) {
658 0         0 warn "IPv6 address specified for '$address' but Socket6 not found\n";
659 0         0 return;
660             }
661 0         0 $domain = AF_INET6;
662             }
663              
664             $self->{socketfactory} = POE::Wheel::SocketFactory->new(
665             SocketDomain => $domain,
666             SocketType => SOCK_STREAM,
667             SocketProtocol => 'tcp',
668             RemoteAddress => $self->{socks_proxy} || $self->{proxy} || $self->{resolved_server} || $self->{server},
669             RemotePort => $self->{socks_port} || $self->{proxyport} || $self->{port},
670             SuccessEvent => '_sock_up',
671             FailureEvent => '_sock_failed',
672 91 50 33     2814 ($self->{use_localaddr} ? (BindAddress => $self->{use_localaddr}) : ()),
      33        
673             );
674              
675 91         59537 return;
676             }
677              
678             # got response from POE::Component::Client::DNS
679             sub _got_dns_response {
680 0     0   0 my ($kernel, $self, $response) = @_[KERNEL, OBJECT, ARG0];
681              
682 0         0 my $type = uc $response->{type};
683 0         0 my $net_dns_packet = $response->{response};
684 0         0 my $net_dns_errorstring = $response->{error};
685 0         0 $self->{res_addresses} = [ ];
686              
687 0 0       0 if (!defined $net_dns_packet) {
688 0         0 $self->send_event(irc_socketerr => $net_dns_errorstring );
689 0         0 return;
690             }
691              
692 0         0 my @net_dns_answers = $net_dns_packet->answer;
693              
694 0         0 for my $net_dns_answer (@net_dns_answers) {
695 0 0       0 next if $net_dns_answer->type !~ /^A/;
696 0         0 push @{ $self->{res_addresses} }, $net_dns_answer->rdatastr;
  0         0  
697             }
698              
699 0 0 0     0 if ( !@{ $self->{res_addresses} } && $type eq 'AAAA') {
  0         0  
700 0         0 $kernel->yield(_resolve_addresses => $self->{server}, 'A');
701 0         0 return;
702             }
703              
704 0 0       0 if ( !@{ $self->{res_addresses} } ) {
  0         0  
705 0         0 $self->send_event(irc_socketerr => 'Unable to resolve ' . $self->{server});
706 0         0 return;
707             }
708              
709 0 0       0 if ( my $address = shift @{ $self->{res_addresses} } ) {
  0         0  
710 0         0 $self->{resolved_server} = $address;
711 0         0 $kernel->yield('_do_connect');
712 0         0 return;
713             }
714              
715 0         0 $self->send_event(irc_socketerr => 'Unable to resolve ' . $self->{server});
716 0         0 return;
717             }
718              
719             # Send a CTCP query or reply, with the same syntax as a PRIVMSG event.
720             sub ctcp {
721 27     27 1 9908 my ($kernel, $state, $self, $to) = @_[KERNEL, STATE, OBJECT, ARG0];
722 27         119 my $message = join ' ', @_[ARG1 .. $#_];
723              
724 27 50 33     162 if (!defined $to || !defined $message) {
725 0         0 warn "The '$state' event requires two arguments\n";
726 0         0 return;
727             }
728              
729             # CTCP-quote the message text.
730 27         52 ($message) = @{$self->{ircd_compat}->put([ $message ])};
  27         575  
731              
732             # Should we send this as a CTCP request or reply?
733 27 100       99 $state = $state eq 'ctcpreply' ? 'notice' : 'privmsg';
734              
735 27         134 $kernel->yield($state, $to, $message);
736 27         2034 return;
737             }
738              
739             # The way /notify is implemented in IRC clients.
740             sub ison {
741 0     0 1 0 my ($kernel, @nicks) = @_[KERNEL, ARG0 .. $#_];
742 0         0 my $tmp = 'ISON';
743              
744 0 0       0 if (!@nicks) {
745 0         0 warn "The 'ison' event requires one or more nicknames\n";
746 0         0 return;
747             }
748              
749             # We can pass as many nicks as we want, as long as it's shorter than
750             # the maximum command length (510). If the list we get is too long,
751             # w'll break it into multiple ISON commands.
752 0         0 while (@nicks) {
753 0         0 my $nick = shift @nicks;
754 0 0       0 if (length($tmp) + length($nick) >= 509) {
755 0         0 $kernel->yield(sl_high => $tmp);
756 0         0 $tmp = 'ISON';
757             }
758 0         0 $tmp .= " $nick";
759             }
760              
761 0         0 $kernel->yield(sl_high => $tmp);
762 0         0 return;
763             }
764              
765             # Tell the IRC server to forcibly remove a user from a channel.
766             sub kick {
767 6     6 1 1929 my ($kernel, $chan, $nick) = @_[KERNEL, ARG0, ARG1];
768 6         30 my $message = join '', @_[ARG2 .. $#_];
769              
770 6 50 33     82 if (!defined $chan || !defined $nick) {
771 0         0 warn "The 'kick' event requires at least two arguments\n";
772 0         0 return;
773             }
774              
775 6 50       37 $nick .= " :$message" if defined $message;
776 6         46 $kernel->yield(sl_high => "KICK $chan $nick");
777 6         513 return;
778             }
779              
780             # Tell the IRC server to forcibly remove a user from a channel. Freenode extension
781             sub remove {
782 0     0 1 0 my ($kernel, $chan, $nick) = @_[KERNEL, ARG0, ARG1];
783 0         0 my $message = join '', @_[ARG2 .. $#_];
784              
785 0 0 0     0 if (!defined $chan || !defined $nick) {
786 0         0 warn "The 'remove' event requires at least two arguments\n";
787 0         0 return;
788             }
789              
790 0 0       0 $nick .= " :$message" if defined $message;
791 0         0 $kernel->yield(sl_high => "REMOVE $chan $nick");
792 0         0 return;
793             }
794              
795             # Interact with NickServ
796             sub nickserv {
797 0     0 1 0 my ($kernel, $self, $state) = @_[KERNEL, OBJECT, STATE];
798 0         0 my $args = join ' ', @_[ARG0 .. $#_];
799              
800 0         0 my $command = 'NICKSERV';
801 0         0 my $version = $self->server_version();
802 0 0 0     0 $command = 'NS' if defined $version && $version =~ /ratbox/i;
803 0 0       0 $command .= " $args" if defined $args;
804              
805 0         0 $kernel->yield(sl_high => $command);
806 0         0 return;
807             }
808              
809             # Set up a new IRC component. Deprecated.
810             sub new {
811 0     0 1 0 my ($package, $alias) = splice @_, 0, 2;
812 0 0       0 croak "$package options should be an even-sized list" if @_ & 1;
813 0         0 my %options = @_;
814              
815 0 0       0 if (!defined $alias) {
816 0         0 croak 'Not enough arguments to POE::Component::IRC::new()';
817             }
818              
819 0         0 carp "Use of ${package}->new() is deprecated, please use spawn()";
820              
821 0         0 my $self = $package->spawn ( alias => $alias, options => \%options );
822 0         0 return $self;
823             }
824              
825             # Set up a new IRC component. New interface.
826             sub spawn {
827 115     115 1 22754 my ($package) = shift;
828 115 50       593 croak "$package requires an even number of arguments" if @_ & 1;
829 115         591 my %params = @_;
830              
831 115         964 $params{ lc $_ } = delete $params{$_} for keys %params;
832 115 50       645 delete $params{options} if ref $params{options} ne 'HASH';
833              
834 115         373 my $self = bless { }, $package;
835 115         695 $self->_create();
836              
837 115 50       523 if ($ENV{POCOIRC_DEBUG}) {
838 0         0 $params{debug} = 1;
839 0         0 $params{plugin_debug} = 1;
840             }
841              
842 115         298 my $options = delete $params{options};
843 115         265 my $alias = delete $params{alias};
844 115         263 my $plugin_debug = delete $params{plugin_debug};
845              
846             $self->_syndicator_init(
847             prefix => 'irc_',
848             reg_prefix => 'PCI_',
849             types => [SERVER => 'S', USER => 'U'],
850             alias => $alias,
851             register_signal => 'POCOIRC_REGISTER',
852             shutdown_signal => 'POCOIRC_SHUTDOWN',
853             object_states => [
854             $self => delete $self->{OBJECT_STATES_HASHREF},
855             $self => delete $self->{OBJECT_STATES_ARRAYREF},
856 115 100       2465 ],
    50          
857             ($plugin_debug ? (debug => 1) : () ),
858             (ref $options eq 'HASH' ? ( options => $options ) : ()),
859             );
860              
861 115         17771 $params{spawned} = 1;
862 115         684 $self->_configure(\%params);
863              
864 115 100 33     1343 if (!$params{nodns} && $GOT_CLIENT_DNS && !$self->{resolver}) {
      66        
865 114         688 $self->{resolver} = POE::Component::Client::DNS->spawn(
866             Alias => 'resolver' . $self->session_id()
867             );
868 114         134996 $self->{mydns} = 1;
869             }
870              
871 115         507 return $self;
872             }
873              
874             # The handler for all IRC commands that take no arguments.
875             sub noargs {
876 0     0 0 0 my ($kernel, $state, $arg) = @_[KERNEL, STATE, ARG0];
877 0         0 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
878              
879 0 0       0 if (defined $arg) {
880 0         0 warn "The '$state' event takes no arguments\n";
881 0         0 return;
882             }
883              
884 0         0 $state = uc $state;
885 0         0 $kernel->yield(sl_prioritized => $pri, $state);
886 0         0 return;
887             }
888              
889             # The handler for commands that take one required and two optional arguments.
890             sub oneandtwoopt {
891 0     0 0 0 my ($kernel, $state) = @_[KERNEL, STATE];
892 0         0 my $arg = join '', @_[ARG0 .. $#_];
893 0         0 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
894              
895 0 0       0 $state = 'connect' if $state eq 'sconnect';
896 0         0 $state = uc $state;
897 0 0       0 if (defined $arg) {
898 0 0       0 $arg = ':' . $arg if $arg =~ /\x20/;
899 0         0 $state .= " $arg";
900             }
901              
902 0         0 $kernel->yield(sl_prioritized => $pri, $state);
903 0         0 return;
904             }
905              
906             # The handler for commands that take at least one optional argument.
907             sub oneoptarg {
908 153     153 0 80283 my ($kernel, $state) = @_[KERNEL, STATE];
909 153         650 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
910 153         444 $state = uc $state;
911              
912 153 100       556 if (defined $_[ARG0]) {
913 53         211 my $arg = join '', @_[ARG0 .. $#_];
914 53 100       240 $arg = ':' . $arg if $arg =~ /\x20/;
915 53         162 $state .= " $arg";
916             }
917              
918 153         651 $kernel->yield(sl_prioritized => $pri, $state);
919 153         14710 return;
920             }
921              
922             # The handler for commands which take one required and one optional argument.
923             sub oneortwo {
924 87     87 0 7012599 my ($kernel, $state, $one) = @_[KERNEL, STATE, ARG0];
925 87         394 my $two = join '', @_[ARG1 .. $#_];
926 87         326 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
927              
928 87 50       395 if (!defined $one) {
929 0         0 warn "The '$state' event requires at least one argument\n";
930 0         0 return;
931             }
932              
933 87         345 $state = uc( $state ) . " $one";
934 87 50       350 $state .= " $two" if defined $two;
935 87         385 $kernel->yield(sl_prioritized => $pri, $state);
936 87         8414 return;
937             }
938              
939             # Handler for commands that take exactly one argument.
940             sub onlyonearg {
941 9     9 0 942718 my ($kernel, $state) = @_[KERNEL, STATE];
942 9         57 my $arg = join '', @_[ARG0 .. $#_];
943 9         45 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
944              
945 9 50       68 if (!defined $arg) {
946 0         0 warn "The '$state' event requires one argument\n";
947 0         0 return;
948             }
949              
950 9         70 $state = uc $state;
951 9 50       53 $arg = ':' . $arg if $arg =~ /\x20/;
952 9         46 $state .= " $arg";
953 9         54 $kernel->yield(sl_prioritized => $pri, $state);
954 9         970 return;
955             }
956              
957             # Handler for commands that take exactly two arguments.
958             sub onlytwoargs {
959 1     1 0 323 my ($kernel, $state, $one) = @_[KERNEL, STATE, ARG0];
960 1         6 my ($two) = join '', @_[ARG1 .. $#_];
961 1         4 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
962              
963 1 50 33     16 if (!defined $one || !defined $two) {
964 0         0 warn "The '$state' event requires two arguments\n";
965 0         0 return;
966             }
967              
968 1         4 $state = uc $state;
969 1 50       5 $two = ':' . $two if $two =~ /\x20/;
970 1         4 $state .= " $one $two";
971 1         5 $kernel->yield(sl_prioritized => $pri, $state);
972 1         77 return;
973             }
974              
975             # Handler for privmsg or notice events.
976             sub privandnotice {
977 93     93 0 26018 my ($kernel, $state, $to, $msg) = @_[KERNEL, STATE, ARG0, ARG1];
978 93         299 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
979              
980 93         206 $state =~ s/privmsglo/privmsg/;
981 93         179 $state =~ s/privmsghi/privmsg/;
982 93         151 $state =~ s/noticelo/notice/;
983 93         184 $state =~ s/noticehi/notice/;
984              
985 93 50 33     557 if (!defined $to || !defined $msg) {
986 0         0 warn "The '$state' event requires two arguments\n";
987 0         0 return;
988             }
989              
990 93 100       303 $to = join ',', @$to if ref $to eq 'ARRAY';
991 93         253 $state = uc $state;
992              
993 93         585 $kernel->yield(sl_prioritized => $pri, "$state $to :$msg");
994 93         7828 return;
995             }
996              
997             # Tell the IRC session to go away.
998             sub shutdown {
999 116     116 1 154110 my ($kernel, $self, $sender, $session) = @_[KERNEL, OBJECT, SENDER, SESSION];
1000 116 100       581 return if $self->{_shutdown};
1001 115         459 $self->{_shutdown} = $sender->ID();
1002              
1003 115 100       916 if ($self->logged_in()) {
    50          
1004 1         4 my ($msg, $timeout) = @_[ARG0, ARG1];
1005 1 50       6 $msg = '' if !defined $msg;
1006 1 50       4 $timeout = 5 if !defined $timeout;
1007 1 50       4 $msg = ":$msg" if $msg =~ /\x20/;
1008 1         3 my $cmd = "QUIT $msg";
1009 1         5 $kernel->call($session => sl_high => $cmd);
1010 1         10 $kernel->delay('_quit_timeout', $timeout);
1011 1         101 $self->{_waiting} = 1;
1012             }
1013             elsif ($self->connected()) {
1014 0         0 $self->disconnect();
1015             }
1016             else {
1017 114         470 $self->_shutdown();
1018             }
1019              
1020 115         536 return;
1021             }
1022              
1023             sub _quit_timeout {
1024 0     0   0 my ($self) = $_[OBJECT];
1025 0         0 $self->disconnect();
1026 0         0 return;
1027             }
1028              
1029             sub _shutdown {
1030 115     115   298 my ($self) = @_;
1031              
1032 115         977 $self->_syndicator_destroy($self->{_shutdown});
1033 115         25030 delete $self->{$_} for qw(socketfactory dcc wheelmap);
1034 115 100 66     1566 $self->{resolver}->shutdown() if $self->{resolver} && $self->{mydns};
1035 115         28402 return;
1036             }
1037              
1038             # Send a line of login-priority IRC output. These are things which
1039             # must go first.
1040             sub sl_login {
1041 541     541 0 20383 my ($kernel, $self) = @_[KERNEL, OBJECT];
1042 541         1702 my $arg = join ' ', @_[ARG0 .. $#_];
1043 541         1642 $kernel->yield(sl_prioritized => PRI_LOGIN, $arg );
1044 541         47847 return;
1045             }
1046              
1047             # Send a line of high-priority IRC output. Things like channel/user
1048             # modes, kick messages, and whatever.
1049             sub sl_high {
1050 7     7 0 808 my ($kernel, $self) = @_[KERNEL, OBJECT];
1051 7         41 my $arg = join ' ', @_[ARG0 .. $#_];
1052 7         37 $kernel->yield(sl_prioritized => PRI_HIGH, $arg );
1053 7         517 return;
1054             }
1055              
1056             # Send a line of normal-priority IRC output to the server. PRIVMSG
1057             # and other random chatter. Uses sl() for compatibility with existing
1058             # code.
1059             sub sl {
1060 5     5 0 1728 my ($kernel, $self) = @_[KERNEL, OBJECT];
1061 5         22 my $arg = join ' ', @_[ARG0 .. $#_];
1062 5         18 $kernel->yield(sl_prioritized => PRI_NORMAL, $arg );
1063 5         447 return;
1064             }
1065              
1066             # Prioritized sl(). This keeps the queue ordered by priority, low to
1067             # high in the UNIX tradition. It also throttles transmission
1068             # following the hybrid ircd's algorithm, so you can't accidentally
1069             # flood yourself off. Thanks to Raistlin for explaining how ircd
1070             # throttles messages.
1071             sub sl_prioritized {
1072 1032     1032 0 164989 my ($kernel, $self, $priority, @args) = @_[KERNEL, OBJECT, ARG0, ARG1];
1073              
1074 1032 50       6745 if (my ($event) = $args[0] =~ /^(\w+)/ ) {
1075             # Let the plugin system process this
1076 1032 50       4328 return 1 if $self->send_user_event($event, \@args) == PCI_EAT_ALL;
1077             }
1078             else {
1079 0         0 warn "Unable to extract the event name from '$args[0]'\n";
1080             }
1081              
1082 1032         159014 my $msg = $args[0];
1083 1032         2079 my $now = time();
1084 1032 100       3248 $self->{send_time} = $now if $self->{send_time} < $now;
1085              
1086             # if we find a newline in the message, take that to be the end of it
1087 1032         2848 $msg =~ s/[\015\012].*//s;
1088              
1089 1032 50       3535 if (bytes::length($msg) > $self->{msg_length} - bytes::length($self->nick_name())) {
1090 0         0 $msg = bytes::substr($msg, 0, $self->{msg_length} - bytes::length($self->nick_name()));
1091             }
1092              
1093 1032 50 66     9264 if (!$self->{flood} && @{ $self->{send_queue} }) {
  7 100 100     58  
      100        
1094 0         0 my $i = @{ $self->{send_queue} };
  0         0  
1095 0   0     0 $i-- while ($i && $priority < $self->{send_queue}->[$i-1]->[MSG_PRI]);
1096 0         0 splice( @{ $self->{send_queue} }, $i, 0, [ $priority, $msg ] );
  0         0  
1097             }
1098             elsif ( !$self->{flood} && $self->{send_time} - $now >= 10
1099             || !defined $self->{socket} ) {
1100 3         7 push( @{$self->{send_queue}}, [ $priority, $msg ] );
  3         16  
1101 3         23 $kernel->delay( sl_delayed => $self->{send_time} - $now - 10 );
1102             }
1103             else {
1104 1029 50       2485 warn ">>> $msg\n" if $self->{debug};
1105 1029 100       2410 $self->send_event(irc_raw_out => $msg) if $self->{raw};
1106 1029         7057 $self->{send_time} += 2 + length($msg) / 120;
1107 1029         3750 $self->{socket}->put($msg);
1108             }
1109              
1110 1032         73414 return;
1111             }
1112              
1113             # Send delayed lines to the ircd. We manage a virtual "send time"
1114             # that progresses into the future based on hybrid ircd's rules every
1115             # time a message is sent. Once we find it ten or more seconds into
1116             # the future, we wait for the realtime clock to catch up.
1117             sub sl_delayed {
1118 93     93 0 2700396 my ($kernel, $self) = @_[KERNEL, OBJECT];
1119              
1120 93 100       470 return if !defined $self->{socket};
1121              
1122 92         294 my $now = time();
1123 92 50       366 $self->{send_time} = $now if $self->{send_time} < $now;
1124              
1125 92   100     230 while (@{ $self->{send_queue} } && ($self->{send_time} - $now < 10)) {
  94         958  
1126 2         9 my $arg = (shift @{$self->{send_queue}})->[MSG_TEXT];
  2         14  
1127 2 50       27 warn ">>> $arg\n" if $self->{debug};
1128 2 50       14 $self->send_event(irc_raw_out => $arg) if $self->{raw};
1129 2         14 $self->{send_time} += 2 + length($arg) / 120;
1130 2         25 $self->{socket}->put($arg);
1131             }
1132              
1133 92 100       549 if (@{ $self->{send_queue} }) {
  92         303  
1134 1         10 $kernel->delay( sl_delayed => $self->{send_time} - $now - 10 );
1135             }
1136              
1137 92         463 return;
1138             }
1139              
1140             # The handler for commands which have N arguments, separated by spaces.
1141             sub spacesep {
1142 121     121 0 997292 my ($kernel, $state) = @_[KERNEL, STATE];
1143 121         472 my $args = join ' ', @_[ARG0 .. $#_];
1144 121         376 my $pri = $_[OBJECT]->{IRC_CMDS}->{$state}->[CMD_PRI];
1145              
1146 121         291 $state = uc $state;
1147 121 50       495 $state .= " $args" if defined $args;
1148 121         429 $kernel->yield(sl_prioritized => $pri, $state );
1149 121         10810 return;
1150             }
1151              
1152             # Set or query the current topic on a channel.
1153             sub topic {
1154 6     6 1 780 my ($kernel, $chan, @args) = @_[KERNEL, ARG0..$#_];
1155 6         17 my $topic;
1156 6 100       31 $topic = join '', @args if @args;
1157              
1158 6 100       30 if (defined $topic) {
1159 5         15 $chan .= " :";
1160 5 50       34 $chan .= $topic if length $topic;
1161             }
1162              
1163 6         65 $kernel->yield(sl_prioritized => PRI_NORMAL, "TOPIC $chan");
1164 6         495 return;
1165             }
1166              
1167             # Asks the IRC server for some random information about particular nicks.
1168             sub userhost {
1169 0     0 1 0 my ($kernel, @nicks) = @_[KERNEL, ARG0 .. $#_];
1170              
1171 0 0       0 if (!@nicks) {
1172 0         0 warn "The 'userhost' event requires at least one nickname\n";
1173 0         0 return;
1174             }
1175              
1176             # According to the RFC, you can only send 5 nicks at a time.
1177 0         0 while (@nicks) {
1178 0         0 $kernel->yield(
1179             'sl_prioritized',
1180             PRI_HIGH,
1181             'USERHOST ' . join(' ', splice(@nicks, 0, 5)),
1182             );
1183             }
1184              
1185 0         0 return;
1186             }
1187              
1188             # Non-event methods
1189              
1190             sub server {
1191 0     0 1 0 my ($self) = @_;
1192 0         0 return $self->{server};
1193             }
1194              
1195             sub port {
1196 0     0 1 0 my ($self) = @_;
1197 0         0 return $self->{port};
1198             }
1199              
1200             sub server_name {
1201 7     7 1 3771 my ($self) = @_;
1202 7         47 return $self->{INFO}{ServerName};
1203             }
1204              
1205             sub server_version {
1206 0     0 1 0 my ($self) = @_;
1207 0         0 return $self->{INFO}{ServerVersion};
1208             }
1209              
1210             sub localaddr {
1211 8     8 1 29 my ($self) = @_;
1212 8         34 return $self->{localaddr};
1213             }
1214              
1215             sub nick_name {
1216 1767     1767 1 100358 my ($self) = @_;
1217 1767         6318 return $self->{INFO}{RealNick};
1218             }
1219              
1220             sub send_queue {
1221 0     0 1 0 my ($self) = @_;
1222              
1223 0 0 0     0 if (defined $self->{send_queue} && ref $self->{send_queue} eq 'ARRAY' ) {
1224 0         0 return scalar @{ $self->{send_queue} };
  0         0  
1225             }
1226 0         0 return;
1227             }
1228              
1229             sub raw_events {
1230 4     4 1 13 my ($self, $value) = @_;
1231 4 50       40 return $self->{raw} if !defined $value;
1232 4         24 $self->{raw} = $value;
1233 4         14 return;
1234             }
1235              
1236             sub connected {
1237 118     118 1 306 my ($self) = @_;
1238 118         416 return $self->{connected};
1239             }
1240              
1241             sub logged_in {
1242 120     120 1 562 my ($self) = @_;
1243 120 100       496 return 1 if $self->{INFO}{LoggedIn};
1244 117         721 return;
1245             }
1246              
1247             sub _compress_uplink {
1248 90     90   398 my ($self, $value) = @_;
1249              
1250 90 50       431 return if !$GOT_ZLIB;
1251 0 0       0 return $self->{uplink} if !defined $value;
1252              
1253 0 0       0 if ($value) {
1254 0 0       0 $self->{out_filter}->unshift( POE::Filter::Zlib::Stream->new() ) if !$self->{uplink};
1255 0         0 $self->{uplink} = 1;
1256             }
1257             else {
1258 0 0       0 $self->{out_filter}->shift() if $self->{uplink};
1259 0         0 $self->{uplink} = 0;
1260             }
1261              
1262 0         0 return $self->{uplink};
1263             }
1264              
1265             sub _compress_downlink {
1266 90     90   250 my ($self, $value) = @_;
1267              
1268 90 50       316 return if !$GOT_ZLIB;
1269 0 0       0 return $self->{downlink} if !defined $value;
1270              
1271 0 0       0 if ($value) {
1272 0 0       0 $self->{srv_filter}->unshift( POE::Filter::Zlib::Stream->new() ) if !$self->{downlink};
1273 0         0 $self->{downlink} = 1;
1274             }
1275             else {
1276 0 0       0 $self->{srv_filter}->shift() if $self->{uplink};
1277 0         0 $self->{downlink} = 0;
1278             }
1279              
1280 0         0 return $self->{downlink};
1281             }
1282              
1283             sub S_001 {
1284 90     90 0 17375 my ($self, $irc) = splice @_, 0, 2;
1285 90         201 $self->{INFO}{ServerName} = ${ $_[0] };
  90         346  
1286 90         279 $self->{INFO}{LoggedIn} = 1;
1287 90         257 return PCI_EAT_NONE;
1288             }
1289              
1290             sub S_004 {
1291 90     90 0 24634 my ($self, $irc) = splice @_, 0, 2;
1292 90         218 my $args = ${ $_[2] };
  90         243  
1293 90         303 $self->{INFO}{ServerVersion} = $args->[1];
1294 90         253 return PCI_EAT_NONE;
1295             }
1296              
1297             sub S_error {
1298 89     89 0 36084 my ($self, $irc) = splice @_, 0, 2;
1299 89         520 $self->{INFO}{LoggedIn} = 0;
1300 89         324 return PCI_EAT_NONE;
1301             }
1302              
1303             sub S_disconnected {
1304 90     90 0 26687 my ($self, $irc) = splice @_, 0, 2;
1305 90         303 $self->{INFO}{LoggedIn} = 0;
1306              
1307 90 100       379 if ($self->{_waiting}) {
1308 1         5 $poe_kernel->delay('_quit_timeout');
1309 1         95 delete $self->{_waiting};
1310             }
1311              
1312 90 100       321 $self->_shutdown() if $self->{_shutdown};
1313 90         256 return PCI_EAT_NONE;
1314             }
1315              
1316             sub S_shutdown {
1317 115     115 0 206860 my ($self, $irc) = splice @_, 0, 2;
1318 115         518 $self->{INFO}{LoggedIn} = 0;
1319 115         354 return PCI_EAT_NONE;
1320             }
1321              
1322             # Automatically replies to a PING from the server. Do not confuse this
1323             # with CTCP PINGs, which are a wholly different animal that evolved
1324             # much later on the technological timeline.
1325             sub S_ping {
1326 0     0 0 0 my ($self, $irc) = splice @_, 0, 2;
1327 0         0 my $arg = ${ $_[0] };
  0         0  
1328 0         0 $irc->yield(sl_login => "PONG :$arg");
1329 0         0 return PCI_EAT_NONE;
1330             }
1331              
1332             # NICK messages for the purposes of determining our current nickname
1333             sub S_nick {
1334 10     10 0 2194 my ($self, $irc) = splice @_, 0, 2;
1335 10         25 my $nick = ( split /!/, ${ $_[0] } )[0];
  10         45  
1336 10         28 my $new = ${ $_[1] };
  10         21  
1337 10 100       52 $self->{INFO}{RealNick} = $new if ( $nick eq $self->{INFO}{RealNick} );
1338 10         34 return PCI_EAT_NONE;
1339             }
1340              
1341             # tell POE::Filter::IRC::Compat to handle IDENTIFY-MSG
1342             sub S_290 {
1343 0     0 0 0 my ($self, $irc) = splice @_, 0, 2;
1344 0         0 my $text = ${ $_[1] };
  0         0  
1345 0 0       0 $self->{ircd_compat}->identifymsg(1) if $text eq 'IDENTIFY-MSG';
1346 0         0 return PCI_EAT_NONE;
1347             }
1348              
1349             sub S_cap {
1350 3     3 0 1683 my ($self, $irc) = splice @_, 0, 2;
1351 3         10 my $cmd = ${ $_[0] };
  3         108  
1352              
1353 3 100       27 if ($cmd eq 'ACK') {
1354 1 50       5 my $list = ${ $_[1] } eq '*' ? ${ $_[2] } : ${ $_[1] };
  1         7  
  0         0  
  1         5  
1355 1         7 my @enabled = split / /, $list;
1356              
1357 1 50       5 if (grep { $_ =~ /^=?identify-msg$/ } @enabled) {
  1         12  
1358 0         0 $self->{ircd_compat}->identifymsg(1);
1359             }
1360 1 50       5 if (grep { $_ =~ /^-identify-msg$/ } @enabled) {
  1         8  
1361 0         0 $self->{ircd_compat}->identifymsg(0);
1362             }
1363             }
1364 3         19 return PCI_EAT_NONE;
1365             }
1366              
1367             sub S_isupport {
1368 90     90 0 13933 my ($self, $irc) = splice @_, 0, 2;
1369 90         215 my $isupport = ${ $_[0] };
  90         286  
1370 90   50     553 $self->{ircd_compat}->chantypes( $isupport->isupport('CHANTYPES') || [ '#', '&' ] );
1371 90 50       362 $irc->yield(sl_login => 'CAPAB IDENTIFY-MSG') if $isupport->isupport('CAPAB');
1372 90 50       400 $irc->yield(sl_login => 'PROTOCTL NAMESX') if $isupport->isupport('NAMESX');
1373 90 50       299 $irc->yield(sl_login => 'PROTOCTL UHNAMES') if $isupport->isupport('UHNAMES');
1374 90         330 return PCI_EAT_NONE;
1375             }
1376              
1377             # accesses the ISupport plugin
1378             sub isupport {
1379 1667     1667 1 4557 my ($self, @args) = @_;
1380 1667         4922 return $self->{isupport}->isupport(@args);
1381             }
1382              
1383             sub isupport_dump_keys {
1384 0     0 1 0 return $_[0]->{isupport}->isupport_dump_keys();
1385             }
1386              
1387             sub resolver {
1388 2     2 1 1562 return $_[0]->{resolver};
1389             }
1390              
1391             sub _ip_get_version {
1392 91     91   329 my ($ip) = @_;
1393 91 50       378 return if !defined $ip;
1394              
1395             # If the address does not contain any ':', maybe it's IPv4
1396 91 50 33     700 return 4 if $ip !~ /:/ && _ip_is_ipv4($ip);
1397              
1398             # Is it IPv6 ?
1399 0 0       0 return 6 if _ip_is_ipv6($ip);
1400              
1401 0         0 return;
1402             }
1403              
1404             sub _ip_is_ipv4 {
1405 91     91   279 my ($ip) = @_;
1406 91 50       319 return if !defined $ip;
1407              
1408             # Check for invalid chars
1409 91 50       768 return if $ip !~ /^[\d\.]+$/;
1410 91 50       464 return if $ip =~ /^\./;
1411 91 50       406 return if $ip =~ /\.$/;
1412              
1413             # Single Numbers are considered to be IPv4
1414 91 50 33     593 return 1 if $ip =~ /^(\d+)$/ && $1 < 256;
1415              
1416             # Count quads
1417 91         448 my $n = ($ip =~ tr/\./\./);
1418              
1419             # IPv4 must have from 1 to 4 quads
1420 91 50 33     722 return if $n <= 0 || $n > 4;
1421              
1422             # Check for empty quads
1423 91 50       436 return if $ip =~ /\.\./;
1424              
1425 91         531 for my $quad (split /\./, $ip) {
1426             # Check for invalid quads
1427 364 50 33     1852 return if $quad < 0 || $quad >= 256;
1428             }
1429 91         926 return 1;
1430             }
1431              
1432             sub _ip_is_ipv6 {
1433 91     91   277 my ($ip) = @_;
1434 91 50       316 return if !defined $ip;
1435              
1436             # Count octets
1437 91         263 my $n = ($ip =~ tr/:/:/);
1438 91 50 33     679 return if ($n <= 0 || $n >= 8);
1439              
1440             # $k is a counter
1441 0           my $k;
1442              
1443 0           for my $octet (split /:/, $ip) {
1444 0           $k++;
1445              
1446             # Empty octet ?
1447 0 0         next if $octet eq '';
1448              
1449             # Normal v6 octet ?
1450 0 0         next if $octet =~ /^[a-f\d]{1,4}$/i;
1451              
1452             # Last octet - is it IPv4 ?
1453 0 0         if ($k == $n + 1) {
1454 0 0         next if (ip_is_ipv4($octet));
1455             }
1456              
1457 0           return;
1458             }
1459              
1460             # Does the IP address start with : ?
1461 0 0         return if $ip =~ m/^:[^:]/;
1462              
1463             # Does the IP address finish with : ?
1464 0 0         return if $ip =~ m/[^:]:$/;
1465              
1466             # Does the IP address have more than one '::' pattern ?
1467 0 0         return if $ip =~ s/:(?=:)//g > 1;
1468              
1469 0           return 1;
1470             }
1471              
1472             1;
1473              
1474             =encoding utf8
1475              
1476             =head1 NAME
1477              
1478             POE::Component::IRC - A fully event-driven IRC client module
1479              
1480             =head1 SYNOPSIS
1481              
1482             # A simple Rot13 'encryption' bot
1483              
1484             use strict;
1485             use warnings;
1486             use POE qw(Component::IRC);
1487              
1488             my $nickname = 'Flibble' . $$;
1489             my $ircname = 'Flibble the Sailor Bot';
1490             my $server = 'irc.perl.org';
1491              
1492             my @channels = ('#Blah', '#Foo', '#Bar');
1493              
1494             # We create a new PoCo-IRC object
1495             my $irc = POE::Component::IRC->spawn(
1496             nick => $nickname,
1497             ircname => $ircname,
1498             server => $server,
1499             ) or die "Oh noooo! $!";
1500              
1501             POE::Session->create(
1502             package_states => [
1503             main => [ qw(_default _start irc_001 irc_public) ],
1504             ],
1505             heap => { irc => $irc },
1506             );
1507              
1508             $poe_kernel->run();
1509              
1510             sub _start {
1511             my $heap = $_[HEAP];
1512              
1513             # retrieve our component's object from the heap where we stashed it
1514             my $irc = $heap->{irc};
1515              
1516             $irc->yield( register => 'all' );
1517             $irc->yield( connect => { } );
1518             return;
1519             }
1520              
1521             sub irc_001 {
1522             my $sender = $_[SENDER];
1523              
1524             # Since this is an irc_* event, we can get the component's object by
1525             # accessing the heap of the sender. Then we register and connect to the
1526             # specified server.
1527             my $irc = $sender->get_heap();
1528              
1529             print "Connected to ", $irc->server_name(), "\n";
1530              
1531             # we join our channels
1532             $irc->yield( join => $_ ) for @channels;
1533             return;
1534             }
1535              
1536             sub irc_public {
1537             my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];
1538             my $nick = ( split /!/, $who )[0];
1539             my $channel = $where->[0];
1540              
1541             if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) {
1542             $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
1543             $irc->yield( privmsg => $channel => "$nick: $rot13" );
1544             }
1545             return;
1546             }
1547              
1548             # We registered for all events, this will produce some debug info.
1549             sub _default {
1550             my ($event, $args) = @_[ARG0 .. $#_];
1551             my @output = ( "$event: " );
1552              
1553             for my $arg (@$args) {
1554             if ( ref $arg eq 'ARRAY' ) {
1555             push( @output, '[' . join(', ', @$arg ) . ']' );
1556             }
1557             else {
1558             push ( @output, "'$arg'" );
1559             }
1560             }
1561             print join ' ', @output, "\n";
1562             return;
1563             }
1564              
1565             =head1 DESCRIPTION
1566              
1567             POE::Component::IRC is a POE component (who'd have guessed?) which
1568             acts as an easily controllable IRC client for your other POE
1569             components and sessions. You create an IRC component and tell it what
1570             events your session cares about and where to connect to, and it sends
1571             back interesting IRC events when they happen. You make the client do
1572             things by sending it events. That's all there is to it. Cool, no?
1573              
1574             [Note that using this module requires some familiarity with the
1575             details of the IRC protocol. I'd advise you to read up on the gory
1576             details of RFC 1459 (L) before you
1577             get started. Keep the list of server numeric codes handy while you
1578             program. Needless to say, you'll also need a good working knowledge of
1579             POE, or this document will be of very little use to you.]
1580              
1581             The POE::Component::IRC distribution has a F folder with a collection of
1582             salient documentation including the pertinent RFCs.
1583              
1584             POE::Component::IRC consists of a POE::Session that manages the IRC connection
1585             and dispatches C prefixed events to interested sessions and
1586             an object that can be used to access additional information using methods.
1587              
1588             Sessions register their interest in receiving C events by sending
1589             L|/register> to the component. One would usually do this in
1590             your C<_start> handler. Your session will continue to receive events until
1591             you L|/unregister>. The component will continue to stay
1592             around until you tell it not to with L|/shutdown>.
1593              
1594             The L demonstrates a fairly basic bot.
1595              
1596             See L for more
1597             examples.
1598              
1599             =head2 Useful subclasses
1600              
1601             Included with POE::Component::IRC are a number of useful subclasses. As they
1602             are subclasses they support all the methods, etc. documented here and have
1603             additional methods and quirks which are documented separately:
1604              
1605             =over 4
1606              
1607             =item * L
1608              
1609             POE::Component::IRC::State provides all the functionality of POE::Component::IRC
1610             but also tracks IRC state entities such as nicks and channels.
1611              
1612             =item * L
1613              
1614             POE::Component::IRC::Qnet is POE::Component::IRC tweaked for use on Quakenet IRC
1615             network.
1616              
1617             =item * L
1618              
1619             POE::Component::IRC::Qnet::State is a tweaked version of POE::Component::IRC::State
1620             for use on the Quakenet IRC network.
1621              
1622             =back
1623              
1624             =head2 The Plugin system
1625              
1626             As of 3.7, PoCo-IRC sports a plugin system. The documentation for it can be
1627             read by looking at L.
1628             That is not a subclass, just a placeholder for documentation!
1629              
1630             A number of useful plugins have made their way into the core distribution:
1631              
1632             =over 4
1633              
1634             =item * L
1635              
1636             Provides DCC support. Loaded by default.
1637              
1638             =item * L
1639              
1640             Keeps you on your favorite channels throughout reconnects and even kicks.
1641              
1642             =item * L
1643              
1644             Glues an irc bot to an IRC network, i.e. deals with maintaining ircd connections.
1645              
1646             =item * L
1647              
1648             Under normal circumstances irc bots do not normal the msgs and public msgs that
1649             they generate themselves. This plugin enables you to handle those events.
1650              
1651             =item * L
1652              
1653             Generates C / C / C
1654             events whenever your bot's name comes up in channel discussion.
1655              
1656             =item * L
1657              
1658             Provides an easy way to handle commands issued to your bot.
1659              
1660             =item * L
1661              
1662             See inside the component. See what events are being sent. Generate irc commands
1663             manually. A TCP based console.
1664              
1665             =item * L
1666              
1667             Follow the tail of an ever-growing file.
1668              
1669             =item * L
1670              
1671             Log public and private messages to disk.
1672              
1673             =item * L
1674              
1675             Identify with NickServ when needed.
1676              
1677             =item * L
1678              
1679             A lightweight IRC proxy/bouncer.
1680              
1681             =item * L
1682              
1683             Automagically generates replies to ctcp version, time and userinfo queries.
1684              
1685             =item * L
1686              
1687             An experimental Plugin Manager plugin.
1688              
1689             =item * L
1690              
1691             Automagically deals with your nickname being in use and reclaiming it.
1692              
1693             =item * L
1694              
1695             Cycles (parts and rejoins) channels if they become empty and opless, in order
1696             to gain ops.
1697              
1698             =back
1699              
1700             =head1 CONSTRUCTORS
1701              
1702             Both constructors return an object. The object is also available within 'irc_'
1703             event handlers by using C<< $_[SENDER]->get_heap() >>. See also
1704             L|/register> and L|/irc_registered>.
1705              
1706             =head2 C
1707              
1708             Takes a number of arguments, all of which are optional. All the options
1709             below may be supplied to the L|/connect> input event as well,
1710             except for B<'alias'>, B<'options'>, B<'NoDNS'>, B<'debug'>, and
1711             B<'plugin_debug'>.
1712              
1713             =over 4
1714              
1715             =item * B<'alias'>, a name (kernel alias) that this instance will be known
1716             by;
1717              
1718             =item * B<'options'>, a hashref containing L
1719             options;
1720              
1721             =item * B<'Server'>, the server name;
1722              
1723             =item * B<'Port'>, the remote port number;
1724              
1725             =item * B<'Password'>, an optional password for restricted servers;
1726              
1727             =item * B<'Nick'>, your client's IRC nickname;
1728              
1729             =item * B<'Username'>, your client's username;
1730              
1731             =item * B<'Ircname'>, some cute comment or something.
1732              
1733             =item * B<'Bitmode'>, an integer representing your initial user modes set
1734             in the USER command. See RFC 2812. If you do not set this, C<8> (+i) will
1735             be used.
1736              
1737             =item * B<'UseSSL'>, set to some true value if you want to connect using
1738             SSL.
1739              
1740             =item * B<'SSLCert'>, set to a SSL Certificate(PAM encoded) to connect using a client cert
1741              
1742             =item * B<'SSLKey'>, set to a SSL Key(PAM encoded) to connect using a client cert
1743              
1744             =item * B<'SSLCtx'>, set to a SSL Context to configure the SSL Connection
1745              
1746             The B<'SSLCert'> and B<'SSLKey'> both need to be specified. The B<'SSLCtx'> takes precedence specified.
1747              
1748             =item * B<'Raw'>, set to some true value to enable the component to send
1749             L|/irc_raw> and L|/irc_raw_out> events.
1750              
1751             =item * B<'LocalAddr'>, which local IP address on a multihomed box to
1752             connect as;
1753              
1754             =item * B<'LocalPort'>, the local TCP port to open your socket on;
1755              
1756             =item * B<'NoDNS'>, set this to 1 to disable DNS lookups using
1757             PoCo-Client-DNS. (See note below).
1758              
1759             =item * B<'Flood'>, when true, it disables the component's flood
1760             protection algorithms, allowing it to send messages to an IRC server at
1761             full speed. Disconnects and k-lines are some common side effects of
1762             flooding IRC servers, so care should be used when enabling this option.
1763             Default is false.
1764              
1765             Two new attributes are B<'Proxy'> and B<'ProxyPort'> for sending your
1766             =item * B<'Proxy'>, IP address or server name of a proxy server to use.
1767              
1768             =item * B<'ProxyPort'>, which tcp port on the proxy to connect to.
1769              
1770             =item * B<'NATAddr'>, what other clients see as your IP address.
1771              
1772             =item * B<'DCCPorts'>, an arrayref containing tcp ports that can be used
1773             for DCC sends.
1774              
1775             =item * B<'Resolver'>, provide a L object for the component to use.
1776              
1777             =item * B<'msg_length'>, the maximum length of IRC messages, in bytes.
1778             Default is 450. The IRC component shortens all messages longer than this
1779             value minus the length of your current nickname. IRC only allows raw
1780             protocol lines messages that are 512 bytes or shorter, including the
1781             trailing "\r\n". This is most relevant to long PRIVMSGs. The IRC component
1782             can't be sure how long your user@host mask will be every time you send a
1783             message, considering that most networks mangle the 'user' part and some
1784             even replace the whole string (think FreeNode cloaks). If you have an
1785             unusually long user@host mask you might want to decrease this value if
1786             you're prone to sending long messages. Conversely, if you have an
1787             unusually short one, you can increase this value if you want to be able to
1788             send as long a message as possible. Be careful though, increase it too
1789             much and the IRC server might disconnect you with a "Request too long"
1790             message when you try to send a message that's too long.
1791              
1792             =item * B<'debug'>, if set to a true value causes the IRC component to
1793             print every message sent to and from the server, as well as print some
1794             warnings when it receives malformed messages. This option will be enabled
1795             if the C environment variable is set to a true value.
1796              
1797             =item * B<'plugin_debug'>, set to some true value to print plugin debug
1798             info, default 0. Plugins are processed inside an eval. When you enable
1799             this option, you will be notified when (and why) a plugin raises an
1800             exception. This option will be enabled if the C environment
1801             variable is set to a true value.
1802              
1803             =item * B<'socks_proxy'>, specify a SOCKS4/SOCKS4a proxy to use.
1804              
1805             =item * B<'socks_port'>, the SOCKS port to use, defaults to 1080 if not
1806             specified.
1807              
1808             =item * B<'socks_id'>, specify a SOCKS user_id. Default is none.
1809              
1810             =item * B<'useipv6'>, enable the use of IPv6 for connections.
1811              
1812             =item * B<'webirc'>, enable the use of WEBIRC to spoof host/IP.
1813             You must have a WEBIRC password set up on the IRC server/network (so will
1814             only work for servers which trust you to spoof the IP & host the connection
1815             is from) - value should be a hashref containing keys C, C,
1816             C and C.
1817              
1818             =back
1819              
1820             C will supply reasonable defaults for any of these attributes
1821             which are missing, so don't feel obliged to write them all out.
1822              
1823             If the component finds that L
1824             is installed it will use that to resolve the server name passed. Disable
1825             this behaviour if you like, by passing: C<< NoDNS => 1 >>.
1826              
1827             IRC traffic through a proxy server. B<'Proxy'>'s value should be the IP
1828             address or server name of the proxy. B<'ProxyPort'>'s value should be the
1829             port on the proxy to connect to. L|/connect> will default
1830             to using the I IRC server's port if you provide a proxy but omit
1831             the proxy's port. These are for HTTP Proxies. See B<'socks_proxy'> for
1832             SOCKS4 and SOCKS4a support.
1833              
1834             For those people who run bots behind firewalls and/or Network Address
1835             Translation there are two additional attributes for DCC. B<'DCCPorts'>,
1836             is an arrayref of ports to use when initiating DCC connections.
1837             B<'NATAddr'>, is the NAT'ed IP address that your bot is hidden behind,
1838             this is sent whenever you do DCC.
1839              
1840             SSL support requires L, as
1841             well as an IRC server that supports SSL connections. If you're missing
1842             POE::Component::SSLify, specifying B<'UseSSL'> will do nothing. The
1843             default is to not try to use SSL.
1844              
1845             B<'Resolver'>, requires a L
1846             object. Useful when spawning multiple poco-irc sessions, saves the
1847             overhead of multiple dns sessions.
1848              
1849             B<'NoDNS'> has different results depending on whether it is set with
1850             L|/spawn> or L|/connect>. Setting it with
1851             C, disables the creation of the POE::Component::Client::DNS
1852             completely. Setting it with L|/connect> on the other hand
1853             allows the PoCo-Client-DNS session to be spawned, but will disable
1854             any dns lookups using it.
1855              
1856             SOCKS4 proxy support is provided by B<'socks_proxy'>, B<'socks_port'> and
1857             B<'socks_id'> parameters. If something goes wrong with the SOCKS connection
1858             you should get a warning on STDERR. This is fairly experimental currently.
1859              
1860             IPv6 support is available for connecting to IPv6 enabled ircds (it won't
1861             work for DCC though). To enable it, specify B<'useipv6'>. Perl >=5.14 or
1862             L (for older Perls) is required. If you that and
1863             L installed and
1864             specify a hostname that resolves to an IPv6 address then IPv6 will be used.
1865             If you specify an ipv6 B<'localaddr'> then IPv6 will be used.
1866              
1867             =head2 C
1868              
1869             This method is deprecated. See the L|/spawn> method instead.
1870             The first argument should be a name (kernel alias) which this new
1871             connection will be known by. Optionally takes more arguments (see
1872             L|/spawn> as name/value pairs. Returns a POE::Component::IRC
1873             object. :)
1874              
1875             B Use of this method will generate a warning. There are currently no
1876             plans to make it die() >;]
1877              
1878             =head1 METHODS
1879              
1880             =head2 Information
1881              
1882             =head3 C
1883              
1884             Takes no arguments. Returns the server host we are currently connected to
1885             (or trying to connect to).
1886              
1887             =head3 C
1888              
1889             Takes no arguments. Returns the server port we are currently connected to
1890             (or trying to connect to).
1891              
1892             =head3 C
1893              
1894             Takes no arguments. Returns the name of the IRC server that the component
1895             is currently connected to.
1896              
1897             =head3 C
1898              
1899             Takes no arguments. Returns the IRC server version.
1900              
1901             =head3 C
1902              
1903             Takes no arguments. Returns a scalar containing the current nickname that the
1904             bot is using.
1905              
1906             =head3 C
1907              
1908             Takes no arguments. Returns the IP address being used.
1909              
1910             =head3 C
1911              
1912             The component provides anti-flood throttling. This method takes no arguments
1913             and returns a scalar representing the number of messages that are queued up
1914             waiting for dispatch to the irc server.
1915              
1916             =head3 C
1917              
1918             Takes no arguments. Returns true or false depending on whether the IRC
1919             component is logged into an IRC network.
1920              
1921             =head3 C
1922              
1923             Takes no arguments. Returns true or false depending on whether the component's
1924             socket is currently connected.
1925              
1926             =head3 C
1927              
1928             Takes no arguments. Terminates the socket connection disgracefully >;o]
1929              
1930             =head3 C
1931              
1932             Takes one argument, a server capability to query. Returns C on failure
1933             or a value representing the applicable capability. A full list of capabilities
1934             is available at L.
1935              
1936             =head3 C
1937              
1938             Takes no arguments, returns a list of the available server capabilities keys,
1939             which can be used with L|/isupport>.
1940              
1941             =head3 C
1942              
1943             Returns a reference to the L
1944             object that is internally created by the component.
1945              
1946             =head2 Events
1947              
1948             =head3 C
1949              
1950             I>
1951              
1952             Takes no arguments. Returns the ID of the component's session. Ideal for posting
1953             events to the component.
1954              
1955             $kernel->post($irc->session_id() => 'mode' => $channel => '+o' => $dude);
1956              
1957             =head3 C
1958              
1959             I>
1960              
1961             Takes no arguments. Returns the session alias that has been set through
1962             L|/spawn>'s B<'alias'> argument.
1963              
1964             =head3 C
1965              
1966             With no arguments, returns true or false depending on whether
1967             L|/irc_raw> and L|/irc_raw_out> events are being generated
1968             or not. Provide a true or false argument to enable or disable this feature
1969             accordingly.
1970              
1971             =head3 C
1972              
1973             I>
1974              
1975             This method provides an alternative object based means of posting events to the
1976             component. First argument is the event to post, following arguments are sent as
1977             arguments to the resultant post.
1978              
1979             $irc->yield(mode => $channel => '+o' => $dude);
1980              
1981             =head3 C
1982              
1983             I>
1984              
1985             This method provides an alternative object based means of calling events to the
1986             component. First argument is the event to call, following arguments are sent as
1987             arguments to the resultant
1988             call.
1989              
1990             $irc->call(mode => $channel => '+o' => $dude);
1991              
1992             =head3 C
1993              
1994             I>
1995              
1996             This method provides a way of posting delayed events to the component. The
1997             first argument is an arrayref consisting of the delayed command to post and
1998             any command arguments. The second argument is the time in seconds that one
1999             wishes to delay the command being posted.
2000              
2001             my $alarm_id = $irc->delay( [ mode => $channel => '+o' => $dude ], 60 );
2002              
2003             Returns an alarm ID that can be used with L|/delay_remove>
2004             to cancel the delayed event. This will be undefined if something went wrong.
2005              
2006             =head3 C
2007              
2008             I>
2009              
2010             This method removes a previously scheduled delayed event from the component.
2011             Takes one argument, the C that was returned by a
2012             L|/delay> method call.
2013              
2014             my $arrayref = $irc->delay_remove( $alarm_id );
2015              
2016             Returns an arrayref that was originally requested to be delayed.
2017              
2018             =head3 C
2019              
2020             I>
2021              
2022             Sends an event through the component's event handling system. These will get
2023             processed by plugins then by registered sessions. First argument is the event
2024             name, followed by any parameters for that event.
2025              
2026             =head3 C
2027              
2028             I>
2029              
2030             This sends an event right after the one that's currently being processed.
2031             Useful if you want to generate some event which is directly related to
2032             another event so you want them to appear together. This method can only be
2033             called when POE::Component::IRC is processing an event, e.g. from one of your
2034             event handlers. Takes the same arguments as L|/send_event>.
2035              
2036             =head3 C
2037              
2038             I>
2039              
2040             This will send an event to be processed immediately. This means that if an
2041             event is currently being processed and there are plugins or sessions which
2042             will receive it after you do, then an event sent with C will
2043             be received by those plugins/sessions I the current event. Takes the
2044             same arguments as L|/send_event>.
2045              
2046             =head2 Plugins
2047              
2048             =head3 C
2049              
2050             I>
2051              
2052             Returns the L
2053             object.
2054              
2055             =head3 C
2056              
2057             I>
2058              
2059             Accepts two arguments:
2060              
2061             The alias for the plugin
2062             The actual plugin object
2063             Any number of extra arguments
2064              
2065             The alias is there for the user to refer to it, as it is possible to have
2066             multiple plugins of the same kind active in one Object::Pluggable object.
2067              
2068             This method goes through the pipeline's C method, which will call
2069             C<< $plugin->plugin_register($pluggable, @args) >>.
2070              
2071             Returns the number of plugins now in the pipeline if plugin was initialized,
2072             C/an empty list if not.
2073              
2074             =head3 C
2075              
2076             I>
2077              
2078             Accepts the following arguments:
2079              
2080             The alias for the plugin or the plugin object itself
2081             Any number of extra arguments
2082              
2083             This method goes through the pipeline's C method, which will call
2084             C<< $plugin->plugin_unregister($pluggable, @args) >>.
2085              
2086             Returns the plugin object if the plugin was removed, C/an empty list
2087             if not.
2088              
2089             =head3 C
2090              
2091             I>
2092              
2093             Accepts the following arguments:
2094              
2095             The alias for the plugin
2096              
2097             This method goes through the pipeline's C method.
2098              
2099             Returns the plugin object if it was found, C/an empty list if not.
2100              
2101             =head3 C
2102              
2103             I>
2104              
2105             Takes no arguments.
2106              
2107             Returns a hashref of plugin objects, keyed on alias, or an empty list if
2108             there are no plugins loaded.
2109              
2110             =head3 C
2111              
2112             I>
2113              
2114             Takes no arguments.
2115              
2116             Returns an arrayref of plugin objects, in the order which they are
2117             encountered in the pipeline.
2118              
2119             =head3 C
2120              
2121             I>
2122              
2123             Accepts the following arguments:
2124              
2125             The plugin object
2126             The type of the hook (the hook types are specified with _pluggable_init()'s 'types')
2127             The event name[s] to watch
2128              
2129             The event names can be as many as possible, or an arrayref. They correspond
2130             to the prefixed events and naturally, arbitrary events too.
2131              
2132             You do not need to supply events with the prefix in front of them, just the
2133             names.
2134              
2135             It is possible to register for all events by specifying 'all' as an event.
2136              
2137             Returns 1 if everything checked out fine, C/an empty list if something
2138             is seriously wrong.
2139              
2140             =head3 C
2141              
2142             I>
2143              
2144             Accepts the following arguments:
2145              
2146             The plugin object
2147             The type of the hook (the hook types are specified with _pluggable_init()'s 'types')
2148             The event name[s] to unwatch
2149              
2150             The event names can be as many as possible, or an arrayref. They correspond
2151             to the prefixed events and naturally, arbitrary events too.
2152              
2153             You do not need to supply events with the prefix in front of them, just the
2154             names.
2155              
2156             It is possible to register for all events by specifying 'all' as an event.
2157              
2158             Returns 1 if all the event name[s] was unregistered, undef if some was not
2159             found.
2160              
2161             =head1 INPUT EVENTS
2162              
2163             How to talk to your new IRC component... here's the events we'll accept.
2164             These are events that are posted to the component, either via
2165             C<< $poe_kernel->post() >> or via the object method L|/yield>.
2166              
2167             So the following would be functionally equivalent:
2168              
2169             sub irc_001 {
2170             my ($kernel,$sender) = @_[KERNEL,SENDER];
2171             my $irc = $sender->get_heap(); # obtain the poco's object
2172              
2173             $irc->yield( privmsg => 'foo' => 'Howdy!' );
2174             $kernel->post( $sender => privmsg => 'foo' => 'Howdy!' );
2175             $kernel->post( $irc->session_id() => privmsg => 'foo' => 'Howdy!' );
2176             $kernel->post( $irc->session_alias() => privmsg => 'foo' => 'Howdy!' );
2177              
2178             return;
2179             }
2180              
2181             =head2 Important Commands
2182              
2183             =head3 C
2184              
2185             I>
2186              
2187             Takes N arguments: a list of event names that your session wants to
2188             listen for, minus the C prefix. So, for instance, if you just
2189             want a bot that keeps track of which people are on a channel, you'll
2190             need to listen for JOINs, PARTs, QUITs, and KICKs to people on the
2191             channel you're in. You'd tell POE::Component::IRC that you want those
2192             events by saying this:
2193              
2194             $kernel->post('my client', 'register', qw(join part quit kick));
2195              
2196             Then, whenever people enter or leave a channel your bot is on (forcibly
2197             or not), your session will receive events with names like
2198             L|/irc_join>, L|/irc_kick>, etc.,
2199             which you can use to update a list of people on the channel.
2200              
2201             Registering for B<'all'> will cause it to send all IRC-related events to
2202             you; this is the easiest way to handle it. See the test script for an
2203             example.
2204              
2205             Registering will generate an L|/irc_registered>
2206             event that your session can trap. C is the components object. Useful
2207             if you want to bolt PoCo-IRC's new features such as Plugins into a bot
2208             coded to the older deprecated API. If you are using the new API, ignore this :)
2209              
2210             Registering with multiple component sessions can be tricky, especially if
2211             one wants to marry up sessions/objects, etc. Check the L
2212             section for an alternative method of registering with multiple poco-ircs.
2213              
2214             Starting with version 4.96, if you spawn the component from inside another POE
2215             session, the component will automatically register that session as wanting
2216             B<'all'> irc events. That session will receive an
2217             L|/irc_registered> event indicating that the component
2218             is up and ready to go.
2219              
2220             =head3 C
2221              
2222             I>
2223              
2224             Takes N arguments: a list of event names which you I want to
2225             receive. If you've previously done a L|/register>
2226             for a particular event which you no longer care about, this event will
2227             tell the IRC connection to stop sending them to you. (If you haven't, it just
2228             ignores you. No big deal.)
2229              
2230             If you have registered with 'all', attempting to unregister individual
2231             events such as 'mode', etc. will not work. This is a 'feature'.
2232              
2233             =head3 C
2234              
2235             Takes one argument: a hash reference of attributes for the new connection,
2236             see L|/spawn> for details. This event tells the IRC client to
2237             connect to a new/different server. If it has a connection already open, it'll
2238             close it gracefully before reconnecting.
2239              
2240             =head3 C and C
2241              
2242             Sends a CTCP query or response to the nick(s) or channel(s) which you
2243             specify. Takes 2 arguments: the nick or channel to send a message to
2244             (use an array reference here to specify multiple recipients), and the
2245             plain text of the message to send (the CTCP quoting will be handled
2246             for you). The "/me" command in popular IRC clients is actually a CTCP action.
2247              
2248             # Doing a /me
2249             $irc->yield(ctcp => $channel => 'ACTION dances.');
2250              
2251             =head3 C
2252              
2253             Tells your IRC client to join a single channel of your choice. Takes
2254             at least one arg: the channel name (required) and the channel key
2255             (optional, for password-protected channels).
2256              
2257             =head3 C
2258              
2259             Tell the IRC server to forcibly evict a user from a particular
2260             channel. Takes at least 2 arguments: a channel name, the nick of the
2261             user to boot, and an optional witty message to show them as they sail
2262             out the door.
2263              
2264             =head3 C
2265              
2266             Tell the IRC server to forcibly evict a user from a particular
2267             channel. Takes at least 2 arguments: a channel name, the nick of the
2268             user to boot, and an optional witty message to show them as they sail
2269             out the door. Similar to KICK but does an enforced PART instead. Not
2270             supported by all servers.
2271              
2272             =head3 C
2273              
2274             Request a mode change on a particular channel or user. Takes at least
2275             one argument: the mode changes to effect, as a single string (e.g.
2276             "#mychan +sm-p+o"), and any number of optional operands to the mode changes
2277             (nicks, hostmasks, channel keys, whatever.) Or just pass them all as one
2278             big string and it'll still work, whatever. I regret that I haven't the
2279             patience now to write a detailed explanation, but serious IRC users know
2280             the details anyhow.
2281              
2282             =head3 C
2283              
2284             Allows you to change your nickname. Takes exactly one argument: the
2285             new username that you'd like to be known as.
2286              
2287             =head3 C
2288              
2289             Talks to NickServ, on networks which have it. Takes any number of
2290             arguments.
2291              
2292             =head3 C
2293              
2294             Sends a NOTICE message to the nick(s) or channel(s) which you
2295             specify. Takes 2 arguments: the nick or channel to send a notice to
2296             (use an array reference here to specify multiple recipients), and the
2297             text of the notice to send.
2298              
2299             =head3 C
2300              
2301             Tell your IRC client to leave the channels which you pass to it. Takes
2302             any number of arguments: channel names to depart from. If the last argument
2303             doesn't begin with a channel name identifier or contains a space character,
2304             it will be treated as a PART message and dealt with accordingly.
2305              
2306             =head3 C
2307              
2308             Sends a public or private message to the nick(s) or channel(s) which
2309             you specify. Takes 2 arguments: the nick or channel to send a message
2310             to (use an array reference here to specify multiple recipients), and
2311             the text of the message to send.
2312              
2313             Have a look at the constants in L if you would
2314             like to use formatting and color codes in your messages.
2315              
2316             $irc->yield('primvsg', '#mychannel', 'Hello there');
2317              
2318             # same, but with a green Hello
2319             use IRC::Utils qw(GREEN NORMAL);
2320             $irc->yield('primvsg', '#mychannel', GREEN.'Hello'.NORMAL.' there');
2321              
2322             =head3 C
2323              
2324             Tells the IRC server to disconnect you. Takes one optional argument:
2325             some clever, witty string that other users in your channels will see
2326             as you leave. You can expect to get an
2327             L|/irc_disconnected> event shortly after sending this.
2328              
2329             =head3 C
2330              
2331             By default, POE::Component::IRC sessions never go away. Even after
2332             they're disconnected, they're still sitting around in the background,
2333             waiting for you to call L|/connect> on them again to
2334             reconnect. (Whether this behavior is the Right Thing is doubtful, but I
2335             don't want to break backwards compatibility at this point.) You can send
2336             the IRC session a C event manually to make it delete itself.
2337              
2338             If you are logged into an IRC server, C first will send a quit
2339             message and wait to be disconnected. It will wait for up to 5 seconds before
2340             forcibly disconnecting from the IRC server. If you provide an argument, that
2341             will be used as the QUIT message. If you provide two arguments, the second
2342             one will be used as the timeout (in seconds).
2343              
2344             Terminating multiple components can be tricky. Check the L
2345             section for a method of shutting down multiple poco-ircs.
2346              
2347             =head3 C
2348              
2349             Retrieves or sets the topic for particular channel. If called with just
2350             the channel name as an argument, it will ask the server to return the
2351             current topic. If called with the channel name and a string, it will
2352             set the channel topic to that string. Supply an empty string to unset a
2353             channel topic.
2354              
2355             =head3 C
2356              
2357             Takes one argument: 0 to turn debugging off or 1 to turn debugging on.
2358             This flips the debugging flag in L,
2359             L, and
2360             POE::Component::IRC. This has the same effect as setting Debug in
2361             L|/spawn> or L|/connect>.
2362              
2363             =head2 Not-So-Important Commands
2364              
2365             =head3 C
2366              
2367             Asks your server who your friendly neighborhood server administrators
2368             are. If you prefer, you can pass it a server name to query, instead of
2369             asking the server you're currently on.
2370              
2371             =head3 C
2372              
2373             When sent with an argument (a message describig where you went), the
2374             server will note that you're now away from your machine or otherwise
2375             preoccupied, and pass your message along to anyone who tries to
2376             communicate with you. When sent without arguments, it tells the server
2377             that you're back and paying attention.
2378              
2379             =head3 C
2380              
2381             Used to query/enable/disable IRC protocol capabilities. Takes any number of
2382             arguments.
2383              
2384             =head3 C
2385              
2386             See the L (loaded by default)
2387             documentation for DCC-related commands.
2388              
2389             =head3 C
2390              
2391             Basically the same as the L|/version> command, except that the
2392             server is permitted to return any information about itself that it thinks is
2393             relevant. There's some nice, specific standards-writing for ya, eh?
2394              
2395             =head3 C
2396              
2397             Invites another user onto an invite-only channel. Takes 2 arguments:
2398             the nick of the user you wish to admit, and the name of the channel to
2399             invite them to.
2400              
2401             =head3 C
2402              
2403             Asks the IRC server which users out of a list of nicknames are
2404             currently online. Takes any number of arguments: a list of nicknames
2405             to query the IRC server about.
2406              
2407             =head3 C
2408              
2409             Asks the server for a list of servers connected to the IRC
2410             network. Takes two optional arguments, which I'm too lazy to document
2411             here, so all you would-be linklooker writers should probably go dig up
2412             the RFC.
2413              
2414             =head3 C
2415              
2416             Asks the server for a list of visible channels and their topics. Takes
2417             any number of optional arguments: names of channels to get topic
2418             information for. If called without any channel names, it'll list every
2419             visible channel on the IRC network. This is usually a really big list,
2420             so don't do this often.
2421              
2422             =head3 C
2423              
2424             Request the server's "Message of the Day", a document which typically
2425             contains stuff like the server's acceptable use policy and admin
2426             contact email addresses, et cetera. Normally you'll automatically
2427             receive this when you log into a server, but if you want it again,
2428             here's how to do it. If you'd like to get the MOTD for a server other
2429             than the one you're logged into, pass it the server's hostname as an
2430             argument; otherwise, no arguments.
2431              
2432             =head3 C
2433              
2434             Asks the server for a list of nicknames on particular channels. Takes
2435             any number of arguments: names of channels to get lists of users
2436             for. If called without any channel names, it'll tell you the nicks of
2437             everyone on the IRC network. This is a really big list, so don't do
2438             this much.
2439              
2440             =head3 C
2441              
2442             Sends a raw line of text to the server. Takes one argument: a string
2443             of a raw IRC command to send to the server. It is more optimal to use
2444             the events this module supplies instead of writing raw IRC commands
2445             yourself.
2446              
2447             =head3 C
2448              
2449             Returns some information about a server. Kinda complicated and not
2450             terribly commonly used, so look it up in the RFC if you're
2451             curious. Takes as many arguments as you please.
2452              
2453             =head3 C
2454              
2455             Asks the server what time it thinks it is, which it will return in a
2456             human-readable form. Takes one optional argument: a server name to
2457             query. If not supplied, defaults to current server.
2458              
2459             =head3 C
2460              
2461             If you pass a server name or nick along with this request, it asks the
2462             server for the list of servers in between you and the thing you
2463             mentioned. If sent with no arguments, it will show you all the servers
2464             which are connected to your current server.
2465              
2466             =head3 C
2467              
2468             Asks the server how many users are logged into it. Defaults to the
2469             server you're currently logged into; however, you can pass a server
2470             name as the first argument to query some other machine instead.
2471              
2472             =head3 C
2473              
2474             Asks the server about the version of ircd that it's running. Takes one
2475             optional argument: a server name to query. If not supplied, defaults
2476             to current server.
2477              
2478             =head3 C
2479              
2480             Lists the logged-on users matching a particular channel name, hostname,
2481             nickname, or what-have-you. Takes one optional argument: a string for
2482             it to search for. Wildcards are allowed; in the absence of this
2483             argument, it will return everyone who's currently logged in (bad
2484             move). Tack an "o" on the end if you want to list only IRCops, as per
2485             the RFC.
2486              
2487             =head3 C
2488              
2489             Queries the IRC server for detailed information about a particular
2490             user. Takes any number of arguments: nicknames or hostmasks to ask for
2491             information about. As of version 3.2, you will receive an
2492             L|/irc_whois> event in addition to the usual numeric
2493             responses. See below for details.
2494              
2495             =head3 C
2496              
2497             Asks the server for information about nickname which is no longer
2498             connected. Takes at least one argument: a nickname to look up (no
2499             wildcards allowed), the optional maximum number of history entries to
2500             return, and the optional server hostname to query. As of version 3.2,
2501             you will receive an L|/irc_whowas> event in addition
2502             to the usual numeric responses. See below for details.
2503              
2504             =head3 C and C
2505              
2506             Included for completeness sake. The component will deal with ponging to
2507             pings automatically. Don't worry about it.
2508              
2509             =head2 Purely Esoteric Commands
2510              
2511             =head3 C
2512              
2513             Tells the IRC server you're connect to, to terminate. Only useful for
2514             IRCops, thank goodness. Takes no arguments.
2515              
2516             =head3 C
2517              
2518             Opers-only command. This one sends a message to all currently
2519             logged-on local-opers (+l). This option is specific to EFNet.
2520              
2521             =head3 C
2522              
2523             In the exceedingly unlikely event that you happen to be an IRC
2524             operator, you can use this command to authenticate with your IRC
2525             server. Takes 2 arguments: your username and your password.
2526              
2527             =head3 C
2528              
2529             Opers-only command. This one sends a message to all currently
2530             logged-on global opers. This option is specific to EFNet.
2531              
2532             =head3 C
2533              
2534             Tells the IRC server you're connected to, to rehash its configuration
2535             files. Only useful for IRCops. Takes no arguments.
2536              
2537             =head3 C
2538              
2539             Tells the IRC server you're connected to, to shut down and restart itself.
2540             Only useful for IRCops, thank goodness. Takes no arguments.
2541              
2542             =head3 C
2543              
2544             Tells one IRC server (which you have operator status on) to connect to
2545             another. This is actually the CONNECT command, but I already had an
2546             event called L|/connect>, so too bad. Takes the args
2547             you'd expect: a server to connect to, an optional port to connect on,
2548             and an optional remote server to connect with, instead of the one you're
2549             currently on.
2550              
2551             =head3 C
2552              
2553             Operator-only command used to disconnect server links. Takes two arguments,
2554             the server to disconnect and a message explaining your action.
2555              
2556             =head3 C
2557              
2558             Don't even ask.
2559              
2560             =head3 C
2561              
2562             Lists the currently connected services on the network that are visible to you.
2563             Takes two optional arguments, a mask for matching service names against, and
2564             a service type.
2565              
2566             =head3 C
2567              
2568             Sends a message to a service. Takes the same arguments as
2569             L|/privmsg>.
2570              
2571             =head3 C
2572              
2573             Asks the IRC server for information about particular nicknames. (The
2574             RFC doesn't define exactly what this is supposed to return.) Takes any
2575             number of arguments: the nicknames to look up.
2576              
2577             =head3 C
2578              
2579             Another opers-only command. This one sends a message to all currently
2580             logged-on opers (and +w users); sort of a mass PA system for the IRC
2581             server administrators. Takes one argument: some clever, witty message
2582             to send.
2583              
2584             =head1 OUTPUT EVENTS
2585              
2586             The events you will receive (or can ask to receive) from your running
2587             IRC component. Note that all incoming event names your session will
2588             receive are prefixed by C, to inhibit event namespace pollution.
2589              
2590             If you wish, you can ask the client to send you every event it
2591             generates. Simply register for the event name "all". This is a lot
2592             easier than writing a huge list of things you specifically want to
2593             listen for.
2594              
2595             FIXME: I'd really like to classify these somewhat ("basic", "oper", "ctcp",
2596             "dcc", "raw" or some such), and I'd welcome suggestions for ways to make
2597             this easier on the user, if you can think of some.
2598              
2599             In your event handlers, C<$_[SENDER]> is the particular component session that
2600             sent you the event. C<< $_[SENDER]->get_heap() >> will retrieve the component's
2601             object. Useful if you want on-the-fly access to the object and its methods.
2602              
2603             =head2 Important Events
2604              
2605             =head3 C
2606              
2607             I>
2608              
2609             Sent once to the requesting session on registration (see
2610             L|/register>). C is a reference tothe component's object.
2611              
2612             =head3 C
2613              
2614             I>
2615              
2616             Sent to all registered sessions when the component has been asked to
2617             L|/shutdown>. C will be the session ID of the requesting
2618             session.
2619              
2620             =head3 C
2621              
2622             The IRC component will send an C event as soon as it
2623             establishes a connection to an IRC server, before attempting to log
2624             in. C is the server name.
2625              
2626             B When you get an C event, this doesn't mean you
2627             can start sending commands to the server yet. Wait until you receive
2628             an L|/All numeric events> event (the server welcome message)
2629             before actually sending anything back to the server.
2630              
2631             =head3 C
2632              
2633             C events are generated upon receipt of CTCP messages, in addition to
2634             the C events mentioned below. They are identical in every way to
2635             these, with one difference: instead of the * being in the method name, it
2636             is prepended to the argument list. For example, if someone types C
2637             Flibble foo bar>, an C event will be sent with B<'foo'> as C,
2638             and the rest as given below.
2639              
2640             It is not recommended that you register for both C and C
2641             events, since they will both be fired and presumably cause duplication.
2642              
2643             =head3 C
2644              
2645             C events are generated upon receipt of CTCP messages.
2646             For instance, receiving a CTCP PING request generates an C
2647             event, CTCP ACTION (produced by typing "/me" in most IRC clients)
2648             generates an C event, blah blah, so on and so forth. C
2649             is the nick!hostmask of the sender. C is the channel/recipient
2650             name(s). C is the text of the CTCP message. On servers supporting the
2651             IDENTIFY-MSG feature (e.g. FreeNode), CTCP ACTIONs will have C, which
2652             will be C<1> if the sender has identified with NickServ, C<0> otherwise.
2653              
2654             Note that DCCs are handled separately -- see the
2655             L.
2656              
2657             =head3 C
2658              
2659             C messages are just like C
2660             messages, described above, except that they're generated when a response
2661             to one of your CTCP queries comes back. They have the same arguments and
2662             such as C events.
2663              
2664             =head3 C
2665              
2666             The counterpart to L|/irc_connected>, sent whenever
2667             a socket connection to an IRC server closes down (whether intentionally or
2668             unintentionally). C is the server name.
2669              
2670             =head3 C
2671              
2672             You get this whenever the server sends you an ERROR message. Expect
2673             this to usually be accompanied by the sudden dropping of your
2674             connection. C is the server's explanation of the error.
2675              
2676             =head3 C
2677              
2678             Sent whenever someone joins a channel that you're on. C is the
2679             person's nick!hostmask. C is the channel name.
2680              
2681             =head3 C
2682              
2683             Sent whenever someone offers you an invitation to another channel. C
2684             is the person's nick!hostmask. C is the name of the channel they want
2685             you to join.
2686              
2687             =head3 C
2688              
2689             Sent whenever someone gets booted off a channel that you're on. C
2690             is the kicker's nick!hostmask. C is the channel name. C is the
2691             nick of the unfortunate kickee. C is the explanation string for the
2692             kick.
2693              
2694             =head3 C
2695              
2696             Sent whenever someone changes a channel mode in your presence, or when
2697             you change your own user mode. C is the nick!hostmask of that
2698             someone. C is the channel it affects (or your nick, if it's a user
2699             mode change). C is the mode string (i.e., "+o-b"). The rest of the
2700             args (C) are the operands to the mode string (nicks,
2701             hostmasks, channel keys, whatever).
2702              
2703             =head3 C
2704              
2705             Sent whenever you receive a PRIVMSG command that was addressed to you
2706             privately. C is the nick!hostmask of the sender. C is an array
2707             reference containing the nick(s) of the recipients. C is the text
2708             of the message. On servers supporting the IDENTIFY-MSG feature (e.g.
2709             FreeNode), there will be an additional argument, C, which will be
2710             C<1> if the sender has identified with NickServ, C<0> otherwise.
2711              
2712             =head3 C
2713              
2714             Sent whenever you, or someone around you, changes nicks. C is the
2715             nick!hostmask of the changer. C is the new nick that they changed
2716             to.
2717              
2718             =head3 C
2719              
2720             Sent whenever you receive a NOTICE command. C is the nick!hostmask
2721             of the sender. C is an array reference containing the nick(s) or
2722             channel name(s) of the recipients. C is the text of the NOTICE
2723             message.
2724              
2725             =head3 C
2726              
2727             Sent whenever someone leaves a channel that you're on. C is the
2728             person's nick!hostmask. C is the channel name. C is the part
2729             message.
2730              
2731             =head3 C
2732              
2733             Sent whenever you receive a PRIVMSG command that was sent to a channel.
2734             C is the nick!hostmask of the sender. C is an array
2735             reference containing the channel name(s) of the recipients. C is the
2736             text of the message. On servers supporting the IDENTIFY-MSG feature (e.g.
2737             FreeNode), there will be an additional argument, C, which will be
2738             C<1> if the sender has identified with NickServ, C<0> otherwise.
2739              
2740             =head3 C
2741              
2742             Sent whenever someone on a channel with you quits IRC (or gets
2743             KILLed). C is the nick!hostmask of the person in question. C is
2744             the clever, witty message they left behind on the way out.
2745              
2746             =head3 C
2747              
2748             Sent when a connection couldn't be established to the IRC server. C
2749             is probably some vague and/or misleading reason for what failed.
2750              
2751             =head3 C
2752              
2753             Sent when a channel topic is set or unset. C is the nick!hostmask of the
2754             sender. C is the channel affected. C will be either: a string if the
2755             topic is being set; or a zero-length string (i.e. '') if the topic is being
2756             unset. Note: replies to queries about what a channel topic *is*
2757             (i.e. TOPIC #channel), are returned as numerics, not with this event.
2758              
2759             =head3 C
2760              
2761             Sent in response to a WHOIS query. C is a hashref, with the following
2762             keys:
2763              
2764             =over 4
2765              
2766             =item * B<'nick'>, the users nickname;
2767              
2768             =item * B<'user'>, the users username;
2769              
2770             =item * B<'host'>, their hostname;
2771              
2772             =item * B<'real'>, their real name;
2773              
2774             =item * B<'idle'>, their idle time in seconds;
2775              
2776             =item * B<'signon'>, the epoch time they signed on (will be undef if ircd
2777             does not support this);
2778              
2779             =item * B<'channels'>, an arrayref listing visible channels they are on,
2780             the channel is prefixed with '@','+','%' depending on whether they have
2781             +o +v or +h;
2782              
2783             =item * B<'server'>, their server (might not be useful on some networks);
2784              
2785             =item * B<'oper'>, whether they are an IRCop, contains the IRC operator
2786             string if they are, undef if they aren't.
2787              
2788             =item * B<'actually'>, some ircds report the user's actual ip address,
2789             that'll be here;
2790              
2791             =item * B<'identified'>. if the user has identified with NICKSERV
2792             (ircu, seven, Plexus)
2793              
2794             =item * B<'modes'>, a string describing the user's modes (Rizon)
2795              
2796             =back
2797              
2798             =head3 C
2799              
2800             Similar to the above, except some keys will be missing.
2801              
2802             =head3 C
2803              
2804             Enabled by passing C<< Raw => 1 >> to L|/spawn> or
2805             L|/connect>, or by calling L|/raw_events> with
2806             a true argument. C is the raw IRC string received by the component from
2807             the IRC server, before it has been mangled by filters and such like.
2808              
2809             =head3 C
2810              
2811             Enabled by passing C<< Raw => 1 >> to L|/spawn> or
2812             L|/connect>, or by calling L|/raw_events> with
2813             a true argument. C is the raw IRC string sent by the component to the
2814             the IRC server.
2815              
2816             =head3 C
2817              
2818             Emitted by the first event after an L|/All numeric events>, to
2819             indicate that isupport information has been gathered. C is the
2820             L
2821             object.
2822              
2823             =head3 C
2824              
2825             Emitted whenever we fail to connect successfully to a SOCKS server or the
2826             SOCKS server is not actually a SOCKS server. C will be some vague reason
2827             as to what went wrong. Hopefully.
2828              
2829             =head3 C
2830              
2831             Emitted whenever a SOCKS connection is rejected by a SOCKS server. C is
2832             the SOCKS code, C the SOCKS server address, C the SOCKS port and
2833             C the SOCKS user id (if defined).
2834              
2835             =head3 C
2836              
2837             I>
2838              
2839             Emitted whenever a new plugin is added to the pipeline. C is the
2840             plugin alias. C is the plugin object.
2841              
2842             =head3 C
2843              
2844             I>
2845              
2846             Emitted whenever a plugin is removed from the pipeline. C is the
2847             plugin alias. C is the plugin object.
2848              
2849             =head3 C
2850              
2851             I>
2852              
2853             Emitted when an error occurs while executing a plugin handler. C is
2854             the error message. C is the plugin alias. C is the plugin object.
2855              
2856             =head2 Somewhat Less Important Events
2857              
2858             =head3 C
2859              
2860             A reply from the server regarding protocol capabilities. C is the
2861             CAP subcommand (e.g. 'LS'). C is the result of the subcommand, unless
2862             this is a multi-part reply, in which case C is '*' and C contains
2863             the result.
2864              
2865             =head3 C
2866              
2867             See the L (loaded by default)
2868             documentation for DCC-related events.
2869              
2870             =head3 C
2871              
2872             An event sent whenever the server sends a PING query to the
2873             client. (Don't confuse this with a CTCP PING, which is another beast
2874             entirely. If unclear, read the RFC.) Note that POE::Component::IRC will
2875             automatically take care of sending the PONG response back to the
2876             server for you, although you can still register to catch the event for
2877             informational purposes.
2878              
2879             =head3 C
2880              
2881             A weird, non-RFC-compliant message from an IRC server. Usually sent during
2882             to you during an authentication phase right after you connect, while the
2883             server does a hostname lookup or similar tasks. C is the text of the
2884             server's message. C is the target, which could be B<'*'> or B<'AUTH'>
2885             or whatever. Servers vary as to whether these notices include a server name
2886             as the sender, or no sender at all. C is the sender, if any.
2887              
2888             =head3 C
2889              
2890             I>
2891              
2892             Emitted on a successful addition of a delayed event using the
2893             L|/delay> method. C will be the alarm_id which can be used
2894             later with L|/delay_remove>. Subsequent parameters are
2895             the arguments that were passed to L|/delay>.
2896              
2897             =head3 C
2898              
2899             I>
2900              
2901             Emitted when a delayed command is successfully removed. C will be the
2902             alarm_id that was removed. Subsequent parameters are the arguments that were
2903             passed to L|/delay>.
2904              
2905             =head2 All numeric events
2906              
2907             Most messages from IRC servers are identified only by three-digit
2908             numeric codes with undescriptive constant names like RPL_UMODEIS and
2909             ERR_NOTOPLEVEL. (Actually, the list of codes in the RFC is kind of
2910             out-of-date... the list in the back of Net::IRC::Event.pm is more
2911             complete, and different IRC networks have different and incompatible
2912             lists. Ack!) As an example, say you wanted to handle event 376
2913             (RPL_ENDOFMOTD, which signals the end of the MOTD message). You'd
2914             register for '376', and listen for C events. Simple, no? C
2915             is the name of the server which sent the message. C is the text of
2916             the message. C is an array reference of the parsed message, so there
2917             is no need to parse C yourself.
2918              
2919             =head1 SIGNALS
2920              
2921             The component will handle a number of custom signals that you may send using
2922             L's C method.
2923              
2924             =head2 C
2925              
2926             I>
2927              
2928             Registering with multiple PoCo-IRC components has been a pita. Well, no more,
2929             using the power of L signals.
2930              
2931             If the component receives a C signal it'll register the
2932             requesting session and trigger an L|/irc_registered>
2933             event. From that event one can get all the information necessary such as the
2934             poco-irc object and the SENDER session to do whatever one needs to build a
2935             poco-irc dispatch table.
2936              
2937             The way the signal handler in PoCo-IRC is written also supports sending the
2938             C to multiple sessions simultaneously, by sending the signal
2939             to the POE Kernel itself.
2940              
2941             Pass the signal your session, session ID or alias, and the IRC events (as
2942             specified to L|/register>).
2943              
2944             To register with multiple PoCo-IRCs one can do the following in your session's
2945             _start handler:
2946              
2947             sub _start {
2948             my ($kernel, $session) = @_[KERNEL, SESSION];
2949              
2950             # Registering with multiple pocoircs for 'all' IRC events
2951             $kernel->signal($kernel, 'POCOIRC_REGISTER', $session->ID(), 'all');
2952              
2953             return:
2954             }
2955              
2956             Each poco-irc will send your session an
2957             L|/irc_registered> event:
2958              
2959             sub irc_registered {
2960             my ($kernel, $sender, $heap, $irc_object) = @_[KERNEL, SENDER, HEAP, ARG0];
2961              
2962             # Get the poco-irc session ID
2963             my $sender_id = $sender->ID();
2964              
2965             # Or it's alias
2966             my $poco_alias = $irc_object->session_alias();
2967              
2968             # Store it in our heap maybe
2969             $heap->{irc_objects}->{ $sender_id } = $irc_object;
2970              
2971             # Make the poco connect
2972             $irc_object->yield(connect => { });
2973              
2974             return;
2975             }
2976              
2977             =head2 C
2978              
2979             I>
2980              
2981             Telling multiple poco-ircs to shutdown was a pita as well. The same principle as
2982             with registering applies to shutdown too.
2983              
2984             Send a C to the POE Kernel to terminate all the active
2985             poco-ircs simultaneously.
2986              
2987             $poe_kernel->signal($poe_kernel, 'POCOIRC_SHUTDOWN');
2988              
2989             Any additional parameters passed to the signal will become your quit messages
2990             on each IRC network.
2991              
2992             =head1 ENCODING
2993              
2994             This can be an issue. Take a look at L
2995             on it.
2996              
2997             =head1 BUGS
2998              
2999             A few have turned up in the past and they are sure to again. Please use
3000             L to report any. Alternatively, email the current
3001             maintainer.
3002              
3003             =head1 DEVELOPMENT
3004              
3005             You can find the latest source on github:
3006             L
3007              
3008             The project's developers usually hang out in the C<#poe> IRC channel on
3009             irc.perl.org. Do drop us a line.
3010              
3011             =head1 MAINTAINERS
3012              
3013             Chris C Williams
3014              
3015             Hinrik Ern SigurEsson
3016              
3017             =head1 AUTHOR
3018              
3019             Dennis Taylor.
3020              
3021             =head1 LICENCE
3022              
3023             Copyright (c) Dennis Taylor, Chris Williams and Hinrik Ern SigurEsson
3024              
3025             This module may be used, modified, and distributed under the same
3026             terms as Perl itself. Please see the license that came with your Perl
3027             distribution for details.
3028              
3029             =head1 MAD PROPS
3030              
3031             The maddest of mad props go out to Rocco "dngor" Caputo
3032             , for inventing something as mind-bogglingly
3033             cool as POE, and to Kevin "oznoid" Lenzo Elenzo@cs.cmu.eduE,
3034             for being the attentive parent of our precocious little infobot on
3035             #perl.
3036              
3037             Further props to a few of the studly bughunters who made this module not
3038             suck: Abys , Addi , ResDev
3039             , and Roderick . Woohoo!
3040              
3041             Kudos to Apocalypse, , for the plugin system and to
3042             Jeff 'japhy' Pinyan, , for Pipeline.
3043              
3044             Thanks to the merry band of POE pixies from #PoE @ irc.perl.org,
3045             including ( but not limited to ), ketas, ct, dec, integral, webfox,
3046             immute, perigrin, paulv, alias.
3047              
3048             IP functions are shamelessly 'borrowed' from L by Manuel
3049             Valente
3050              
3051             Check out the Changes file for further contributors.
3052              
3053             =head1 SEE ALSO
3054              
3055             RFC 1459 L
3056              
3057             L,
3058              
3059             L,
3060              
3061             L,
3062              
3063             Some good examples reside in the POE cookbook which has a whole section
3064             devoted to IRC programming L.
3065              
3066             The examples/ folder of this distribution.
3067              
3068             =cut