File Coverage

blib/lib/POE/Component/IRC/State.pm
Criterion Covered Total %
statement 617 805 76.6
branch 178 300 59.3
condition 71 140 50.7
subroutine 57 71 80.2
pod 29 59 49.1
total 952 1375 69.2


line stmt bran cond sub pod time code
1             package POE::Component::IRC::State;
2             our $AUTHORITY = 'cpan:HINRIK';
3             $POE::Component::IRC::State::VERSION = '6.92';
4 21     21   2196949 use strict;
  21         180  
  21         869  
5 21     21   123 use warnings FATAL => 'all';
  21         44  
  21         1293  
6 21     21   10277 use IRC::Utils qw(uc_irc parse_mode_line normalize_mask);
  21         356918  
  21         2271  
7 21     21   211 use POE;
  21         56  
  21         174  
8 21     21   20762 use POE::Component::IRC::Plugin qw(PCI_EAT_NONE);
  21         63  
  21         1240  
9 21     21   143 use base qw(POE::Component::IRC);
  21         45  
  21         28175  
10              
11             # Event handlers for tracking the STATE. $self->{STATE} is used as our
12             # namespace. uc_irc() is used to create unique keys.
13              
14             # RPL_WELCOME
15             # Make sure we have a clean STATE when we first join the network and if we
16             # inadvertently get disconnected.
17             sub S_001 {
18 28     28 0 7629 my $self = shift;
19 28         253 $self->SUPER::S_001(@_);
20 28         60 shift @_;
21              
22 28         87 delete $self->{STATE};
23 28         77 delete $self->{NETSPLIT};
24 28         132 $self->{STATE}{usermode} = '';
25 28         170 $self->yield(mode => $self->nick_name());
26 28         3733 return PCI_EAT_NONE;
27             }
28              
29             sub S_disconnected {
30 28     28 0 15141 my $self = shift;
31 28         222 $self->SUPER::S_disconnected(@_);
32 28         55 shift @_;
33              
34 28         111 my $nickinfo = $self->nick_info($self->nick_name());
35 28 100       102 $nickinfo = {} if !defined $nickinfo;
36 28         107 my $channels = $self->channels();
37 28         76 push @{ $_[-1] }, $nickinfo, $channels;
  28         92  
38 28         87 return PCI_EAT_NONE;
39             }
40              
41             sub S_error {
42 26     26 0 12817 my $self = shift;
43 26         224 $self->SUPER::S_error(@_);
44 26         56 shift @_;
45              
46 26         111 my $nickinfo = $self->nick_info($self->nick_name());
47 26 100       152 $nickinfo = {} if !defined $nickinfo;
48 26         111 my $channels = $self->channels();
49 26         58 push @{ $_[-1] }, $nickinfo, $channels;
  26         80  
50 26         83 return PCI_EAT_NONE;
51             }
52              
53             sub S_socketerr {
54 0     0 0 0 my ($self, undef) = splice @_, 0, 2;
55 0         0 my $nickinfo = $self->nick_info($self->nick_name());
56 0 0       0 $nickinfo = {} if !defined $nickinfo;
57 0         0 my $channels = $self->channels();
58 0         0 push @{ $_[-1] }, $nickinfo, $channels;
  0         0  
59 0         0 return PCI_EAT_NONE;
60             }
61              
62             sub S_join {
63 53     53 0 17263 my ($self, undef) = splice @_, 0, 2;
64 53         123 my ($nick, $user, $host) = split /[!@]/, ${ $_[0] };
  53         423  
65 53         240 my $map = $self->isupport('CASEMAPPING');
66 53         114 my $chan = ${ $_[1] };
  53         127  
67 53         219 my $uchan = uc_irc($chan, $map);
68 53         779 my $unick = uc_irc($nick, $map);
69              
70 53 100       686 if ($unick eq uc_irc($self->nick_name(), $map)) {
71 34         476 delete $self->{STATE}{Chans}{ $uchan };
72 34         309 $self->{CHANNEL_SYNCH}{ $uchan } = {
73             MODE => 0,
74             WHO => 0,
75             BAN => 0,
76             _time => time(),
77             };
78 34         172 $self->{STATE}{Chans}{ $uchan } = {
79             Name => $chan,
80             Mode => ''
81             };
82              
83             # fake a WHO sync if we're only interested in people's user@host
84             # and the server provides those in the NAMES reply
85 34 50 33     203 if (exists $self->{whojoiners} && !$self->{whojoiners}
      33        
86             && $self->isupport('UHNAMES')) {
87 0         0 $self->_channel_sync($chan, 'WHO');
88             }
89             else {
90 34         150 $self->yield(who => $chan);
91             }
92 34         4208 $self->yield(mode => $chan);
93 34         3647 $self->yield(mode => $chan => 'b');
94             }
95             else {
96             SWITCH: {
97 19         252 my $netsplit = "$unick!$user\@$host";
  19         97  
98 19 100       235 if ( exists $self->{NETSPLIT}{Users}{ $netsplit } ) {
99             # restore state from NETSPLIT if it hasn't expired.
100 1         4 my $nuser = delete $self->{NETSPLIT}{Users}{ $netsplit };
101 1 50       6 if ( ( time - $nuser->{stamp} ) < ( 60 * 60 ) ) {
102 1         5 $self->{STATE}{Nicks}{ $unick } = $nuser->{meta};
103 1         7 $self->send_event_next(irc_nick_sync => $nick, $chan);
104 1         26 last SWITCH;
105             }
106             }
107 18 100 33     206 if ( (!exists $self->{whojoiners} || $self->{whojoiners})
      66        
108             && !exists $self->{STATE}{Nicks}{ $unick }{Real}) {
109 14         85 $self->yield(who => $nick);
110 14         1962 push @{ $self->{NICK_SYNCH}{ $unick } }, $chan;
  14         78  
111             }
112             else {
113             # Fake 'irc_nick_sync'
114 4         22 $self->send_event_next(irc_nick_sync => $nick, $chan);
115             }
116             }
117             }
118              
119 53         3960 $self->{STATE}{Nicks}{ $unick }{Nick} = $nick;
120 53         229 $self->{STATE}{Nicks}{ $unick }{User} = $user;
121 53         157 $self->{STATE}{Nicks}{ $unick }{Host} = $host;
122 53         172 $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan } = '';
123 53         272 $self->{STATE}{Chans}{ $uchan }{Nicks}{ $unick } = '';
124              
125 53         205 return PCI_EAT_NONE;
126             }
127              
128             sub S_chan_sync {
129 31     31 0 5388 my ($self, undef) = splice @_, 0, 2;
130 31         132 my $chan = ${ $_[0] };
  31         98  
131              
132 31 100       140 if ($self->{awaypoll}) {
133 2         19 $poe_kernel->state(_away_sync => $self);
134 2         84 $poe_kernel->delay_add(_away_sync => $self->{awaypoll} => $chan);
135             }
136              
137 31         310 return PCI_EAT_NONE;
138             }
139              
140             sub S_part {
141 5     5 0 3181 my ($self, undef) = splice @_, 0, 2;
142 5         22 my $map = $self->isupport('CASEMAPPING');
143 5         16 my $nick = uc_irc((split /!/, ${ $_[0] } )[0], $map);
  5         29  
144 5         68 my $uchan = uc_irc(${ $_[1] }, $map);
  5         20  
145              
146 5 100       67 if ($nick eq uc_irc($self->nick_name(), $map)) {
147 3         41 delete $self->{STATE}{Nicks}{ $nick }{CHANS}{ $uchan };
148 3         10 delete $self->{STATE}{Chans}{ $uchan }{Nicks}{ $nick };
149              
150 3         8 for my $member ( keys %{ $self->{STATE}{Chans}{ $uchan }{Nicks} } ) {
  3         20  
151 2         9 delete $self->{STATE}{Nicks}{ $member }{CHANS}{ $uchan };
152 2 50       5 if ( keys %{ $self->{STATE}{Nicks}{ $member }{CHANS} } <= 0 ) {
  2         12  
153 2         12 delete $self->{STATE}{Nicks}{ $member };
154             }
155             }
156              
157 3         18 delete $self->{STATE}{Chans}{ $uchan };
158             }
159             else {
160 2         29 delete $self->{STATE}{Nicks}{ $nick }{CHANS}{ $uchan };
161 2         8 delete $self->{STATE}{Chans}{ $uchan }{Nicks}{ $nick };
162 2 50       5 if ( !keys %{ $self->{STATE}{Nicks}{ $nick }{CHANS} } ) {
  2         14  
163 2         12 delete $self->{STATE}{Nicks}{ $nick };
164             }
165             }
166              
167 5         19 return PCI_EAT_NONE;
168             }
169              
170             sub S_quit {
171 3     3 0 1163 my ($self, undef) = splice @_, 0, 2;
172 3         19 my $map = $self->isupport('CASEMAPPING');
173 3         9 my $nick = (split /!/, ${ $_[0] })[0];
  3         22  
174 3         8 my $msg = ${ $_[1] };
  3         9  
175 3         14 my $unick = uc_irc($nick, $map);
176 3         46 my $netsplit = 0;
177              
178 3         9 push @{ $_[-1] }, [ $self->nick_channels( $nick ) ];
  3         19  
179              
180             # Check if it is a netsplit
181 3 100       15 $netsplit = 1 if _is_netsplit( $msg );
182              
183 3 50       17 if ($unick ne uc_irc($self->nick_name(), $map)) {
184 3         43 for my $uchan ( keys %{ $self->{STATE}{Nicks}{ $unick }{CHANS} } ) {
  3         15  
185 4         14 delete $self->{STATE}{Chans}{ $uchan }{Nicks}{ $unick };
186             # No don't stash the channel state.
187             #$self->{NETSPLIT}{Chans}{ $uchan }{NICKS}{ $unick } = $chanstate
188             # if $netsplit;
189             }
190              
191 3         11 my $nickstate = delete $self->{STATE}{Nicks}{ $unick };
192 3 100       19 if ( $netsplit ) {
193 1         4 delete $nickstate->{CHANS};
194 1         15 $self->{NETSPLIT}{Users}{ "$unick!" . join '@', @{$nickstate}{qw(User Host)} } =
  1         6  
195             { meta => $nickstate, stamp => time };
196             }
197             }
198              
199 3         11 return PCI_EAT_NONE;
200             }
201              
202             sub _is_netsplit {
203 3   50 3   13 my $msg = shift || return;
204 3 100       20 return 1 if $msg =~ /^\s*\S+\.[a-z]{2,} \S+\.[a-z]{2,}$/i;
205 2         9 return 0;
206             }
207              
208             sub S_kick {
209 8     8 0 3203 my ($self, undef) = splice @_, 0, 2;
210 8         19 my $chan = ${ $_[1] };
  8         40  
211 8         21 my $nick = ${ $_[2] };
  8         19  
212 8         36 my $map = $self->isupport('CASEMAPPING');
213 8         44 my $unick = uc_irc($nick, $map);
214 8         149 my $uchan = uc_irc($chan, $map);
215              
216 8         97 push @{ $_[-1] }, $self->nick_long_form( $nick );
  8         42  
217              
218 8 100       42 if ( $unick eq uc_irc($self->nick_name(), $map)) {
219 4         63 delete $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan };
220 4         18 delete $self->{STATE}{Chans}{ $uchan }{Nicks}{ $unick };
221              
222 4         12 for my $member ( keys %{ $self->{STATE}{Chans}{ $uchan }{Nicks} } ) {
  4         27  
223 4         17 delete $self->{STATE}{Nicks}{ $member }{CHANS}{ $uchan };
224 4 100       12 if ( keys %{ $self->{STATE}{Nicks}{ $member }{CHANS} } <= 0 ) {
  4         28  
225 3         40 delete $self->{STATE}{Nicks}{ $member };
226             }
227             }
228              
229 4         30 delete $self->{STATE}{Chans}{ $uchan };
230             }
231             else {
232 4         63 delete $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan };
233 4         17 delete $self->{STATE}{Chans}{ $uchan }{Nicks}{ $unick };
234 4 100       11 if ( keys %{ $self->{STATE}{Nicks}{ $unick }{CHANS} } <= 0 ) {
  4         27  
235 3         14 delete $self->{STATE}{Nicks}{ $unick };
236             }
237             }
238              
239 8         36 return PCI_EAT_NONE;
240             }
241              
242             sub S_nick {
243 2     2 0 665 my $self = shift;
244 2         23 $self->SUPER::S_nick(@_);
245 2         5 shift @_;
246              
247 2         4 my $nick = (split /!/, ${ $_[0] })[0];
  2         8  
248 2         5 my $new = ${ $_[1] };
  2         4  
249 2         10 my $map = $self->isupport('CASEMAPPING');
250 2         13 my $unick = uc_irc($nick, $map);
251 2         30 my $unew = uc_irc($new, $map);
252              
253 2         23 push @{ $_[-1] }, [ $self->nick_channels( $nick ) ];
  2         13  
254              
255 2 50       9 if ($unick eq $unew) {
256             # Case Change
257 0         0 $self->{STATE}{Nicks}{ $unick }{Nick} = $new;
258             }
259             else {
260 2         8 my $user = delete $self->{STATE}{Nicks}{ $unick };
261 2         8 $user->{Nick} = $new;
262              
263 2         5 for my $channel ( keys %{ $user->{CHANS} } ) {
  2         8  
264 2         7 $self->{STATE}{Chans}{ $channel }{Nicks}{ $unew } = $user->{CHANS}{ $channel };
265 2         8 delete $self->{STATE}{Chans}{ $channel }{Nicks}{ $unick };
266             }
267              
268 2         6 $self->{STATE}{Nicks}{ $unew } = $user;
269             }
270              
271 2         8 return PCI_EAT_NONE;
272             }
273              
274             sub S_chan_mode {
275 64     64 0 11997 my ($self, undef) = splice @_, 0, 2;
276 64         157 pop @_;
277 64         136 my $who = ${ $_[0] };
  64         171  
278 64         118 my $chan = ${ $_[1] };
  64         135  
279 64         96 my $mode = ${ $_[2] };
  64         146  
280 64 100       205 my $arg = defined $_[3] ? ${ $_[3] } : '';
  26         56  
281 64         221 my $map = $self->isupport('CASEMAPPING');
282 64         197 my $me = uc_irc($self->nick_name(), $map);
283              
284 64 100 100     1316 return PCI_EAT_NONE if $mode !~ /\+[qoah]/ || $me ne uc_irc($arg, $map);
285              
286 1         15 my $excepts = $self->isupport('EXCEPTS');
287 1         4 my $invex = $self->isupport('INVEX');
288 1 50       8 $self->yield(mode => $chan, $excepts ) if $excepts;
289 1 50       186 $self->yield(mode => $chan, $invex ) if $invex;
290              
291 1         109 return PCI_EAT_NONE;
292             }
293              
294             # RPL_UMODEIS
295             sub S_221 {
296 29     29 0 43851 my ($self, undef) = splice @_, 0, 2;
297 29         71 my $mode = ${ $_[1] };
  29         95  
298 29         137 $mode =~ s/^\+//;
299 29         110 $self->{STATE}->{usermode} = $mode;
300 29         88 return PCI_EAT_NONE;
301             }
302              
303             # RPL_CHANNEL_URL
304             sub S_328 {
305 0     0 0 0 my ($self, undef) = splice @_, 0, 2;
306 0         0 my ($chan, $url) = @{ ${ $_[2] } };
  0         0  
  0         0  
307 0         0 my $map = $self->isupport('CASEMAPPING');
308 0         0 my $uchan = uc_irc($chan, $map);
309              
310 0 0       0 return PCI_EAT_NONE if !$self->_channel_exists($chan);
311 0         0 $self->{STATE}{Chans}{ $uchan }{Url} = $url;
312 0         0 return PCI_EAT_NONE;
313             }
314              
315             # RPL_UNAWAY
316             sub S_305 {
317 3     3 0 1232 my ($self, undef) = splice @_, 0, 2;
318 3         9 $self->{STATE}->{away} = 0;
319 3         9 return PCI_EAT_NONE;
320             }
321              
322             # RPL_NOWAWAY
323             sub S_306 {
324 3     3 0 670 my ($self, undef) = splice @_, 0, 2;
325 3         10 $self->{STATE}->{away} = 1;
326 3         10 return PCI_EAT_NONE;
327             }
328              
329             # this code needs refactoring
330             ## no critic (Subroutines::ProhibitExcessComplexity ControlStructures::ProhibitCascadingIfElse)
331             sub S_mode {
332 77     77 0 52967 my ($self, undef) = splice @_, 0, 2;
333 77         417 my $map = $self->isupport('CASEMAPPING');
334 77         156 my $who = ${ $_[0] };
  77         179  
335 77         156 my $chan = ${ $_[1] };
  77         162  
336 77         317 my $uchan = uc_irc($chan, $map);
337 77         1148 pop @_;
338 77         300 my @modes = map { ${ $_ } } @_[2 .. $#_];
  103         186  
  103         416  
339              
340             # CHANMODES is [$list_mode, $always_arg, $arg_when_set, $no_arg]
341             # A $list_mode always has an argument
342 77   50     259 my $prefix = $self->isupport('PREFIX') || { o => '@', v => '+' };
343 77         170 my $statmodes = join '', keys %{ $prefix };
  77         320  
344 77   50     282 my $chanmodes = $self->isupport('CHANMODES') || [ qw(beI k l imnpstaqr) ];
345 77         199 my $alwaysarg = join '', $statmodes, @{ $chanmodes }[0 .. 1];
  77         249  
346              
347             # Do nothing if it is UMODE
348 77 100       339 if ($uchan ne uc_irc($self->nick_name(), $map)) {
349 49         750 my $parsed_mode = parse_mode_line( $prefix, $chanmodes, @modes );
350 49         4036 for my $mode (@{ $parsed_mode->{modes} }) {
  49         162  
351 64         491 my $orig_arg;
352 64 100 33     1363 if (length $chanmodes->[2] && length $alwaysarg && $mode =~ /^(.[$alwaysarg]|\+[$chanmodes->[2]])/) {
      66        
353 26         63 $orig_arg = shift @{ $parsed_mode->{args} };
  26         144  
354             }
355              
356 64         155 my $flag;
357 64         126 my $arg = $orig_arg;
358              
359 64 100 66     3230 if (length $statmodes && (($flag) = $mode =~ /\+([$statmodes])/)) {
    50 33        
    100 66        
    100 66        
    100 66        
    100 66        
    100          
    50          
360 3         12 $arg = uc_irc($arg, $map);
361 3 50 33     56 if (!$self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan } || $self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan } !~ /$flag/) {
362 3         10 $self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan } .= $flag;
363 3         17 $self->{STATE}{Chans}{ $uchan }{Nicks}{ $arg } = $self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan };
364             }
365             }
366             elsif (length $statmodes && (($flag) = $mode =~ /-([$statmodes])/)) {
367 0         0 $arg = uc_irc($arg, $map);
368 0 0       0 if ($self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan } =~ /$flag/) {
369 0         0 $self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan } =~ s/$flag//;
370 0         0 $self->{STATE}{Chans}{ $uchan }{Nicks}{ $arg } = $self->{STATE}{Nicks}{ $arg }{CHANS}{ $uchan };
371             }
372             }
373             elsif (length $chanmodes->[0] && (($flag) = $mode =~ /\+([$chanmodes->[0]])/)) {
374 5         52 $self->{STATE}{Chans}{ $uchan }{Lists}{ $flag }{ $arg } = {
375             SetBy => $who,
376             SetAt => time(),
377             };
378             }
379             elsif (length $chanmodes->[0] && (($flag) = $mode =~ /-([$chanmodes->[0]])/)) {
380 4         27 delete $self->{STATE}{Chans}{ $uchan }{Lists}{ $flag }{ $arg };
381             }
382              
383             # All unhandled modes with arguments
384             elsif (length $chanmodes->[3] && (($flag) = $mode =~ /\+([^$chanmodes->[3]])/)) {
385 12 100       145 $self->{STATE}{Chans}{ $uchan }{Mode} .= $flag if $self->{STATE}{Chans}{ $uchan }{Mode} !~ /$flag/;
386 12         66 $self->{STATE}{Chans}{ $uchan }{ModeArgs}{ $flag } = $arg;
387             }
388             elsif (length $chanmodes->[3] && (($flag) = $mode =~ /-([^$chanmodes->[3]])/)) {
389 4         61 $self->{STATE}{Chans}{ $uchan }{Mode} =~ s/$flag//;
390 4         16 delete $self->{STATE}{Chans}{ $uchan }{ModeArgs}{ $flag };
391             }
392              
393             # Anything else doesn't have arguments so just adjust {Mode} as necessary.
394             elsif (($flag) = $mode =~ /^\+(.)/ ) {
395 34 50       528 $self->{STATE}{Chans}{ $uchan }{Mode} .= $flag if $self->{STATE}{Chans}{ $uchan }{Mode} !~ /$flag/;
396             }
397             elsif (($flag) = $mode =~ /^-(.)/ ) {
398 2         20 $self->{STATE}{Chans}{ $uchan }{Mode} =~ s/$flag//;
399             }
400 64 100       401 $self->send_event_next(irc_chan_mode => $who, $chan, $mode, (defined $orig_arg ? $orig_arg : ()));
401             }
402              
403             # Lets make the channel mode nice
404 49 50       1261 if ( $self->{STATE}{Chans}{ $uchan }{Mode} ) {
405 49         387 $self->{STATE}{Chans}{ $uchan }{Mode} = join('', sort {uc $a cmp uc $b} ( split( //, $self->{STATE}{Chans}{ $uchan }{Mode} ) ) );
  103         502  
406             }
407             }
408             else {
409 28         536 my $parsed_mode = parse_mode_line( @modes );
410 28         1637 for my $mode (@{ $parsed_mode->{modes} }) {
  28         106  
411 28         71 my $flag;
412 28 50       224 if ( ($flag) = $mode =~ /^\+(.)/ ) {
    0          
413 28 50       400 $self->{STATE}{usermode} .= $flag if $self->{STATE}{usermode} !~ /$flag/;
414             }
415             elsif ( ($flag) = $mode =~ /^-(.)/ ) {
416 0         0 $self->{STATE}{usermode} =~ s/$flag//;
417             }
418 28         232 $self->send_event_next(irc_user_mode => $who, $chan, $mode );
419             }
420             }
421              
422 77         1140 return PCI_EAT_NONE;
423             }
424              
425             sub S_topic {
426 5     5 0 5957 my ($self, undef) = splice @_, 0, 2;
427 5         16 my $who = ${ $_[0] };
  5         16  
428 5         12 my $chan = ${ $_[1] };
  5         12  
429 5         11 my $topic = ${ $_[2] };
  5         11  
430 5         28 my $map = $self->isupport('CASEMAPPING');
431 5         21 my $uchan = uc_irc($chan, $map);
432 5         75 push @{ $_[-1] }, $self->{STATE}{Chans}{$uchan}{Topic};
  5         26  
433              
434             $self->{STATE}{Chans}{ $uchan }{Topic} = {
435 5         49 Value => $topic,
436             SetBy => $who,
437             SetAt => time(),
438             };
439              
440 5         33 return PCI_EAT_NONE;
441             }
442              
443             # RPL_NAMES
444             sub S_353 {
445 35     35 0 33480 my ($self, undef) = splice @_, 0, 2;
446 35         96 my @data = @{ ${ $_[2] } };
  35         71  
  35         137  
447 35 50       257 shift @data if $data[0] =~ /^[@=*]$/;
448 35         92 my $chan = shift @data;
449 35         262 my @nicks = split /\s+/, shift @data;
450 35         187 my $map = $self->isupport('CASEMAPPING');
451 35         233 my $uchan = uc_irc($chan, $map);
452 35   50     567 my $prefix = $self->isupport('PREFIX') || { o => '@', v => '+' };
453 35         142 my $search = join '|', map { quotemeta } values %$prefix;
  105         363  
454 35         1218 $search = qr/(?:$search)/;
455              
456 35         162 for my $nick (@nicks) {
457 54         105 my $status;
458 54 100       914 if ( ($status) = $nick =~ /^($search+)/ ) {
459 35         679 $nick =~ s/^($search+)//;
460             }
461              
462 54         180 my ($user, $host);
463 54 50       191 if ($self->isupport('UHNAMES')) {
464 0         0 ($nick, $user, $host) = split /[!@]/, $nick;
465             }
466              
467 54         186 my $unick = uc_irc($nick, $map);
468 54 100       752 $status = '' if !defined $status;
469 54         119 my $whatever = '';
470 54   100     372 my $existing = $self->{STATE}{Nicks}{$unick}{CHANS}{$uchan} || '';
471              
472 54         207 for my $mode (keys %$prefix) {
473 162 100 66     1728 if ($status =~ /\Q$prefix->{$mode}/ && $existing !~ /\Q$prefix->{$mode}/) {
474 35         154 $whatever .= $mode;
475             }
476             }
477              
478 54 100 66     288 $existing .= $whatever if !length $existing || $existing !~ /$whatever/;
479 54         182 $self->{STATE}{Nicks}{$unick}{CHANS}{$uchan} = $existing;
480 54         180 $self->{STATE}{Chans}{$uchan}{Nicks}{$unick} = $existing;
481 54         148 $self->{STATE}{Nicks}{$unick}{Nick} = $nick;
482 54 50       192 if ($self->isupport('UHNAMES')) {
483 0         0 $self->{STATE}{Nicks}{$unick}{User} = $user;
484 0         0 $self->{STATE}{Nicks}{$unick}{Host} = $host;
485             }
486             }
487 35         229 return PCI_EAT_NONE;
488             }
489              
490             # RPL_WHOREPLY
491             sub S_352 {
492 75     75 0 74683 my ($self, undef) = splice @_, 0, 2;
493 75         168 my ($chan, $user, $host, $server, $nick, $status, $rest) = @{ ${ $_[2] } };
  75         137  
  75         355  
494 75         353 my ($hops, $real) = split /\x20/, $rest, 2;
495 75         380 my $map = $self->isupport('CASEMAPPING');
496 75         341 my $unick = uc_irc($nick, $map);
497 75         1107 my $uchan = uc_irc($chan, $map);
498              
499 75         953 $self->{STATE}{Nicks}{ $unick }{Nick} = $nick;
500 75         223 $self->{STATE}{Nicks}{ $unick }{User} = $user;
501 75         185 $self->{STATE}{Nicks}{ $unick }{Host} = $host;
502              
503 75 50 33     361 if ( !exists $self->{whojoiners} || $self->{whojoiners} ) {
504 75         204 $self->{STATE}{Nicks}{ $unick }{Hops} = $hops;
505 75         189 $self->{STATE}{Nicks}{ $unick }{Real} = $real;
506 75         182 $self->{STATE}{Nicks}{ $unick }{Server} = $server;
507 75 100       320 $self->{STATE}{Nicks}{ $unick }{IRCop} = 1 if $status =~ /\*/;
508             }
509              
510 75 100       283 if ( exists $self->{STATE}{Chans}{ $uchan } ) {
511 61         209 my $whatever = '';
512 61   100     286 my $existing = $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan } || '';
513 61   50     235 my $prefix = $self->isupport('PREFIX') || { o => '@', v => '+' };
514              
515 61         134 for my $mode ( keys %{ $prefix } ) {
  61         235  
516 183 100 66     2057 if ($status =~ /\Q$prefix->{$mode}/ && $existing !~ /\Q$prefix->{$mode}/ ) {
517 36         115 $whatever .= $mode;
518             }
519             }
520              
521 61 100 66     459 $existing .= $whatever if !$existing || $existing !~ /$whatever/;
522 61         194 $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan } = $existing;
523 61         179 $self->{STATE}{Chans}{ $uchan }{Nicks}{ $unick } = $existing;
524 61         174 $self->{STATE}{Chans}{ $uchan }{Name} = $chan;
525              
526 61 100 100     266 if ($self->{STATE}{Chans}{ $uchan }{AWAY_SYNCH} && $unick ne uc_irc($self->nick_name(), $map)) {
527 2 100 66     48 if ( $status =~ /G/ && !$self->{STATE}{Nicks}{ $unick }{Away} ) {
    50 33        
528 1         6 $self->send_event_next(irc_user_away => $nick, [ $self->nick_channels( $nick ) ] );
529             }
530             elsif ($status =~ /H/ && $self->{STATE}{Nicks}{ $unick }{Away} ) {
531 1         8 $self->send_event_next(irc_user_back => $nick, [ $self->nick_channels( $nick ) ] );
532             }
533             }
534              
535 61 100       300 if ($self->{awaypoll}) {
536 8 100       41 $self->{STATE}{Nicks}{ $unick }{Away} = $status =~ /G/ ? 1 : 0;
537             }
538             }
539              
540 75         293 return PCI_EAT_NONE;
541             }
542              
543             # RPL_ENDOFWHO
544             sub S_315 {
545 49     49 0 22148 my ($self, undef) = splice @_, 0, 2;
546 49         120 my $what = ${ $_[2] }->[0];
  49         336  
547 49         223 my $map = $self->isupport('CASEMAPPING');
548 49         225 my $uwhat = uc_irc($what, $map);
549              
550 49 100       930 if ( exists $self->{STATE}{Chans}{ $uwhat } ) {
551 35         92 my $chan = $what; my $uchan = $uwhat;
  35         96  
552 35 50       177 if ( $self->_channel_sync($chan, 'WHO') ) {
    100          
553 0         0 my $rec = delete $self->{CHANNEL_SYNCH}{ $uchan };
554 0         0 $self->send_event_next(irc_chan_sync => $chan, time() - $rec->{_time} );
555             }
556             elsif ( $self->{STATE}{Chans}{ $uchan }{AWAY_SYNCH} ) {
557 2         8 $self->{STATE}{Chans}{ $uchan }{AWAY_SYNCH} = 0;
558 2         16 $poe_kernel->delay_add(_away_sync => $self->{awaypoll} => $chan );
559 2         196 $self->send_event_next(irc_away_sync_end => $chan );
560             }
561             }
562             else {
563 14         45 my $nick = $what; my $unick = $uwhat;
  14         36  
564 14         33 my $chan = shift @{ $self->{NICK_SYNCH}{ $unick } };
  14         59  
565 14 50       38 delete $self->{NICK_SYNCH}{ $unick } if !@{ $self->{NICK_SYNCH}{ $unick } };
  14         75  
566 14         83 $self->send_event_next(irc_nick_sync => $nick, $chan );
567             }
568              
569 49         522 return PCI_EAT_NONE;
570             }
571              
572             # RPL_CREATIONTIME
573             sub S_329 {
574 33     33 0 10048 my ($self, undef) = splice @_, 0, 2;
575 33         146 my $map = $self->isupport('CASEMAPPING');
576 33         204 my $chan = ${ $_[2] }->[0];
  33         136  
577 33         77 my $time = ${ $_[2] }->[1];
  33         115  
578 33         130 my $uchan = uc_irc($chan, $map);
579              
580 33         668 $self->{STATE}->{Chans}{ $uchan }{CreationTime} = $time;
581 33         132 return PCI_EAT_NONE;
582             }
583              
584             # RPL_BANLIST
585             sub S_367 {
586 0     0 0 0 my ($self, undef) = splice @_, 0, 2;
587 0         0 my @args = @{ ${ $_[2] } };
  0         0  
  0         0  
588 0         0 my $chan = shift @args;
589 0         0 my $map = $self->isupport('CASEMAPPING');
590 0         0 my $uchan = uc_irc($chan, $map);
591 0         0 my ($mask, $who, $when) = @args;
592              
593 0         0 $self->{STATE}{Chans}{ $uchan }{Lists}{b}{ $mask } = {
594             SetBy => $who,
595             SetAt => $when,
596             };
597 0         0 return PCI_EAT_NONE;
598             }
599              
600             # RPL_ENDOFBANLIST
601             sub S_368 {
602 33     33 0 10015 my ($self, undef) = splice @_, 0, 2;
603 33         97 my @args = @{ ${ $_[2] } };
  33         79  
  33         118  
604 33         126 my $chan = shift @args;
605 33         214 my $map = $self->isupport('CASEMAPPING');
606 33         140 my $uchan = uc_irc($chan, $map);
607              
608 33 100       558 if ($self->_channel_sync($chan, 'BAN')) {
609 31         102 my $rec = delete $self->{CHANNEL_SYNCH}{ $uchan };
610 31         313 $self->send_event_next(irc_chan_sync => $chan, time() - $rec->{_time} );
611             }
612              
613 33         908 return PCI_EAT_NONE;
614             }
615              
616             # RPL_INVITELIST
617             sub S_346 {
618 0     0 0 0 my ($self, undef) = splice @_, 0, 2;
619 0         0 my ($chan, $mask, $who, $when) = @{ ${ $_[2] } };
  0         0  
  0         0  
620 0         0 my $map = $self->isupport('CASEMAPPING');
621 0         0 my $uchan = uc_irc($chan, $map);
622 0         0 my $invex = $self->isupport('INVEX');
623              
624 0         0 $self->{STATE}{Chans}{ $uchan }{Lists}{ $invex }{ $mask } = {
625             SetBy => $who,
626             SetAt => $when
627             };
628              
629 0         0 return PCI_EAT_NONE;
630             }
631              
632             # RPL_ENDOFINVITELIST
633             sub S_347 {
634 1     1 0 1207 my ($self, undef) = splice @_, 0, 2;
635 1         4 my ($chan) = @{ ${ $_[2] } };
  1         3  
  1         4  
636 1         9 my $map = $self->isupport('CASEMAPPING');
637 1         26 my $uchan = uc_irc($chan, $map);
638              
639 1         25 $self->send_event_next(irc_chan_sync_invex => $chan);
640 1         29 return PCI_EAT_NONE;
641             }
642              
643             # RPL_EXCEPTLIST
644             sub S_348 {
645 0     0 0 0 my ($self, undef) = splice @_, 0, 2;
646 0         0 my ($chan, $mask, $who, $when) = @{ ${ $_[2] } };
  0         0  
  0         0  
647 0         0 my $map = $self->isupport('CASEMAPPING');
648 0         0 my $uchan = uc_irc($chan, $map);
649 0         0 my $excepts = $self->isupport('EXCEPTS');
650              
651 0         0 $self->{STATE}{Chans}{ $uchan }{Lists}{ $excepts }{ $mask } = {
652             SetBy => $who,
653             SetAt => $when,
654             };
655 0         0 return PCI_EAT_NONE;
656             }
657              
658             # RPL_ENDOFEXCEPTLIST
659             sub S_349 {
660 1     1 0 1140 my ($self, undef) = splice @_, 0, 2;
661 1         3 my ($chan) = @{ ${ $_[2] } };
  1         2  
  1         4  
662 1         9 my $map = $self->isupport('CASEMAPPING');
663 1         9 my $uchan = uc_irc($chan, $map);
664              
665 1         23 $self->send_event_next(irc_chan_sync_excepts => $chan);
666 1         26 return PCI_EAT_NONE;
667             }
668              
669             # RPL_CHANNELMODEIS
670             sub S_324 {
671 33     33 0 15968 my ($self, undef) = splice @_, 0, 2;
672 33         88 my @args = @{ ${ $_[2] } };
  33         72  
  33         135  
673 33         97 my $chan = shift @args;
674 33         149 my $map = $self->isupport('CASEMAPPING');
675 33         191 my $uchan = uc_irc($chan, $map);
676 33   50     540 my $modes = $self->isupport('CHANMODES') || [ qw(beI k l imnpstaqr) ];
677 33   50     130 my $prefix = $self->isupport('PREFIX') || { o => '@', v => '+' };
678              
679 33         178 my $parsed_mode = parse_mode_line($prefix, $modes, @args);
680 33         3714 for my $mode (@{ $parsed_mode->{modes} }) {
  33         140  
681 74         275 $mode =~ s/\+//;
682 74         159 my $arg = '';
683 74 100       583 if ($mode =~ /[^$modes->[3]]/) {
684             # doesn't match a mode with no args
685 6         12 $arg = shift @{ $parsed_mode->{args} };
  6         20  
686             }
687              
688 74 100       318 if ( $self->{STATE}{Chans}{ $uchan }{Mode} ) {
689 57 100       617 $self->{STATE}{Chans}{ $uchan }{Mode} .= $mode if $self->{STATE}{Chans}{ $uchan }{Mode} !~ /$mode/;
690             }
691             else {
692 17         62 $self->{STATE}{Chans}{ $uchan }{Mode} = $mode;
693             }
694              
695 74 100       484 $self->{STATE}{Chans}{ $uchan }{ModeArgs}{ $mode } = $arg if defined ( $arg );
696             }
697              
698 33 50       184 if ( $self->{STATE}{Chans}{ $uchan }{Mode} ) {
699 33         363 $self->{STATE}{Chans}{ $uchan }{Mode} = join('', sort {uc $a cmp uc $b} split //, $self->{STATE}{Chans}{ $uchan }{Mode} );
  49         301  
700             }
701              
702 33 50       171 if ( $self->_channel_sync($chan, 'MODE') ) {
703 0         0 my $rec = delete $self->{CHANNEL_SYNCH}{ $uchan };
704 0         0 $self->send_event_next(irc_chan_sync => $chan, time() - $rec->{_time} );
705             }
706              
707 33         178 return PCI_EAT_NONE;
708             }
709              
710             # RPL_TOPIC
711             sub S_332 {
712 4     4 0 1100 my ($self, undef) = splice @_, 0, 2;
713 4         10 my $chan = ${ $_[2] }->[0];
  4         50  
714 4         12 my $topic = ${ $_[2] }->[1];
  4         14  
715 4         25 my $map = $self->isupport('CASEMAPPING');
716 4         23 my $uchan = uc_irc($chan, $map);
717              
718 4         85 $self->{STATE}{Chans}{ $uchan }{Topic}{Value} = $topic;
719 4         14 return PCI_EAT_NONE;
720             }
721              
722             # RPL_TOPICWHOTIME
723             sub S_333 {
724 4     4 0 1195 my ($self, undef) = splice @_, 0, 2;
725 4         13 my ($chan, $who, $when) = @{ ${ $_[2] } };
  4         10  
  4         18  
726 4         19 my $map = $self->isupport('CASEMAPPING');
727 4         20 my $uchan = uc_irc($chan, $map);
728              
729 4         62 $self->{STATE}{Chans}{ $uchan }{Topic}{SetBy} = $who;
730 4         12 $self->{STATE}{Chans}{ $uchan }{Topic}{SetAt} = $when;
731              
732 4         13 return PCI_EAT_NONE;
733             }
734              
735             # Methods for STATE query
736             # Internal methods begin with '_'
737             #
738              
739             sub umode {
740 2     2 1 5 my ($self) = @_;
741 2         34 return $self->{STATE}{usermode};
742             }
743              
744             sub is_user_mode_set {
745 2     2 1 183 my ($self, $mode) = @_;
746              
747 2 50       8 if (!defined $mode) {
748 0         0 warn 'User mode is undefined';
749 0         0 return;
750             }
751              
752 2   50     10 $mode = (split //, $mode)[0] || return;
753 2         7 $mode =~ s/[^A-Za-z]//g;
754 2 50       5 return if !$mode;
755              
756 2 50       42 return 1 if $self->{STATE}{usermode} =~ /$mode/;
757 0         0 return;
758             }
759              
760             sub _away_sync {
761 2     2   1987380 my ($self, $chan) = @_[OBJECT, ARG0];
762 2         20 my $map = $self->isupport('CASEMAPPING');
763 2         24 my $uchan = uc_irc($chan, $map);
764              
765 2         53 $self->{STATE}{Chans}{ $uchan }{AWAY_SYNCH} = 1;
766 2         21 $self->yield(who => $chan);
767 2         413 $self->send_event(irc_away_sync_start => $chan);
768              
769 2         251 return;
770             }
771              
772             sub _channel_sync {
773 101     101   304 my ($self, $chan, $sync) = @_;
774 101         288 my $map = $self->isupport('CASEMAPPING');
775 101         303 my $uchan = uc_irc($chan, $map);
776              
777 101 100 100     1354 return if !$self->_channel_exists($chan) || !defined $self->{CHANNEL_SYNCH}{ $uchan };
778 95 50       387 $self->{CHANNEL_SYNCH}{ $uchan }{ $sync } = 1 if $sync;
779              
780 95         238 for my $item ( qw(BAN MODE WHO) ) {
781 157 100       689 return if !$self->{CHANNEL_SYNCH}{ $uchan }{ $item };
782             }
783              
784 31         107 return 1;
785             }
786              
787             sub _nick_exists {
788 162     162   373 my ($self, $nick) = @_;
789 162         380 my $map = $self->isupport('CASEMAPPING');
790 162         383 my $unick = uc_irc($nick, $map);
791              
792 162 100       2264 return 1 if exists $self->{STATE}{Nicks}{ $unick };
793 20         135 return;
794             }
795              
796             sub _channel_exists {
797 137     137   327 my ($self, $chan) = @_;
798 137         372 my $map = $self->isupport('CASEMAPPING');
799 137         382 my $uchan = uc_irc($chan, $map);
800              
801 137 100       2317 return 1 if exists $self->{STATE}{Chans}{ $uchan };
802 1         7 return;
803             }
804              
805             sub _nick_has_channel_mode {
806 8     8   22 my ($self, $chan, $nick, $flag) = @_;
807 8         26 my $map = $self->isupport('CASEMAPPING');
808 8         86 my $uchan = uc_irc($chan, $map);
809 8         105 my $unick = uc_irc($nick, $map);
810 8         91 $flag = (split //, $flag)[0];
811              
812 8 50       37 return if !$self->is_channel_member($uchan, $unick);
813 8 100       128 return 1 if $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan } =~ /$flag/;
814 7         31 return;
815             }
816              
817             # Returns all the channels that the bot is on with an indication of
818             # whether it has operator, halfop or voice.
819             sub channels {
820 66     66 1 170 my ($self) = @_;
821 66         211 my $map = $self->isupport('CASEMAPPING');
822 66         243 my $unick = uc_irc($self->nick_name(), $map);
823              
824 66         743 my %result;
825 66 100 100     253 if (defined $unick && $self->_nick_exists($unick)) {
826 56         116 for my $uchan ( keys %{ $self->{STATE}{Nicks}{ $unick }{CHANS} } ) {
  56         239  
827 67         299 $result{ $self->{STATE}{Chans}{ $uchan }{Name} } = $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan };
828             }
829             }
830              
831 66         355 return \%result;
832             }
833              
834             sub nicks {
835 2     2 1 2469 my ($self) = @_;
836 2         5 return map { $self->{STATE}{Nicks}{$_}{Nick} } keys %{ $self->{STATE}{Nicks} };
  2         11  
  2         11  
837             }
838              
839             sub nick_info {
840 58     58 1 2772 my ($self, $nick) = @_;
841              
842 58 50       187 if (!defined $nick) {
843 0         0 warn 'Nickname is undefined';
844 0         0 return;
845             }
846              
847 58         200 my $map = $self->isupport('CASEMAPPING');
848 58         218 my $unick = uc_irc($nick, $map);
849              
850 58 100       885 return if !$self->_nick_exists($nick);
851              
852 49         141 my $user = $self->{STATE}{Nicks}{ $unick };
853 49         168 my %result = %{ $user };
  49         412  
854              
855             # maybe we haven't synced this user's info yet
856 49 50 33     325 if (defined $result{User} && defined $result{Host}) {
857 49         378 $result{Userhost} = "$result{User}\@$result{Host}";
858             }
859 49         117 delete $result{'CHANS'};
860              
861 49         150 return \%result;
862             }
863              
864             sub nick_long_form {
865 16     16 1 55 my ($self, $nick) = @_;
866              
867 16 50       60 if (!defined $nick) {
868 0         0 warn 'Nickname is undefined';
869 0         0 return;
870             }
871              
872 16         59 my $map = $self->isupport('CASEMAPPING');
873 16         58 my $unick = uc_irc($nick, $map);
874              
875 16 50       234 return if !$self->_nick_exists($nick);
876              
877 16         47 my $user = $self->{STATE}{Nicks}{ $unick };
878 16 50 33     134 return unless exists $user->{User} && exists $user->{Host};
879 16         115 return "$user->{Nick}!$user->{User}\@$user->{Host}";
880             }
881              
882             sub nick_channels {
883 10     10 1 156 my ($self, $nick) = @_;
884              
885 10 50       44 if (!defined $nick) {
886 0         0 warn 'Nickname is undefined';
887 0         0 return;
888             }
889 10         39 my $map = $self->isupport('CASEMAPPING');
890 10         47 my $unick = uc_irc($nick, $map);
891              
892 10 50       144 return if !$self->_nick_exists($nick);
893 10         25 return map { $self->{STATE}{Chans}{$_}{Name} } keys %{ $self->{STATE}{Nicks}{ $unick }{CHANS} };
  11         73  
  10         135  
894             }
895              
896             sub channel_list {
897 6     6 1 168 my ($self, $chan) = @_;
898              
899 6 50       24 if (!defined $chan) {
900 0         0 warn 'Channel is undefined';
901 0         0 return;
902             }
903              
904 6         36 my $map = $self->isupport('CASEMAPPING');
905 6         34 my $uchan = uc_irc($chan, $map);
906              
907 6 50       77 return if !$self->_channel_exists($chan);
908 6         19 return map { $self->{STATE}{Nicks}{$_}{Nick} } keys %{ $self->{STATE}{Chans}{ $uchan }{Nicks} };
  9         52  
  6         35  
909             }
910              
911             sub is_away {
912 4     4 1 12 my ($self, $nick) = @_;
913              
914 4 50       17 if (!defined $nick) {
915 0         0 warn 'Nickname is undefined';
916 0         0 return;
917             }
918              
919 4         19 my $map = $self->isupport('CASEMAPPING');
920 4         18 my $unick = uc_irc($nick, $map);
921              
922 4 50       55 if ($unick eq uc_irc($self->nick_name())) {
923             # more accurate
924 4 100       60 return 1 if $self->{STATE}{away};
925 3         16 return;
926             }
927              
928 0 0       0 return if !$self->_nick_exists($nick);
929 0 0       0 return 1 if $self->{STATE}{Nicks}{ $unick }{Away};
930 0         0 return;
931             }
932              
933             sub is_operator {
934 2     2 1 7 my ($self, $nick) = @_;
935              
936 2 50       9 if (!defined $nick) {
937 0         0 warn 'Nickname is undefined';
938 0         0 return;
939             }
940              
941 2         18 my $map = $self->isupport('CASEMAPPING');
942 2         25 my $unick = uc_irc($nick, $map);
943              
944 2 50       35 return if !$self->_nick_exists($nick);
945              
946 0 0       0 return 1 if $self->{STATE}{Nicks}{ $unick }{IRCop};
947 0         0 return;
948             }
949              
950             sub is_channel_mode_set {
951 8     8 1 115 my ($self, $chan, $mode) = @_;
952              
953 8 50 33     43 if (!defined $chan || !defined $mode) {
954 0         0 warn 'Channel or mode is undefined';
955 0         0 return;
956             }
957              
958 8         25 my $map = $self->isupport('CASEMAPPING');
959 8         34 my $uchan = uc_irc($chan, $map);
960 8         101 $mode = (split //, $mode)[0];
961              
962 8 50 33     27 return if !$self->_channel_exists($chan) || !$mode;
963 8         29 $mode =~ s/[^A-Za-z]//g;
964              
965 8 100 66     118 if (defined $self->{STATE}{Chans}{ $uchan }{Mode}
966             && $self->{STATE}{Chans}{ $uchan }{Mode} =~ /$mode/) {
967 2         19 return 1;
968             }
969              
970 6         63 return;
971             }
972              
973             sub is_channel_synced {
974 0     0 1 0 my ($self, $chan) = @_;
975              
976 0 0       0 if (!defined $chan) {
977 0         0 warn 'Channel is undefined';
978 0         0 return;
979             }
980              
981 0         0 return $self->_channel_sync($chan);
982             }
983              
984             sub channel_creation_time {
985 2     2 1 2070 my ($self, $chan) = @_;
986              
987 2 50       11 if (!defined $chan) {
988 0         0 warn 'Channel is undefined';
989 0         0 return;
990             }
991              
992 2         9 my $map = $self->isupport('CASEMAPPING');
993 2         9 my $uchan = uc_irc($chan, $map);
994              
995 2 50       29 return if !$self->_channel_exists($chan);
996 2 50       9 return if !exists $self->{STATE}{Chans}{ $uchan }{CreationTime};
997              
998 2         14 return $self->{STATE}{Chans}{ $uchan }{CreationTime};
999             }
1000              
1001             sub channel_limit {
1002 3     3 1 10 my ($self, $chan) = @_;
1003              
1004 3 50       13 if (!defined $chan) {
1005 0         0 warn 'Channel is undefined';
1006 0         0 return;
1007             }
1008              
1009 3         13 my $map = $self->isupport('CASEMAPPING');
1010 3         12 my $uchan = uc_irc($chan, $map);
1011              
1012 3 50       38 return if !$self->_channel_exists($chan);
1013              
1014 3 100 66     12 if ( $self->is_channel_mode_set($chan, 'l')
1015             && defined $self->{STATE}{Chans}{ $uchan }{ModeArgs}{l} ) {
1016 1         7 return $self->{STATE}{Chans}{ $uchan }{ModeArgs}{l};
1017             }
1018              
1019 2         12 return;
1020             }
1021              
1022             sub channel_key {
1023 2     2 1 6 my ($self, $chan) = @_;
1024              
1025 2 50       6 if (!defined $chan) {
1026 0         0 warn 'Channel is undefined';
1027 0         0 return;
1028             }
1029              
1030 2         7 my $map = $self->isupport('CASEMAPPING');
1031 2         7 my $uchan = uc_irc($chan, $map);
1032 2 50       26 return if !$self->_channel_exists($chan);
1033              
1034 2 50 33     8 if ( $self->is_channel_mode_set($chan, 'k')
1035             && defined $self->{STATE}{Chans}{ $uchan }{ModeArgs}{k} ) {
1036 0         0 return $self->{STATE}{Chans}{ $uchan }{ModeArgs}{k};
1037             }
1038              
1039 2         25 return;
1040             }
1041              
1042             sub channel_modes {
1043 0     0 1 0 my ($self, $chan) = @_;
1044              
1045 0 0       0 if (!defined $chan) {
1046 0         0 warn 'Channel is undefined';
1047 0         0 return;
1048             }
1049              
1050 0         0 my $map = $self->isupport('CASEMAPPING');
1051 0         0 my $uchan = uc_irc($chan, $map);
1052 0 0       0 return if !$self->_channel_exists($chan);
1053              
1054 0         0 my %modes;
1055 0 0       0 if ( defined $self->{STATE}{Chans}{ $uchan }{Mode} ) {
1056 0         0 %modes = map { ($_ => '') } split(//, $self->{STATE}{Chans}{ $uchan }{Mode});
  0         0  
1057             }
1058 0 0       0 if ( defined $self->{STATE}{Chans}{ $uchan }->{ModeArgs} ) {
1059 0         0 my %args = %{ $self->{STATE}{Chans}{ $uchan }{ModeArgs} };
  0         0  
1060 0         0 @modes{keys %args} = values %args;
1061             }
1062              
1063 0         0 return \%modes;
1064             }
1065              
1066             sub is_channel_member {
1067 11     11 1 1390 my ($self, $chan, $nick) = @_;
1068              
1069 11 50 33     57 if (!defined $chan || !defined $nick) {
1070 0         0 warn 'Channel or nickname is undefined';
1071 0         0 return;
1072             }
1073              
1074 11         52 my $map = $self->isupport('CASEMAPPING');
1075 11         41 my $uchan = uc_irc($chan, $map);
1076 11         139 my $unick = uc_irc($nick, $map);
1077              
1078 11 50 33     122 return if !$self->_channel_exists($chan) || !$self->_nick_exists($nick);
1079 11 50       56 return 1 if defined $self->{STATE}{Chans}{ $uchan }{Nicks}{ $unick };
1080 0         0 return;
1081             }
1082              
1083             sub is_channel_operator {
1084 4     4 1 16 my ($self, $chan, $nick) = @_;
1085              
1086 4 50 33     30 if (!defined $chan || !defined $nick) {
1087 0         0 warn 'Channel or nickname is undefined';
1088 0         0 return;
1089             }
1090              
1091 4 100       19 return 1 if $self->_nick_has_channel_mode($chan, $nick, 'o');
1092 3         157 return;
1093             }
1094              
1095             sub has_channel_voice {
1096 2     2 1 9 my ($self, $chan, $nick) = @_;
1097              
1098 2 50 33     16 if (!defined $chan || !defined $nick) {
1099 0         0 warn 'Channel or nickname is undefined';
1100 0         0 return;
1101             }
1102              
1103 2 50       8 return 1 if $self->_nick_has_channel_mode($chan, $nick, 'v');
1104 2         10 return;
1105             }
1106              
1107             sub is_channel_halfop {
1108 2     2 1 10 my ($self, $chan, $nick) = @_;
1109              
1110 2 50 33     18 if (!defined $chan || !defined $nick) {
1111 0         0 warn 'Channel or nickname is undefined';
1112 0         0 return;
1113             }
1114              
1115 2 50       8 return 1 if $self->_nick_has_channel_mode($chan, $nick, 'h');
1116 2         9 return;
1117             }
1118              
1119             sub is_channel_owner {
1120 0     0 1 0 my ($self, $chan, $nick) = @_;
1121              
1122 0 0 0     0 if (!defined $chan || !defined $nick) {
1123 0         0 warn 'Channel or nickname is undefined';
1124 0         0 return;
1125             }
1126              
1127 0 0       0 return 1 if $self->_nick_has_channel_mode($chan, $nick, 'q');
1128 0         0 return;
1129             }
1130              
1131             sub is_channel_admin {
1132 0     0 1 0 my ($self, $chan, $nick) = @_;
1133              
1134 0 0 0     0 if (!defined $chan || !defined $nick) {
1135 0         0 warn 'Channel or nickname is undefined';
1136 0         0 return;
1137             }
1138              
1139 0 0       0 return 1 if $self->_nick_has_channel_mode($chan, $nick, 'a');
1140 0         0 return;
1141             }
1142              
1143             sub ban_mask {
1144 2     2 1 7 my ($self, $chan, $mask) = @_;
1145              
1146 2 50 33     24 if (!defined $chan || !defined $mask) {
1147 0         0 warn 'Channel or mask is undefined';
1148 0         0 return;
1149             }
1150              
1151 2         9 my $map = $self->isupport('CASEMAPPING');
1152 2         9 $mask = normalize_mask($mask);
1153 2         72 my @result;
1154              
1155 2 50       8 return if !$self->_channel_exists($chan);
1156              
1157             # Convert the mask from IRC to regex.
1158 2         6 $mask = uc_irc($mask, $map);
1159 2         23 $mask = quotemeta $mask;
1160 2         30 $mask =~ s/\\\*/[\x01-\xFF]{0,}/g;
1161 2         7 $mask =~ s/\\\?/[\x01-\xFF]{1,1}/g;
1162              
1163 2         10 for my $nick ( $self->channel_list($chan) ) {
1164 3 100       61 push @result, $nick if uc_irc($self->nick_long_form($nick)) =~ /^$mask$/;
1165             }
1166              
1167 2         407 return @result;
1168             }
1169              
1170              
1171             sub channel_ban_list {
1172 0     0 1 0 my ($self, $chan) = @_;
1173              
1174 0 0       0 if (!defined $chan) {
1175 0         0 warn 'Channel is undefined';
1176 0         0 return;
1177             }
1178              
1179 0         0 my $map = $self->isupport('CASEMAPPING');
1180 0         0 my $uchan = uc_irc($chan, $map);
1181 0         0 my %result;
1182              
1183 0 0       0 return if !$self->_channel_exists($chan);
1184              
1185 0 0       0 if ( defined $self->{STATE}{Chans}{ $uchan }{Lists}{b} ) {
1186 0         0 %result = %{ $self->{STATE}{Chans}{ $uchan }{Lists}{b} };
  0         0  
1187             }
1188              
1189 0         0 return \%result;
1190             }
1191              
1192             sub channel_except_list {
1193 0     0 1 0 my ($self, $chan) = @_;
1194              
1195 0 0       0 if (!defined $chan) {
1196 0         0 warn 'Channel is undefined';
1197 0         0 return;
1198             }
1199              
1200 0         0 my $map = $self->isupport('CASEMAPPING');
1201 0         0 my $uchan = uc_irc($chan, $map);
1202 0         0 my $excepts = $self->isupport('EXCEPTS');
1203 0         0 my %result;
1204              
1205 0 0       0 return if !$self->_channel_exists($chan);
1206              
1207 0 0       0 if ( defined $self->{STATE}{Chans}{ $uchan }{Lists}{ $excepts } ) {
1208 0         0 %result = %{ $self->{STATE}{Chans}{ $uchan }{Lists}{ $excepts } };
  0         0  
1209             }
1210              
1211 0         0 return \%result;
1212             }
1213              
1214             sub channel_invex_list {
1215 0     0 1 0 my ($self, $chan) = @_;
1216              
1217 0 0       0 if (!defined $chan) {
1218 0         0 warn 'Channel is undefined';
1219 0         0 return;
1220             }
1221              
1222 0         0 my $map = $self->isupport('CASEMAPPING');
1223 0         0 my $uchan = uc_irc($chan, $map);
1224 0         0 my $invex = $self->isupport('INVEX');
1225 0         0 my %result;
1226              
1227 0 0       0 return if !$self->_channel_exists($chan);
1228              
1229 0 0       0 if ( defined $self->{STATE}{Chans}{ $uchan }{Lists}{ $invex } ) {
1230 0         0 %result = %{ $self->{STATE}{Chans}{ $uchan }{Lists}{ $invex } };
  0         0  
1231             }
1232              
1233 0         0 return \%result;
1234             }
1235              
1236             sub channel_topic {
1237 2     2 1 120 my ($self, $chan) = @_;
1238              
1239 2 50       8 if (!defined $chan) {
1240 0         0 warn 'Channel is undefined';
1241 0         0 return;
1242             }
1243              
1244 2         8 my $map = $self->isupport('CASEMAPPING');
1245 2         8 my $uchan = uc_irc($chan, $map);
1246 2         23 my %result;
1247              
1248 2 50       10 return if !$self->_channel_exists($chan);
1249              
1250 2 100       8 if ( defined $self->{STATE}{Chans}{ $uchan }{Topic} ) {
1251 1         2 %result = %{ $self->{STATE}{Chans}{ $uchan }{Topic} };
  1         5  
1252             }
1253              
1254 2         9 return \%result;
1255             }
1256              
1257             sub channel_url {
1258 0     0 1   my ($self, $chan) = @_;
1259              
1260 0 0         if (!defined $chan) {
1261 0           warn 'Channel is undefined';
1262 0           return;
1263             }
1264              
1265 0           my $map = $self->isupport('CASEMAPPING');
1266 0           my $uchan = uc_irc($chan, $map);
1267              
1268 0 0         return if !$self->_channel_exists($chan);
1269 0           return $self->{STATE}{Chans}{ $uchan }{Url};
1270             }
1271              
1272             sub nick_channel_modes {
1273 0     0 1   my ($self, $chan, $nick) = @_;
1274              
1275 0 0 0       if (!defined $chan || !defined $nick) {
1276 0           warn 'Channel or nick is undefined';
1277 0           return;
1278             }
1279              
1280 0           my $map = $self->isupport('CASEMAPPING');
1281 0           my $uchan = uc_irc($chan, $map);
1282 0           my $unick = uc_irc($nick, $map);
1283              
1284 0 0         return if !$self->is_channel_member($chan, $nick);
1285              
1286 0           return $self->{STATE}{Nicks}{ $unick }{CHANS}{ $uchan };
1287             }
1288              
1289             1;
1290              
1291             =encoding utf8
1292              
1293             =head1 NAME
1294              
1295             POE::Component::IRC::State - A fully event-driven IRC client module with
1296             nickname and channel tracking
1297              
1298             =head1 SYNOPSIS
1299              
1300             # A simple Rot13 'encryption' bot
1301              
1302             use strict;
1303             use warnings;
1304             use POE qw(Component::IRC::State);
1305              
1306             my $nickname = 'Flibble' . $$;
1307             my $ircname = 'Flibble the Sailor Bot';
1308             my $ircserver = 'irc.blahblahblah.irc';
1309             my $port = 6667;
1310              
1311             my @channels = ( '#Blah', '#Foo', '#Bar' );
1312              
1313             # We create a new PoCo-IRC object and component.
1314             my $irc = POE::Component::IRC::State->spawn(
1315             nick => $nickname,
1316             server => $ircserver,
1317             port => $port,
1318             ircname => $ircname,
1319             ) or die "Oh noooo! $!";
1320              
1321             POE::Session->create(
1322             package_states => [
1323             main => [ qw(_default _start irc_001 irc_public) ],
1324             ],
1325             heap => { irc => $irc },
1326             );
1327              
1328             $poe_kernel->run();
1329              
1330             sub _start {
1331             my ($kernel, $heap) = @_[KERNEL, HEAP];
1332              
1333             # We get the session ID of the component from the object
1334             # and register and connect to the specified server.
1335             my $irc_session = $heap->{irc}->session_id();
1336             $kernel->post( $irc_session => register => 'all' );
1337             $kernel->post( $irc_session => connect => { } );
1338             return;
1339             }
1340              
1341             sub irc_001 {
1342             my ($kernel, $sender) = @_[KERNEL, SENDER];
1343              
1344             # Get the component's object at any time by accessing the heap of
1345             # the SENDER
1346             my $poco_object = $sender->get_heap();
1347             print "Connected to ", $poco_object->server_name(), "\n";
1348              
1349             # In any irc_* events SENDER will be the PoCo-IRC session
1350             $kernel->post( $sender => join => $_ ) for @channels;
1351             return;
1352             }
1353              
1354             sub irc_public {
1355             my ($kernel ,$sender, $who, $where, $what) = @_[KERNEL, SENDER, ARG0 .. ARG2];
1356             my $nick = ( split /!/, $who )[0];
1357             my $channel = $where->[0];
1358             my $poco_object = $sender->get_heap();
1359              
1360             if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) {
1361             # Only operators can issue a rot13 command to us.
1362             return if !$poco_object->is_channel_operator( $channel, $nick );
1363              
1364             $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
1365             $kernel->post( $sender => privmsg => $channel => "$nick: $rot13" );
1366             }
1367             return;
1368             }
1369              
1370             # We registered for all events, this will produce some debug info.
1371             sub _default {
1372             my ($event, $args) = @_[ARG0 .. $#_];
1373             my @output = ( "$event: " );
1374              
1375             for my $arg ( @$args ) {
1376             if (ref $arg eq 'ARRAY') {
1377             push( @output, '[' . join(', ', @$arg ) . ']' );
1378             }
1379             else {
1380             push ( @output, "'$arg'" );
1381             }
1382             }
1383             print join ' ', @output, "\n";
1384             return 0;
1385             }
1386              
1387             =head1 DESCRIPTION
1388              
1389             POE::Component::IRC::State is a sub-class of L
1390             which tracks IRC state entities such as nicks and channels. See the
1391             documentation for L for general usage.
1392             This document covers the extra methods that POE::Component::IRC::State provides.
1393              
1394             The component tracks channels and nicks, so that it always has a current
1395             snapshot of what channels it is on and who else is on those channels. The
1396             returned object provides methods to query the collected state.
1397              
1398             =head1 CONSTRUCTORS
1399              
1400             POE::Component::IRC::State's constructors, and its C event, all
1401             take the same arguments as L does, as
1402             well as two additional ones:
1403              
1404             B<'AwayPoll'>, the interval (in seconds) in which to poll (i.e. C)
1405             the away status of channel members. Defaults to 0 (disabled). If enabled, you
1406             will receive C / L|/irc_user_away> /
1407             L|/irc_user_back> events, and will be able to use the
1408             L|/is_away> method for users other than yourself. This can cause
1409             a lot of increase in traffic, especially if you are on big channels, so if you
1410             do use this, you probably don't want to set it too low. For reference, X-Chat
1411             uses 300 seconds (5 minutes).
1412              
1413             B<'WhoJoiners'>, a boolean indicating whether the component should send a
1414             C for every person which joins a channel. Defaults to on
1415             (the C is sent). If you turn this off, L|/is_operator>
1416             will not work and L|/nick_info> will only return the keys
1417             B<'Nick'>, B<'User'>, B<'Host'> and B<'Userhost'>.
1418              
1419             =head1 METHODS
1420              
1421             All of the L methods are supported,
1422             plus the following:
1423              
1424             =head2 C
1425              
1426             Expects a channel and a ban mask, as passed to MODE +b-b. Returns a list of
1427             nicks on that channel that match the specified ban mask or an empty list if
1428             the channel doesn't exist in the state or there are no matches.
1429              
1430             =head2 C
1431              
1432             Expects a channel as a parameter. Returns a hashref containing the banlist
1433             if the channel is in the state, a false value if not. The hashref keys are the
1434             entries on the list, each with the keys B<'SetBy'> and B<'SetAt'>. These keys
1435             will hold the nick!hostmask of the user who set the entry (or just the nick
1436             if it's all the ircd gives us), and the time at which it was set respectively.
1437              
1438             =head2 C
1439              
1440             Expects a channel as parameter. Returns channel creation time or a false value.
1441              
1442             =head2 C
1443              
1444             Expects a channel as a parameter. Returns a hashref containing the ban
1445             exception list if the channel is in the state, a false value if not. The
1446             hashref keys are the entries on the list, each with the keys B<'SetBy'> and
1447             B<'SetAt'>. These keys will hold the nick!hostmask of the user who set the
1448             entry (or just the nick if it's all the ircd gives us), and the time at which
1449             it was set respectively.
1450              
1451             =head2 C
1452              
1453             Expects a channel as a parameter. Returns a hashref containing the invite
1454             exception list if the channel is in the state, a false value if not. The
1455             hashref keys are the entries on the list, each with the keys B<'SetBy'> and
1456             B<'SetAt'>. These keys will hold the nick!hostmask of the user who set the
1457             entry (or just the nick if it's all the ircd gives us), and the time at which
1458             it was set respectively.
1459              
1460             =head2 C
1461              
1462             Expects a channel as parameter. Returns the channel key or a false value.
1463              
1464             =head2 C
1465              
1466             Expects a channel as parameter. Returns the channel limit or a false value.
1467              
1468             =head2 C
1469              
1470             Expects a channel as parameter. Returns a list of all nicks on the specified
1471             channel. If the component happens to not be on that channel an empty list will
1472             be returned.
1473              
1474             =head2 C
1475              
1476             Expects a channel as parameter. Returns a hash ref keyed on channel mode, with
1477             the mode argument (if any) as the value. Returns a false value instead if the
1478             channel is not in the state.
1479              
1480             =head2 C
1481              
1482             Takes no parameters. Returns a hashref, keyed on channel name and whether the
1483             bot is operator, halfop or
1484             has voice on that channel.
1485              
1486             for my $channel ( keys %{ $irc->channels() } ) {
1487             $irc->yield( 'privmsg' => $channel => 'm00!' );
1488             }
1489              
1490             =head2 C
1491              
1492             Expects a channel as a parameter. Returns a hashref containing topic
1493             information if the channel is in the state, a false value if not. The hashref
1494             contains the following keys: B<'Value'>, B<'SetBy'>, B<'SetAt'>. These keys
1495             will hold the topic itself, the nick!hostmask of the user who set it (or just
1496             the nick if it's all the ircd gives us), and the time at which it was set
1497             respectively.
1498              
1499             If the component happens to not be on the channel, nothing will be returned.
1500              
1501             =head2 C
1502              
1503             Expects a channel as a parameter. Returns the channel's URL. If the channel
1504             has no URL or the component is not on the channel, nothing will be returned.
1505              
1506             =head2 C
1507              
1508             Expects a channel and a nickname as parameters. Returns a true value if
1509             the nick has voice on the specified channel. Returns false if the nick does
1510             not have voice on the channel or if the nick/channel does not exist in the state.
1511              
1512             =head2 C
1513              
1514             Expects a nick as parameter. Returns a true value if the specified nick is away.
1515             Returns a false value if the nick is not away or not in the state. This will
1516             only work for your IRC user unless you specified a value for B<'AwayPoll'> in
1517             L|POE::Component::IRC/spawn>.
1518              
1519             =head2 C
1520              
1521             Expects a channel and a nickname as parameters. Returns a true value if
1522             the nick is an admin on the specified channel. Returns false if the nick is
1523             not an admin on the channel or if the nick/channel does not exist in the state.
1524              
1525             =head2 C
1526              
1527             Expects a channel and a nickname as parameters. Returns a true value if
1528             the nick is a half-operator on the specified channel. Returns false if the nick
1529             is not a half-operator on the channel or if the nick/channel does not exist in
1530             the state.
1531              
1532             =head2 C
1533              
1534             Expects a channel and a nickname as parameters. Returns a true value if
1535             the nick is on the specified channel. Returns false if the nick is not on the
1536             channel or if the nick/channel does not exist in the state.
1537              
1538             =head2 C
1539              
1540             Expects a channel and a single mode flag C<[A-Za-z]>. Returns a true value
1541             if that mode is set on the channel.
1542              
1543             =head2 C
1544              
1545             Expects a channel and a nickname as parameters. Returns a true value if
1546             the nick is an operator on the specified channel. Returns false if the nick is
1547             not an operator on the channel or if the nick/channel does not exist in the state.
1548              
1549             =head2 C
1550              
1551             Expects a channel and a nickname as parameters. Returns a true value if
1552             the nick is an owner on the specified channel. Returns false if the nick is
1553             not an owner on the channel or if the nick/channel does not exist in the state.
1554              
1555             =head2 C
1556              
1557             Expects a channel as a parameter. Returns true if the channel has been synced.
1558             Returns false if it has not been synced or if the channel is not in the state.
1559              
1560             =head2 C
1561              
1562             Expects a nick as parameter. Returns a true value if the specified nick is
1563             an IRC operator. Returns a false value if the nick is not an IRC operator
1564             or is not in the state.
1565              
1566             =head2 C
1567              
1568             Expects single user mode flag C<[A-Za-z]>. Returns a true value if that user
1569             mode is set.
1570              
1571             =head2 C
1572              
1573             Expects a channel and a nickname as parameters. Returns the modes of the
1574             specified nick on the specified channel (ie. qaohv). If the nick is not on the
1575             channel in the state, a false value will be returned.
1576              
1577             =head2 C
1578              
1579             Expects a nickname. Returns a list of the channels that that nickname and the
1580             component are on. An empty list will be returned if the nickname does not
1581             exist in the state.
1582              
1583             =head2 C
1584              
1585             Expects a nickname. Returns a hashref containing similar information to that
1586             returned by WHOIS. Returns a false value if the nickname doesn't exist in the
1587             state. The hashref contains the following keys:
1588              
1589             B<'Nick'>, B<'User'>, B<'Host'>, B<'Userhost'>, B<'Hops'>, B<'Real'>,
1590             B<'Server'> and, if applicable, B<'IRCop'>.
1591              
1592             =head2 C
1593              
1594             Expects a nickname. Returns the long form of that nickname, ie. C
1595             or a false value if the nick is not in the state.
1596              
1597             =head2 C
1598              
1599             Takes no parameters. Returns a list of all the nicks, including itself, that it
1600             knows about. If the component happens to be on no channels then an empty list
1601             is returned.
1602              
1603             =head2 C
1604              
1605             Takes no parameters. Returns the current user mode set for the bot.
1606              
1607             =head1 OUTPUT EVENTS
1608              
1609             =head2 Augmented events
1610              
1611             New parameters are added to the following
1612             L events.
1613              
1614             =head3 C
1615              
1616             See also L|POE::Component::IRC/irc_quit> in
1617             L.
1618              
1619             Additional parameter C contains an arrayref of channel names that are
1620             common to the quitting client and the component.
1621              
1622             =head3 C
1623              
1624             See also L|POE::Component::IRC/irc_nick> in
1625             L.
1626              
1627             Additional parameter C contains an arrayref of channel names that are
1628             common to the nick hanging client and the component.
1629              
1630             =head3 C
1631              
1632             See also L|POE::Component::IRC/irc_kick> in
1633             L.
1634              
1635             Additional parameter C contains the full nick!user@host of the kicked
1636             individual.
1637              
1638             =head3 C
1639              
1640             See also L|POE::Component::IRC/irc_kick> in
1641             L.
1642              
1643             Additional parameter C contains the old topic hashref, like the one
1644             returned by L|/channel_topic>.
1645              
1646             =head3 C
1647              
1648             =head3 C
1649              
1650             =head3 C
1651              
1652             These three all have two additional parameters. C is a hash of
1653             information about your IRC user (see L|/nick_info>), while
1654             C is a hash of the channels you were on (see
1655             L|/channels>).
1656              
1657             =head2 New events
1658              
1659             As well as all the usual L C
1660             events, there are the following events you can register for:
1661              
1662             =head3 C
1663              
1664             Sent whenever the component starts to synchronise the away statuses of channel
1665             members. C is the channel name. You will only receive this event if you
1666             specified a value for B<'AwayPoll'> in L|POE::Component::IRC/spawn>.
1667              
1668             =head3 C
1669              
1670             Sent whenever the component has completed synchronising the away statuses of
1671             channel members. C is the channel name. You will only receive this event if
1672             you specified a value for B<'AwayPoll'> in L|POE::Component::IRC/spawn>.
1673              
1674             =head3 C
1675              
1676             This is almost identical to L|POE::Component::IRC/irc_mode>,
1677             except that it's sent once for each individual mode with it's respective
1678             argument if it has one (ie. the banmask if it's +b or -b). However, this
1679             event is only sent for channel modes.
1680              
1681             =head3 C
1682              
1683             Sent whenever the component has completed synchronising a channel that it has
1684             joined. C is the channel name and C is the time in seconds that
1685             the channel took to synchronise.
1686              
1687             =head3 C
1688              
1689             Sent whenever the component has completed synchronising a channel's INVEX
1690             (invite list). Usually triggered by the component being opped on a channel.
1691             C is the channel name.
1692              
1693             =head3 C
1694              
1695             Sent whenever the component has completed synchronising a channel's EXCEPTS
1696             (ban exemption list). Usually triggered by the component being opped on a
1697             channel. C is the channel.
1698              
1699             =head3 C
1700              
1701             Sent whenever the component has completed synchronising a user who has joined
1702             a channel the component is on. C is the user's nickname and C the
1703             channel they have joined.
1704              
1705             =head3 C
1706              
1707             Sent when an IRC user sets his/her status to away. C is the nickname,
1708             C is an arrayref of channel names that are common to the nickname
1709             and the component. You will only receive this event if you specified a value
1710             for B<'AwayPoll'> in L|POE::Component::IRC/spawn>.
1711              
1712             B This above is only for users I. To know when you
1713             change your own away status, register for the C and C events.
1714              
1715             =head3 C
1716              
1717             Sent when an IRC user unsets his/her away status. C is the nickname,
1718             C is an arrayref of channel names that are common to the nickname and
1719             the component. You will only receive this event if you specified a value for
1720             B<'AwayPoll'> in L|POE::Component::IRC/spawn>.
1721              
1722             B This above is only for users I. To know when you
1723             change your own away status, register for the C and C events.
1724              
1725             =head3 C
1726              
1727             This is almost identical to L|POE::Component::IRC/irc_mode>,
1728             except it is sent for each individual umode that is being set.
1729              
1730             =head1 CAVEATS
1731              
1732             The component gathers information by registering for C, C,
1733             C, C, C, C and various numeric replies.
1734             When the component is asked to join a channel, when it joins it will issue
1735             'WHO #channel', 'MODE #channel', and 'MODE #channel b'. These will solicit
1736             between them the numerics, C, C and C, respectively.
1737             When someone joins a channel the bot is on, it issues a 'WHO nick'. You may
1738             want to ignore these.
1739              
1740             Currently, whenever the component sees a topic or channel list change, it will
1741             use C
1742             for the SetBy value. When an ircd gives us its record of such changes, it will
1743             use its own time (obviously) and may only give us the nickname of the user,
1744             rather than their full address. Thus, if our C
1745             not match, or the ircd uses the nickname only, ugly inconsistencies can develop.
1746             This leaves the B<'SetAt'> and B<'SetBy'> values inaccurate at best, and you
1747             should use them with this in mind (for now, at least).
1748              
1749             =head1 AUTHOR
1750              
1751             Chris Williams
1752              
1753             With contributions from Lyndon Miller.
1754              
1755             =head1 LICENCE
1756              
1757             This module may be used, modified, and distributed under the same
1758             terms as Perl itself. Please see the license that came with your Perl
1759             distribution for details.
1760              
1761             =head1 SEE ALSO
1762              
1763             L
1764              
1765             L
1766              
1767             =cut