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