package main;
use strict;
use warnings;
+#sub POE::Kernel::TRACE_EVENTS () { 1 }
+#sub POE::Kernel::TRACE_SIGNALS () { 1 }
use POE;
use POE qw(Component::IRC Component::IRC::Plugin::Connector);
use POE::Component::IRC;
-# list of joined irc channels
-%main::irc_channels = ();
# list of sessions
%main::sessions = ();
# logfile name
_default => \&_default,
irc_001 => \&on_connect,
irc_public => \&on_message,
+ irc_msg => \&on_message,
+ public2 => \&on_message,
irc_376 => \&on_end_motd,
irc_433 => \&on_nickused,
+ irc_330 => \&on_whois_identified,
+ irc_318 => \&on_whois_end,
irc_ping => \&on_ping,
autoping => \&do_autoping,
irc_error => \&on_error,
# inline_states => {
# irc_353 => \&on_names,
-# irc_join => \&on_join,
+# irc_join => \&on_join,
# irc_part => \&on_part,
# irc_quit => \&on_quit,
# irc_nick => \&on_nick,
# init_config()
#
-# init config
+# init configuration
#
# parameter:
# none
# read_config()
#
-# read config & set variables accordingly
+# read configuration & set variables accordingly
#
# parameter:
# - config file name
# config_get_key1()
#
-# read config value
+# read configuration value
#
# parameter:
# - config key 1
# config_get_key2()
#
-# read config value
+# read configuration value
#
# parameter:
# - config key 1
# config_get_key3()
#
-# read config value
+# read configuration value
#
# parameter:
# - config key 1
# config_get_keys1()
#
-# read config keys
+# read configuration keys
#
# parameter:
# - config key 1
# validate_config()
#
-# read config & validate important settings
+# read configuration & validate important settings
#
# parameter:
# none
# reread_config()
#
-# reread config & execute changes
+# reread configuration & execute changes
#
# parameter:
# none
$main::sessions{$session}{'last_nick_change_attempt'} = time();
}
+ # FIXME: use channels from config directly on join
sort_irc_channels_into_sessions();
}
-
sub sort_irc_channels_into_sessions {
- my @channels = config_get_keys1('channels');
+ my @channels = $main::config->config_get_keys1('channels');
foreach my $channel (@channels) {
# FIXME: find out if this channel is already joined
# FIXME: if session changes, reassign the channel
- my $session = config_get_key3('channels', $channel, 'session');
+ my $session = $main::config->config_get_key3('channels', $channel, 'session');
push(@{$main::sessions{$session}{'irc_channels'}}, $channel);
print_msg("assign irc channel '$channel' to session '$session'", DEBUG);
}
}
-
sub write_to_channel {
}
}
# have to shutdown here, else Component::IRC Component::IRC::Plugin::Connector will reconnect
- $poe_kernel->delay_add( execute_shutdown => 10 );
+ $poe_kernel->delay_add( execute_shutdown => 5 );
$shutdown = 1;
return;
}
+# find_command()
+#
+# find a valid command in a message line
+#
+# parameter:
+# - message line
+# - optional: channel name
+# return:
+# - array with:
+# - command
+# - rest of string
+# undef if no command could be identified
+sub find_command {
+ my $msg = shift;
+ my $channel = shift;
+
+ my ($command, $string);
+
+ if ($msg =~ /^\s*\?([a-z]+)\s+(.+)/) {
+ $command = lc($1);
+ $string = $2;
+
+ # looks like a command, at least started with a question mark
+ # find out if it really is one
+
+ if (is_valid_command($command)) {
+ return ($command, $string);
+ }
+
+ # try to translate the command
+ # find the channel language
+ my $channel_language = config_get_key3('channels', $channel, 'language');
+ # not defined channel language leads to a full search across all languages
+ # this is just fine
+
+ my $translation = find_translation($channel_language, $command);
+ if (defined($translation) and is_valid_command($translation)) {
+ return ($translation, $string);
+ }
+ }
+
+ return undef;
+}
+
+
+# is_valid_command()
+#
+# find out if this is a valid command (includes valid admin commands)
+#
+# parameter:
+# - command
+# return:
+# - 0/1
+sub is_valid_command {
+ my $command = shift;
+
+ my $status = is_valid_admin_command($command);
+ if ($status == 1) {
+ return 1;
+ }
+
+ if ($command eq 'help') {
+ return 1;
+ } elsif ($command eq 'info') {
+ return 1;
+ }
+
+ return 0;
+}
+
+
+# is_valid_admin_command()
+#
+# find out if this is a valid admin command
+#
+# parameter:
+# - command
+# return:
+# - 0/1
+sub is_valid_admin_command {
+ my $command = shift;
+
+ if ($command eq 'learn') {
+ return 1;
+ } elsif ($command eq 'forget') {
+ return 1;
+ } elsif ($command eq 'config') {
+ return 1;
+ }
+
+ return 0;
+}
+
+
+# translate_with_default()
+#
+# translate a text into another language
+#
+# parameter:
+# - language
+# - text to translate
+# - default translation
+# return:
+# - translated text, or returns the original text if there is no translation
+sub translate_with_default {
+ my $language = shift;
+ my $word = shift;
+ my $default = shift;
+
+ my $translation = translate($language, $word);
+ if (!defined($translation)) {
+ return $default;
+ }
+
+ return $translation;
+}
+
+
+# translate()
+#
+# translate a text into another language
+#
+# parameter:
+# - language
+# - text to translate
+# return:
+# - translated text, or undef
+sub translate {
+ my $language = shift;
+ my $word = shift;
+
+
+ my $translation = config_get_key3('translations', $language, $word);
+ if (!defined($translation)) {
+ return undef;
+ }
+
+ # return the first word, if multiple translations are available
+ if ($translation =~ /^([^\|]+)\|/) {
+ $translation = $1;
+ }
+
+ return $translation;
+}
+
+
+# translations()
+#
+# returns all translations for a text into another language
+#
+# parameter:
+# - language
+# - text to translate
+# return:
+# - array with translations, or undef
+sub translations {
+ my $language = shift;
+ my $word = shift;
+
+ my $translation = config_get_key3('translations', $language, $word);
+ if (!defined($translation)) {
+ return undef;
+ }
+
+ # always return all translations in an array, even if there is only one
+ my @translation = ($translation);
+ if ($translation =~ /\|/) {
+ @translation = split(/\|/, $translation);
+ }
+
+ return @translation;
+}
+
+
+# find_translation()
+#
+# find a translated word and return the according key
+#
+# parameter:
+# - language
+# - translated text
+# - optional: flag if case sensitive search, default is not case sensitive, 0 will search sensitive
+# return:
+# - translation key, or undef
+sub find_translation {
+ my $language = shift;
+ my $word = shift;
+ my $lowercase = 1;
+ if (defined($_[0])) {
+ $lowercase = shift;
+ }
+
+ my @languages = $main::config->config_get_keys1('translations');
+
+ # find a word in one or all languages
+ foreach my $tmp (@languages) {
+ if (!defined($language) or (defined($language) and $language eq $tmp)) {
+ my @tmp2 = $main::config->config_get_keys2('translations', $tmp);
+ foreach my $tmp2 (@tmp2) {
+ my $tmp3 = $main::config->config_get_key3('translations', $tmp, $tmp2);
+ my @tmp3 = ($tmp3);
+ if ($tmp3 =~ /\|/) {
+ @tmp3 = split(/\|/, $tmp3);
+ }
+ foreach my $tmp4 (@tmp3) {
+ if ($lowercase) {
+ if (lc($word) eq lc($tmp4)) {
+ return $tmp2;
+ }
+ } else {
+ if ($word eq $tmp4) {
+ return $tmp2;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+
+# translate_text_for_channel()
+#
+# translate a text for a channel
+#
+# parameter:
+# - channel name
+# - text key
+# - default text if no translation is available (not optional!)
+# return:
+# - translated text (or default text)
+sub translate_text_for_channel {
+ my $channel = shift;
+ my $text_key = shift;
+ my $default_text = shift;
+
+ my $text = $default_text;
+
+ # translate text
+ if (substr($channel, 0, 1) eq '#') {
+ my $channel_language = config_get_key3('channels', $channel, 'language');
+ if (defined($channel_language)) {
+ $text = translate_with_default($channel_language, $text_key, $default_text);
+ }
+ }
+
+ return $text;
+}
+
+
+
+
+
+
######################################################################
# IRC functions
$irc->yield( connect => { Debug => $main::debug_traffic } );
+ # enable tracing
+ #$_[SESSION]->option(trace => 1);
+
return;
}
set_session_activity($session);
+ $main::sessions{$session}{'irc_channels'} = [];
# join all channels
foreach my $channel (@irc_channels) {
+ # based on the current configuration, each channel can only be joined by one bot session
$irc->yield( join => $channel );
}
}
-# irc_public
+########
+# on_message ( )
+####
+# called when some message was sent to channel or to bot
+#
+
+# on_message()
+#
+# called when some message was sent to channel or to bot
+#
sub on_message {
- my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];
+ my ( $kernel, $heap, $who, $where, $msg, $sender ) = @_[ KERNEL, HEAP, ARG0, ARG1, ARG2, SENDER ];
my $nick = ( split /!/, $who )[0];
my $channel = $where->[0];
+ my $replyto = $channel;
+ my $full_msg = $msg;
+ my $like = 0;
+ print_msg("on_message($msg)", DEBUG);
my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
- #print "\n\nsession: $session\n\n";
- set_session_activity($session);
- if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) {
- $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
- $irc->yield( privmsg => $channel => "$nick: $rot13" );
+ # recognize valid command (both admin and unprivileged)
+ my ($command, $string) = find_command($msg, (substr($channel, 0, 1) eq '#') ? $channel : undef);
+
+
+ if (defined($command)) {
+ my $answer;
+
+ # handle all admin commands
+ if (is_valid_admin_command($command)) {
+
+ # no authentication information available, create callback
+ if (!defined($heap->{whois_callback}->{$nick}->{authed})) {
+ $heap->{whois_callback}->{$nick} = {event => (lc($channel) eq lc($irc->nick_name())) ? 'irc_msg' : 'irc_public'};
+ $heap->{whois_callback}->{$nick}->{authed} = 0;
+ # register a callback
+ @{$heap->{whois_callback}->{$nick}->{args}} = ($who, $where, $msg);
+
+ # no auth information available
+ # shoot a 'whois' to the irc server
+ $irc->yield( whois => $nick );
+ return;
+ }
+ # handle authentication callback
+ elsif ($heap->{whois_callback}->{$nick}->{authed} != 1) {
+ # user is not logged in on freenode
+ $answer = "You are not authorized";
+ # translate error message
+ $answer = translate_text_for_channel($channel, 'you_are_not_authorized', $answer);
+ }
+ else {
+ # execute desired command
+ #$answer = $admin_commands->{$command}($kernel, $nick, $channel, $string);
+ $answer = "Execute command: $command";
+ print_msg("Execute command: $command", INFO);
+ }
+ # drop the callback for this nick
+ undef ($heap->{whois_callback}->{$nick});
+
+ if (length($answer)) {
+ # if command was called in channel print answer to channel, if it was PM print it as PM
+ if (lc($channel) eq lc($irc->nick_name())) {
+ $irc->yield( privmsg => $nick, $answer);
+ }
+ else {
+ $irc->yield( privmsg => $channel, $answer);
+ }
+ return;
+ }
+
+
+
+
+ }
+ }
+
+
+# if ($msg =~ /^\s*(\?(?:learn|forget|config))\s+(.+)/i) {
+# my ($command, $string) = ($1, $2);
+# my $answer;
+#
+# if (!defined($heap->{whois_callback}->{$nick}->{authed})) {
+# $heap->{whois_callback}->{$nick} = {event => (lc($channel) eq lc($irc->nick_name())) ? 'irc_msg' : 'irc_public'};
+# $heap->{whois_callback}->{$nick}->{authed} = 0;
+# # register a callback
+# @{$heap->{whois_callback}->{$nick}->{args}} = ($who, $where, $msg);
+#
+# # no auth information available
+# # shoot a 'whois' to the irc server
+# $irc->yield( whois => $nick );
+# return;
+# }
+# elsif ($heap->{whois_callback}->{$nick}->{authed} != 1) {
+# $answer = "You are not authorized";
+# }
+# else {
+# # execute desired command
+# #$answer = $admin_commands->{$command}($kernel, $nick, $channel, $string);
+# $answer = "Execute command: $command";
+# print_msg("Execute command: $command", INFO);
+# }
+# # drop the callback for this nick
+# undef ($heap->{whois_callback}->{$nick});
+#
+# if (length($answer)) {
+# # if command was called in channel print answer to channel, if it was PM print it as PM
+# if (lc($channel) eq lc($irc->nick_name())) {
+# $irc->yield( privmsg => $nick, $answer);
+# }
+# else {
+# $irc->yield( privmsg => $channel, $answer);
+# }
+# return;
+# }
+# }
+# elsif ($msg =~ /^\s*\?\?(\?*)(.+)/i) {
+# $like = ($1 and $LIKESEARCH) ? 1 : 0;
+# $msg = $2;
+# $msg =~ s/^\s+//;
+#
+# if (substr($channel, 0, 1) eq '#')
+# {
+# if ($my_nick ne $irc_nick) {
+# if (grep( /^$channel$/i, find_nick( $heap, $irc_nick ) )) {
+# print_msg("Not processing query command, master bot is on channel", DEBUG);
+# return;
+# }
+# }
+# }
+#
+# if ($msg =~ /^(.+)\s+>\s+(\w+)/i) {
+# return unless (grep( /^$channel$/i, find_nick( $heap, $2 ) ));
+# $replyto = $2;
+# $msg = $1;
+# } elsif (lc($channel) eq lc($my_nick)) {
+# $replyto = $nick;
+# } else {
+# $replyto = $channel;
+# }
+# }
+# elsif ($msg =~ /^\s*$my_nick\W+tell\s+(\w+)\s+about\s+(.+)/i) {
+# if ($1 eq "me") {
+# $replyto = $nick;
+# } elsif ($1 eq "us") {
+# $replyto = $channel;
+# } else {
+# $replyto = $1;
+# return unless (grep( /^$channel$/i, find_nick( $heap, $replyto ) ));
+# }
+#
+# $msg = $2;
+# } else {
+# return;
+# }
+#
+# # get data from db
+# my $answers = get_answer($msg, $like);
+# my $message_to_say = get_message($msg);
+# my $numanswers = @$answers;
+#
+# # print each answer as one line, except when there are more than $MAXWRAP
+# if ($numanswers) {
+# $kernel->post(pg_docbot => privmsg => $replyto, "For information about '$msg' see:\n");
+# if ($numanswers <= $MAXWRAP) {
+# for my $answer (@$answers) {
+# $kernel->post(pg_docbot => privmsg => $replyto, $answer)
+# }
+# }
+# else {
+# for my $answer (word_wrap(' :: ', 250, @$answers)) {
+# $kernel->post(pg_docbot => privmsg => $replyto, $answer);
+# }
+# }
+# }
+# else { # "nothing found," is always sends to the caller, not to the receiver
+# # if command was called in channel print, answer to channel, if it was PM print it as PM
+# if (lc($channel) eq lc($my_nick)) {
+# $kernel->post(pg_docbot => privmsg => $nick, "Nothing found");
+# } else {
+# $kernel->post(pg_docbot => privmsg => $channel, "Nothing found");
+# }
+# }
+}
+
+
+
+
+
+# on_whois_identified()
+#
+# parse whois lines
+#
+sub on_whois_identified {
+ my ( $kernel, $heap, $detail, $sender ) = @_[KERNEL, HEAP, ARG1, SENDER];
+ my $nick = ( split / /, $detail )[0];
+
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
+ print_msg("on_whois_identified(session: $session, nick: $nick)\n", DEBUG);
+
+ if (defined($heap->{whois_callback}->{$nick})) {
+ print_msg("Nick $nick is authed", DEBUG);
+ $heap->{whois_callback}->{$nick}->{authed} = 1;
+ }
+}
+
+
+# on_whois_end()
+#
+# end of whois output
+#
+sub on_whois_end {
+ my ( $kernel, $heap, $detail, $sender ) = @_[KERNEL, HEAP, ARG1, SENDER];
+ my $nick = ( split / /, $detail )[0];
+
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
+ print_msg("on_whois_end(session: $session, nick: $nick)\n", DEBUG);
+
+ if (defined($heap->{whois_callback}->{$nick}->{event})) {
+ $irc->send_event($heap->{whois_callback}->{$nick}->{event} => @{$heap->{whois_callback}->{$nick}->{args}});
}
- return;
}
+
#
## vi: ts=4
projects / docbot.git / commitdiff