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__
syntax highlighted by Code2HTML, v. 0.9.1