package NetHirc::Adventurer; use strict; use warnings; use POE qw(Kernel Session Component::IRC); use NetHirc::Commands; # pollutes our namespace intentionally. use NetHirc::Handlers; # also pollutes our namespace intentionally. use NetHirc::Util; my @events = qw( _start _stop connect complain next_connect shutdown display_public ); my @commands = qw( cmd_error cmd_say cmd_next cmd_msg cmd_quit cmd_join cmd_part cmd_describe cmd_ctcp cmd_me cmd_kick cmd_mode cmd_nick cmd_notice cmd_admin cmd_away cmd_info cmd_version cmd_invite cmd_ison cmd_list _cmd_list_confirmed _cmd_refused cmd_names _cmd_names_confirmed cmd_motd cmd_time cmd_topic cmd_userhost cmd_users cmd_who cmd_whois cmd_whowas cmd_server cmd_disconnect cmd_debug cmd_argcount cmd_yoda cmd_mirror cmd_pigl cmd_shuffle cmd_inventory cmd_help cmd_log _cmd_log_start _cmd_log_start_confirmed _cmd_log_start_error _cmd_log_stop _cmd_log_stop_confirmed _cmd_log_write_error _cmd_log_status cmd_count _cmd_count_show _cmd_count_report_all _cmd_count_report_one _cmd_count_start _cmd_count_start_success _cmd_count_start_fail _cmd_count_stop _cmd_count_stop_success _cmd_count_stop_fail _cmd_count_status _cmd_count_clear cmd_system _cmd_system_display _cmd_system_error cmd_pipe _cmd_pipe_display _cmd_pipe_error _cmd_pipe_close cmd_pipemsg _cmd_pipemsg_display _cmd_pipemsg_error _cmd_pipemsg_close cmd_bigbrother _cmd_bigbrother_on _cmd_bigbrother_off _cmd_bigbrother_announce _cmd_bigbrother_status cmd_query _cmd_query_start _cmd_query_stop ); my @irc_events = qw( irc_connected irc_disconnected irc_error irc_join irc_invite irc_kick irc_mode irc_msg irc_nick irc_notice irc_part irc_ping irc_public irc_quit irc_socketerr irc_topic irc_ctcp_action irc_ctcp_ping irc_ctcp_version irc_ctcpreply_ping irc_ctcpreply_version irc_whois irc_whowas ); # List stolen from Net::IRC::Event and then pruned for our needs. # Pruned Undernet, pircd, Bahamut, Unreal, and anything involving # stats, services, links, because that's just annyoing to test. # Though we may have to slowly put it back (darn freenode). my %irc_numerics = qw( 001 welcome 002 yourhost 003 created 004 myinfo 005 map 221 umodeis 250 luserconns 251 luserclient 252 luserop 254 luserchannels 256 adminme 257 adminloc1 258 adminloc2 259 adminemail 265 n_local 266 n_global 301 away 302 userhost 303 ison 305 unaway 306 nowaway 315 endofwho 316 whoischanop 321 liststart 322 list 323 listend 324 channelmodeis 329 channelcreate 331 notopic 332 topic 333 topicinfo 351 version 352 whoreply 353 namreply 366 endofnames 367 banlist 368 endofbanlist 371 info 372 motd 373 infostart 374 endofinfo 375 motdstart 376 endofmotd 377 motd2 391 time 401 nosuchnick 402 nosuchserver 403 nosuchchannel 404 cannotsendtochan 406 wasnosuchnick 411 norecipient 412 notexttosend 422 nomotd 433 nicknameinuse 441 usernotinchannel 442 notonchannel 471 channelisfull 472 unknownmode 473 inviteonlychan 474 bannedfromchan 475 badchannelkey 482 chanoprivsneeded 501 umodeunknownflag ); my @unimplemented = qw( 253 luserunknown 255 luserme 290 helphdr 291 helpop 292 helptlr 293 helphlp 294 helpfwd 295 helpign 300 none 310 whoishelp 311 whoisuser 312 whoisserver 313 whoisoperator 314 whowasuser 317 whoisidle 318 endofwhois 319 whoischannels 341 inviting 342 summoning 346 invitelist 347 endofinvitelist 361 killdone 362 closing 363 closeend 369 endofwhowas 379 whoismodes 381 youreoper 382 rehashing 384 myportis 385 notoperanymore 392 usersstart 393 users 394 endofusers 395 nousers 405 toomanychannels 407 toomanytargets 409 noorigin 421 unknowncommand 423 noadmininfo 424 fileerror 431 nonicknamegiven 432 erroneusnickname 436 nickcollision 443 useronchannel 444 nologin 445 summondisabled 446 usersdisabled 451 notregistered 461 needmoreparams 462 alreadyregistered 463 nopermforhost 464 passwdmismatch 465 yourebannedcreep 466 youwillbebanned 467 keyset 476 badchanmask 481 noprivileges 483 cantkillserver 491 nooperhost 492 noservicehost 502 usersdontmatch links cmd_links trace cmd_trace stats cmd_stats oper cmd_oper rehash cmd_rehash restart cmd_restart sconnect cmd_sconnect summon cmd_summon wallops cmd_wallops anything dcc-releated channels pickle/bye/exit/q/x cc/cmdchar dc/disconnect leave/part system pipe pipemsg/msgpipe ); # Gross symbol table hack to produce quasi-readable code. I hope # it's worth it. sub new { shift; POE::Session->create( 'package_states' => [ 'NetHirc::Adventurer' => [ @events, @irc_events, @commands, map { "irc_$_" } keys %irc_numerics, ] ], 'args' => [ @_ ], ); } sub _start { debug('a', "_start"); my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; my ($db, $rc, $commands) = @_[ARG0..ARG2]; $kernel->alias_set('nethirc_adventurer'); $heap->{'db'} = $db; $heap->{'rc'} = $rc; $heap->{'commands'} = $commands; $kernel->post($session, 'next_connect'); } sub _stop { my $heap = $_[HEAP]; delete $heap->{'db'}; delete $heap->{'rc'}; } sub connect { debug('a', "connect"); my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0]; my $server = $args->{'Server'}; my $inv = $heap->{'rc'}; my ($srv) = $inv->has_server($server); if ($srv->used()) { $kernel->post($server, 'connect') unless $srv->connected(); return; } my $irc = POE::Component::IRC->spawn('alias' => $server); $srv->used(1); my $unblessed = { %$args }; $unblessed->{'NoDNS'} = 1; $irc->yield('register', 'all'); $irc->yield('connect', $unblessed); } sub next_connect { debug('a', "next_connect"); my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; my $inv = $heap->{'rc'}; my ($srv) = grep { not $_->connected() and not $_->used() } @$inv; $kernel->post($session, 'connect', $srv) if $srv; } sub complain { my $heap = $_[HEAP]; my $db = $heap->{'db'}; my $complaints = $db->{'complaints'} || [ "Blank lines are dull." ]; my $complaint = $complaints->[int rand @$complaints]; nht('complaint', $complaint); } sub shutdown { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; $kernel->post('nethirc_debug', '_stop'); my $inv = $heap->{'rc'}; map { $kernel->post($_->name(), 'unregister', 'all'); $kernel->post($_->name(), 'shutdown'); } @$inv; $kernel->post('nethirc_terminal', '_stop'); $kernel->post('nethirc_log', '_stop'); $kernel->post('nethirc_counter', '_stop'); $kernel->post('nethirc_totalitarian', '_stop'); $kernel->post($session, '_stop'); } sub display_public { my ($heap, $server, $target, $nick, $message) = @_[HEAP, ARG0..ARG3]; my $inv = $heap->{'rc'}; my $srv = $inv->current_server(); my $channel = $srv->current_channel(); if ($server eq $srv->name()) { if (lc($channel) eq lc($target)) { nht('public', $nick, $message); } else { nht('public_otherchannel', $nick, $target, $message); } } else { nht('public_otherserver', $nick, $target, $server, $message) } } 1; __END__