diff options
| -rw-r--r-- | Plugin/Antiflood.pm | 2 | ||||
| -rw-r--r-- | Plugin/Greet.pm | 4 | ||||
| -rw-r--r-- | Plugin/Hmm.pm | 2 | ||||
| -rw-r--r-- | Plugin/Jinx.pm | 6 | ||||
| -rw-r--r-- | Plugin/Log.pm | 60 | ||||
| -rw-r--r-- | Plugin/Men.pm | 2 | ||||
| -rw-r--r-- | Plugin/Natural.pm | 4 | ||||
| -rw-r--r-- | Plugin/Rejoin.pm | 34 | ||||
| -rw-r--r-- | Plugin/Titillate.pm | 2 | ||||
| -rw-r--r-- | Plugin/URL_Title.pm | 2 | ||||
| -rwxr-xr-x | idalius.pl | 188 |
11 files changed, 223 insertions, 83 deletions
diff --git a/Plugin/Antiflood.pm b/Plugin/Antiflood.pm index 77d7f17..37e2199 100644 --- a/Plugin/Antiflood.pm +++ b/Plugin/Antiflood.pm @@ -16,7 +16,7 @@ sub configure { } sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $channel = $where->[0]; my $nick = (split /!/, $who)[0]; diff --git a/Plugin/Greet.pm b/Plugin/Greet.pm index e66c91a..e28ff26 100644 --- a/Plugin/Greet.pm +++ b/Plugin/Greet.pm @@ -54,10 +54,10 @@ my @own_responses = ( ); sub on_join { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $irc) = @_; my $nick = (split /!/, $who)[0]; my $response; - if ($nick eq $root_config->{current_nick}) { + if ($nick eq $irc->nick_name()) { return unless self_odds(); $response = some @own_responses; } else { diff --git a/Plugin/Hmm.pm b/Plugin/Hmm.pm index 9c426b8..e3909a0 100644 --- a/Plugin/Hmm.pm +++ b/Plugin/Hmm.pm @@ -27,7 +27,7 @@ sub some { } sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $nick = (split /!/, $who)[0]; # Don't perform this in q to users diff --git a/Plugin/Jinx.pm b/Plugin/Jinx.pm index f1e712b..733291f 100644 --- a/Plugin/Jinx.pm +++ b/Plugin/Jinx.pm @@ -19,7 +19,7 @@ sub configure { } sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $channel = $where->[0]; return if $last_response{$channel} and lc $what eq lc $last_response{$channel}; @@ -35,7 +35,7 @@ sub on_message { } sub on_action { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $channel = $where->[0]; return if $last_response{$channel} and lc $what eq lc $last_response{$channel}; @@ -53,7 +53,7 @@ sub on_action { # Even ignored nicks should be allowed to break a streak sub on_message_yes_really_even_from_ignored_nicks { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $channel = $where->[0]; return if $last{$channel} and lc $last{$channel} eq lc $what; diff --git a/Plugin/Log.pm b/Plugin/Log.pm new file mode 100644 index 0000000..8f9982f --- /dev/null +++ b/Plugin/Log.pm @@ -0,0 +1,60 @@ +package Plugin::Log; + +use strict; +use warnings; + +my $config; +my $root_config; + +sub configure { + my $self = shift; + shift; # cmdref + shift; # run_command + $config = shift; + $root_config = shift; + + return $self; +} + +sub on_message { + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; + $logger->("[$where->[0]] $who: $raw_what"); + return; +} + +sub on_action { + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; + $logger->("[$where->[0]] * $who $raw_what"); + return; +} + +sub on_part { + my ($self, $logger, $who, $where, $why, $irc) = @_; + $logger->("[$where] --- $who left ($why)"); + return; +} + +sub on_join { + my ($self, $logger, $who, $where, $irc) = @_; + $logger->("[$where] --- $who joined"); + return; +} + +sub on_kick { + my ($self, $logger, $kicker, $where, $kickee, $why, $irc) = @_; + $logger->("[$where] !!! $kicker kicked $kickee ($why)"); + return; +} + +sub on_nick { + my ($self, $logger, $who, $new_nick, $irc) = @_; + $logger->("$who changed nick to $new_nick"); + return; +} + +sub on_invite { + my ($self, $logger, $who, $where, $irc) = @_; + $logger->("$who invited me to join $where"); + return; +} +1; diff --git a/Plugin/Men.pm b/Plugin/Men.pm index 7a53a71..265cc87 100644 --- a/Plugin/Men.pm +++ b/Plugin/Men.pm @@ -24,7 +24,7 @@ sub configure { } sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; return unless rand(100) < $config->{chance}; diff --git a/Plugin/Natural.pm b/Plugin/Natural.pm index 2d13070..501bf11 100644 --- a/Plugin/Natural.pm +++ b/Plugin/Natural.pm @@ -86,7 +86,7 @@ sub choose_normal_response { } sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $nick = (split /!/, $who)[0]; if (ref($where) eq "ARRAY") { @@ -94,7 +94,7 @@ sub on_message { } my $response; - if ($what =~ /\b\Q$root_config->{current_nick}\E\b/) { + if ($what =~ /\b\Q$irc->nick_name()\E\b/) { return unless mention_odds(); $response = choose_mention_response($what, $nick); } else { diff --git a/Plugin/Rejoin.pm b/Plugin/Rejoin.pm new file mode 100644 index 0000000..127f5bc --- /dev/null +++ b/Plugin/Rejoin.pm @@ -0,0 +1,34 @@ +package Plugin::Rejoin; + +use strict; +use warnings; + +my $config; +my $root_config; + +sub configure { + my $self = shift; + shift; # cmdref + shift; # run_command + $config = shift; + $root_config = shift; + + return $self; +} + +sub on_kick { + my ($self, $logger, $kicker, $where, $kickee, $why, $irc) = @_; + if ($kickee eq $irc->nick_name) { + $logger->("I was kicked from $where. Rejoining now..."); + $irc->yield(join => $where); + } + return; +} + +sub on_invite { + my ($self, $logger, $who, $where, $irc) = @_; + + $irc->yield(join => $where) if (grep {$_ eq $where} @{$root_config->{channels}}); + return; +} +1; diff --git a/Plugin/Titillate.pm b/Plugin/Titillate.pm index 499d350..817facd 100644 --- a/Plugin/Titillate.pm +++ b/Plugin/Titillate.pm @@ -19,7 +19,7 @@ sub configure { } sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $gathered = ""; my @expressions = (keys %{$config->{triggers}}); my %responses; diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 205a6c5..4bc9fc8 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -35,7 +35,7 @@ sub start_handler sub on_message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; my $url; # Drawn from RFC 3986Β§2 @@ -11,6 +11,7 @@ use IdaliusConfig; use Plugin qw/load_plugin/; use IRC::Utils qw(strip_color strip_formatting); +my $ignore_suffix = "_yes_really_even_from_ignored_nicks"; my $config_file = "bot.conf"; my $config = IdaliusConfig::parse_config($config_file); my %laststrike = (); @@ -29,8 +30,6 @@ load_configure_all_plugins(); $| = 1; -$config->{_}->{current_nick} = $config->{_}->{nick}; - # New PoCo-IRC object my $irc = POE::Component::IRC->spawn( UseSSL => $config->{_}->{usessl}, @@ -78,6 +77,9 @@ drop_priv(); $poe_kernel->run(); + +################################################################################ +# Helpers and module framework sub load_configure_all_plugins { eval { for my $module (@{$config->{_}->{plugins}}) { @@ -140,9 +142,13 @@ sub run_command { my $action = $commands{$owner}{$command}; return $action->($irc, \&log_info, $who, $where, $ided, $rest, @arguments); } + +# Send an effect-free client->server message as a form of ping to allegedly +# help POE realise when a connection is down. It otherwise seems to not realise +# a connection has fallen over otherwise. sub custom_ping { my ($irc, $heap) = @_[KERNEL, HEAP]; - $irc->yield(userhost => $config->{_}->{current_nick}); + $irc->yield(userhost => $irc->nick_name()); $irc->delay(custom_ping => $ping_delay); } @@ -177,44 +183,18 @@ sub should_ignore { return grep {$_ eq $nick} @{$config->{_}->{ignore}}; } -sub _start { - my $heap = $_[HEAP]; - my $irc = $heap->{irc}; - $irc->yield(register => 'all'); - $irc->yield(connect => { }); - return; -} - -sub irc_001 { - my ($irc, $sender) = @_[KERNEL, SENDER]; - my $heap = $sender->get_heap(); - - log_info("Connected to server ", $heap->server_name()); +sub reconnect { + my $reconnect_delay = 20; - $config->{_}->{current_nick} = $config->{_}->{nick}; - $heap->yield(join => $_) for @{$config->{_}->{channels}}; - $irc->delay(custom_ping => $ping_delay); - return; -} + log_info("Reconnecting in $reconnect_delay seconds"); + sleep($reconnect_delay); -sub irc_nick { - my ($who, $new_nick) = @_[ARG0 .. ARG1]; - my $oldnick = (split /!/, $who)[0]; - if ($oldnick eq $config->{_}->{current_nick}) { - $config->{_}->{current_nick} = $new_nick; - } - return; + $irc->yield(connect => { }); } -sub irc_kick { - my ($kicker, $channel, $kickee, $reason) = @_[ARG0 .. ARG3]; - if ($kickee eq $config->{_}->{current_nick}) { - log_info("I was kicked by $kicker ($reason). Rejoining now."); - $irc->yield(join => $channel); - } - return; -} +################################################################################ +# Plugin event handling helpers sub handle_common { my ($message_type, $who, $where, $what, $ided) = @_; my $nick = (split /!/, $who)[0]; @@ -223,35 +203,84 @@ sub handle_common { $what =~ s/\s+$//g; + # Firstly, trigger commands my $stripped_what = strip_color(strip_formatting($what)); my $no_prefix_what = $stripped_what; - if (!should_ignore($nick) && ($config->{_}->{prefix_nick} && $no_prefix_what =~ s/^\Q$config->{_}->{current_nick}\E[:,]\s+//g || + my $current_nick = $irc->nick_name(); + if (!should_ignore($nick) && ($config->{_}->{prefix_nick} && $no_prefix_what =~ s/^\Q$current_nick\E[:,]\s+//g || ($config->{_}->{prefix} && $no_prefix_what =~ s/^\Q$config->{_}->{prefix}//))) { $output = run_command($no_prefix_what, $who, $where, $ided); $irc->yield(privmsg => $where => $output) if $output; strike_add($nick, $channel) if $output; } - # handler names are defined as being prefixed with on_ + # Secondly, trigger non-command handlers + trigger_modules($message_type, $who, $where, ($who, $where, $what, $stripped_what)); + + return; +} + +# Trigger applicable non-command-bound handlers in any active modules for +# a given message type, passing them only the given arguments +sub trigger_modules { + my ($message_type, $who, $where, @arguments) = @_; + my $nick = (split /!/, $who)[0]; + + for my $handler (handlers_for($message_type, $who)) { + my @base_args = (\&log_info); + push @base_args, @arguments; + push @base_args, $irc; + my $output = $handler->(@base_args); + if ($output and $where) { + $irc->yield(privmsg => $where => $output); + strike_add($nick, $where->[0]); + } + } + return; +} + +# Return a list of subs capable of handling the given message type for a nick +sub handlers_for { + my ($message_type, $nick) = @_; + my @handlers = (); + $nick = (split /!/, $nick)[0]; + $message_type = "on_$message_type"; - my $ignore_suffix = "_yes_really_even_from_ignored_nicks"; for my $module (@{$config->{_}->{active_plugins}}) { if (module_is_enabled($module)) { if (!should_ignore($nick) and $module->can($message_type)) { # Leave message type unchanged } elsif ($module->can($message_type.$ignore_suffix)) { - # Handler for non-ignored and ignored exists $message_type = $message_type.$ignore_suffix; } else { # No handler next; } - $output = $module->$message_type(\&log_info, $irc->nick_name, $who, $where, $what, $stripped_what, $irc); - $irc->yield(privmsg => $where => $output) if $output; - strike_add($nick, $channel) if $output; + push @handlers, sub { $module->$message_type(@_); }; } } + return @handlers; +} + +############################################################################### +# Begin internal/core handlers +sub _start { + my $heap = $_[HEAP]; + my $irc = $heap->{irc}; + $irc->yield(register => 'all'); + $irc->yield(connect => { }); + return; +} + +sub irc_001 { + my ($irc, $sender) = @_[KERNEL, SENDER]; + my $heap = $sender->get_heap(); + + log_info("Connected to server ", $heap->server_name()); + + $heap->yield(join => $_) for @{$config->{_}->{channels}}; + $irc->delay(custom_ping => $ping_delay); return; } @@ -260,29 +289,22 @@ sub irc_ctcp_action { my $nick = ( split /!/, $who )[0]; my $channel = $where->[0]; - log_info("[$channel] [action] $who $what"); - - return handle_common("action", $who, $where, $what); + handle_common("action", $who, $where, $what); + return; } sub irc_public { my ($who, $where, $what, $ided) = @_[ARG0 .. ARG3]; my $nick = ( split /!/, $who )[0]; my $channel = $where->[0]; - - log_info("[$channel] $who: $what"); - - return handle_common("message", $who, $where, $what, $ided); + handle_common("message", $who, $where, $what, $ided); + return; } sub irc_join { my ($who, $channel) = @_[ARG0 .. ARG1]; - my @where = ($channel); - my $nick = ( split /!/, $who )[0]; - - log_info("[$channel] >>> $who joined"); - - return handle_common("join", $who, \@where, ""); + trigger_modules("join", $who, $channel, ($who, $channel)); + return; } sub irc_part { @@ -290,15 +312,51 @@ sub irc_part { my $nick = ( split /!/, $who )[0]; my @where = ($channel); - log_info("[$channel] <<< $who left ($why)"); + trigger_modules("part", $who, $channel, ($who, $channel, $why)); + return; +} - return handle_common("part", $who, \@where, $why); +sub irc_kick { + my ($kicker, $channel, $kickee, $reason) = @_[ARG0 .. ARG3]; + trigger_modules("kick", $kicker, $channel, ($kicker, $channel, $kickee, $reason)); + return; } +sub irc_nick { + my ($who, $new_nick) = @_[ARG0 .. ARG1]; + trigger_modules("nick", $who, undef, ($who, $new_nick)); + return; +} + +sub irc_invite { + my ($who, $where) = @_[ARG0 .. ARG1]; + trigger_modules("invite", $who, undef, ($who, $where)); + return; +} + +# FIXME these need implementing even if just for logging: +# irc_registered +# irc_shutdown +# irc_connected +# irc_ctcp_* +# irc_ctcpreply_* +# irc_disconnected +# irc_error +# irc_mode +# irc_notice +# irc_quit +# irc_socketerr +# irc_topic +# irc_whois +# irc_whowas + sub irc_msg { my ($who, $to, $what, $ided) = @_[ARG0 .. ARG3]; my $nick = (split /!/, $who)[0]; + # FIXME trigger plugins with on_msg or something. Currently no privmsg + # are logged, but Log.pm can do this for us. + my $stripped_what = strip_color(strip_formatting($what)); my $output = run_command($stripped_what, $who, $nick, $ided); $irc->yield(privmsg => $nick => $output) if $output; @@ -306,19 +364,7 @@ sub irc_msg { return; } -sub irc_invite { - my ($who, $where) = @_[ARG0 .. ARG1]; - $irc->yield(join => $where) if (grep {$_ eq $where} @{$config->{_}->{channels}}); -} - -sub reconnect { - my $reconnect_delay = 20; - - log_info("Reconnecting in $reconnect_delay seconds"); - sleep($reconnect_delay); - - $irc->yield(connect => { }); -} +############################################################################### sub irc_disconnected { _default(@_); # Dump the message |