aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Plugin/Antiflood.pm2
-rw-r--r--Plugin/Greet.pm4
-rw-r--r--Plugin/Hmm.pm2
-rw-r--r--Plugin/Jinx.pm6
-rw-r--r--Plugin/Log.pm60
-rw-r--r--Plugin/Men.pm2
-rw-r--r--Plugin/Natural.pm4
-rw-r--r--Plugin/Rejoin.pm34
-rw-r--r--Plugin/Titillate.pm2
-rw-r--r--Plugin/URL_Title.pm2
-rwxr-xr-xidalius.pl188
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
diff --git a/idalius.pl b/idalius.pl
index d19087d..7de8238 100755
--- a/idalius.pl
+++ b/idalius.pl
@@ -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