package main;
use strict;
use warnings;
+
#sub POE::Kernel::TRACE_EVENTS () { 1 }
#sub POE::Kernel::TRACE_SIGNALS () { 1 }
use POE;
# handle command line arguments
######################################################################
# defaults
-$main::help = 0;
-$main::debug = 0;
-$main::debug_traffic = 0;
-$main::config_file = "";
+$main::help = 0;
+$main::debug = 0;
+$main::debug_traffic = 0;
+$main::config_file = "";
$main::translations_file = "";
# parse options
my $args_init_string = "help h d debug D c=s config=s l=s logfile=s t=s translations=s";
unless (
GetOptions(
- 'help|h|?' => \$main::help,
- 'debug|d' => \$main::debug,
- 'debug-irc|D' => \$main::debug_traffic,
- 'config|c=s' => \$main::config_file,
- 'logfile|l=s' => \$main::logfile,
- 'translations|t=s' => \$main::translations_file,
+ 'help|h|?' => \$main::help,
+ 'debug|d' => \$main::debug,
+ 'debug-irc|D' => \$main::debug_traffic,
+ 'config|c=s' => \$main::config_file,
+ 'logfile|l=s' => \$main::logfile,
+ 'translations|t=s' => \$main::translations_file,
)
) {
# There were some errors with parsing command line options - show help.
# create a set of POE sessions
foreach my $session (keys(%main::sessions)) {
- my $name = config_get_key2('irc', 'name');
+ my $name = config_get_key2('irc', 'name');
my $server = config_get_key2('irc', 'server');
- my $port = config_get_key2('irc', 'port');
+ my $port = config_get_key2('irc', 'port');
$port = (length($port) > 0 and $port =~ /^\d+$/) ? $port : '6667';
my $ssl = config_get_key2('irc', 'ssl') ? 1 : undef;
my $irc = POE::Component::IRC->spawn(
- Nick => $main::sessions{$session}{'nickname'},
+ Nick => $main::sessions{$session}{'nickname'},
Ircname => $name,
- Server => $server,
- Port => $port,
- Raw => 1,
- UseSSL => $ssl,
+ Server => $server,
+ Port => $port,
+ Raw => 1,
+ UseSSL => $ssl,
);
if (!$irc) {
print_msg("Could not spawn POE session: $!", ERROR);
# start the next tick
$_[HEAP]->{next_alarm_time} = int(time()) + 10;
$_[KERNEL]->alarm(tick => $_[HEAP]->{next_alarm_time});
- $_[KERNEL]->sig( INT => 'got_sig_int' );
+ $_[KERNEL]->sig( INT => 'got_sig_int' );
$_[KERNEL]->sig( TERM => 'got_sig_term' );
$_[KERNEL]->sig( KILL => 'got_sig_kill' );
- $_[KERNEL]->sig( HUP => 'got_sig_hup' );
+ $_[KERNEL]->sig( HUP => 'got_sig_hup' );
},
# a tick every 10 seconds
# call the real watchdog function
watchdog();
},
- got_sig_int => \&interrupt_handler_quit,
- got_sig_term => \&interrupt_handler_quit,
- got_sig_kill => \&interrupt_handler_quit,
- got_sig_hup => \&interrupt_handler_quit,
+ got_sig_int => \&interrupt_handler_quit,
+ got_sig_term => \&interrupt_handler_quit,
+ got_sig_kill => \&interrupt_handler_quit,
+ got_sig_hup => \&interrupt_handler_quit,
execute_shutdown => \&execute_shutdown,
},
);
# return:
# none
sub init_statistics {
+
$main::statistics{'docbot_start'} = time();
- $main::statistics{'command_counter_search'} = 0;
- $main::statistics{'command_counter_help'} = 0;
- $main::statistics{'command_counter_info'} = 0;
- $main::statistics{'command_counter_learn'} = 0;
- $main::statistics{'command_counter_forget'} = 0;
- $main::statistics{'command_counter_config'} = 0;
- $main::statistics{'command_counter_status'} = 0;
+ $main::statistics{'command_counter_search'} = 0;
+ $main::statistics{'command_counter_help'} = 0;
+ $main::statistics{'command_counter_info'} = 0;
+ $main::statistics{'command_counter_learn'} = 0;
+ $main::statistics{'command_counter_forget'} = 0;
+ $main::statistics{'command_counter_config'} = 0;
+ $main::statistics{'command_counter_status'} = 0;
$main::statistics{'command_counter_wallchan'} = 0;
- $main::statistics{'command_counter_say'} = 0;
- $main::statistics{'command_counter_join'} = 0;
- $main::statistics{'command_counter_leave'} = 0;
- $main::statistics{'command_counter_lost'} = 0;
- $main::statistics{'command_counter_url'} = 0;
- $main::statistics{'command_counter_key'} = 0;
+ $main::statistics{'command_counter_say'} = 0;
+ $main::statistics{'command_counter_join'} = 0;
+ $main::statistics{'command_counter_leave'} = 0;
+ $main::statistics{'command_counter_lost'} = 0;
+ $main::statistics{'command_counter_url'} = 0;
+ $main::statistics{'command_counter_key'} = 0;
- $main::statistics{'command_access_denied'} = 0;
+ $main::statistics{'command_access_denied'} = 0;
- $main::statistics{'database_connects'} = 0;
- $main::statistics{'database_queries'} = 0;
+ $main::statistics{'database_connects'} = 0;
+ $main::statistics{'database_queries'} = 0;
- $main::statistics{'connects'} = 0;
+ $main::statistics{'connects'} = 0;
}
# return:
# none
sub init_database {
+
print_msg("Init database configuration and connection", DEBUG);
# create database class
$main::db = docbot::db->new();
# fill in the configuration
- $main::db->set_config('name', config_get_key2('database', 'name'));
- $main::db->set_config('host', config_get_key2('database', 'host'));
- $main::db->set_config('port', (config_get_key2('database', 'port')) ? config_get_key2('database', 'port') : '5432');
+ $main::db->set_config('name', config_get_key2('database', 'name'));
+ $main::db->set_config('host', config_get_key2('database', 'host'));
+ $main::db->set_config('port', (config_get_key2('database', 'port')) ? config_get_key2('database', 'port') : '5432');
$main::db->set_config('username', config_get_key2('database', 'username'));
$main::db->set_config('password', config_get_key2('database', 'password'));
- $main::db->set_config('schema', (config_get_key2('database', 'schema')) ? config_get_key2('database', 'schema') : 'public');
+ $main::db->set_config('schema', (config_get_key2('database', 'schema')) ? config_get_key2('database', 'schema') : 'public');
# validate formal database configuration
if (!$main::db->verify_config()) {
# return:
# none
sub config_set_key1 {
- my $key1 = shift;
+ my $key1 = shift;
my $value = shift;
$main::config->config_set_key($key1, $value);
# return:
# none
sub config_set_key2 {
- my $key1 = shift;
- my $key2 = shift;
+ my $key1 = shift;
+ my $key2 = shift;
my $value = shift;
$main::config->config_set_key2($key1, $key2, $value);
# return:
# none
sub config_set_key3 {
- my $key1 = shift;
- my $key2 = shift;
- my $key3 = shift;
+ my $key1 = shift;
+ my $key2 = shift;
+ my $key3 = shift;
my $value = shift;
$main::config->config_set_key3($key1, $key2, $key3, $value);
# return:
# none
sub validate_config {
+
if (!config_get_key2('bot', 'commandchannel')) {
die("Please set config value 'bot:commandchannel'\n");
}
}
my @sessions = config_get_keys1('sessions');
- my %seen_nicknames = ();
- my %seen_sessions = ();
+ my %seen_nicknames = ();
+ my %seen_sessions = ();
my %channels_for_session = ();
foreach my $session (@sessions) {
if ($session !~ /^\d+$/) {
if ($nickname !~ /^[a-zA-Z0-9_\-]+$/) {
die("Please use a different nickname: $nickname\n");
}
- $seen_nicknames{$nickname} = 1;
- $seen_sessions{$session} = 1;
+ $seen_nicknames{$nickname} = 1;
+ $seen_sessions{$session} = 1;
$channels_for_session{$session} = 0;
}
# return:
# none
sub print_msg {
- my $msg = shift;
+ my $msg = shift;
my $level = shift || $main::loglevel;
if ($level > $main::loglevel) {
print "$timestamp ";
printf "%-8s", "[" . $main::loglevels{$level} . "]";
print "- $msg\n";
+
return 1;
}
exit(0);
}
}
-
}
$main::sessions{$session} = ();
my $nickname = config_get_key3('sessions', $session, 'nickname');
my $password = config_get_key3('sessions', $session, 'password');
- $main::sessions{$session}{'nickname'} = $nickname;
- $main::sessions{$session}{'password'} = $password;
+ $main::sessions{$session}{'nickname'} = $nickname;
+ $main::sessions{$session}{'password'} = $password;
$main::sessions{$session}{'joined_channels'} = [];
# for the watchdog
stop_session_activity($session);
$main::sessions{$session}{'last_nick_change_attempt'} = time();
- $main::sessions{$session}{'last_connect_time'} = undef;
+ $main::sessions{$session}{'last_connect_time'} = undef;
}
}
# none
sub send_to_channel {
my $channel = shift;
- my $msg = shift;
+ my $msg = shift;
+
$msg =~ s/\n//g;
my $session = session_for_channel($channel);
my @channels = config_get_keys1('channels');
my @join_channels = ();
foreach my $channel (@channels) {
- my $channel_session = config_get_key3('channels', $channel, 'session');
+ my $channel_session = config_get_key3('channels', $channel, 'session');
my $channel_autojoin = config_get_key3('channels', $channel, 'autojoin');
if (!defined($channel_autojoin)) {
$channel_autojoin = '';
# autojoin is the default
my $channel_autojoin_result = 1;
given ($channel_autojoin) {
- when(/^0$/) {$channel_autojoin_result = 0;}
- when(/^n$/) {$channel_autojoin_result = 0;}
- when(/^no$/) {$channel_autojoin_result = 0;}
- when(/^1$/) {$channel_autojoin_result = 1;}
- when(/^y$/) {$channel_autojoin_result = 1;}
+ when(/^0$/) {$channel_autojoin_result = 0;}
+ when(/^n$/) {$channel_autojoin_result = 0;}
+ when(/^no$/) {$channel_autojoin_result = 0;}
+ when(/^1$/) {$channel_autojoin_result = 1;}
+ when(/^y$/) {$channel_autojoin_result = 1;}
when(/^yes$/) {$channel_autojoin_result = 1;}
}
if ($channel_session == $session and $channel_autojoin_result == 1) {
}
}
}
-
}
# return:
# none
sub maintenance_5m {
+
if (!$main::db->test_database()) {
print_msg("Database not connected!", ERROR);
}
# none
sub send_to_commandchannel {
my $msg = shift;
+
$msg =~ s/\n//g;
my $commandchannel = config_get_key2('bot', 'commandchannel');
# return:
# none
sub death {
- print_msg("death()", DEBUG);
my $text = '';
if (defined($_[0])) {
$text = shift;
}
+ print_msg("death()", DEBUG);
+
if (length($text) > 0) {
$text = "Error: $text - shutting down";
} else {
# - rest of string
# undef if no command could be identified
sub find_command {
- my $msg = shift;
+ my $msg = shift;
my $channel = shift;
my ($command, $string);
if ($msg =~ /^\s*\?([a-z]+)\s*(.*)/) {
$command = lc($1);
- $string = defined($2) ? $2 : '';
+ $string = defined($2) ? $2 : '';
# looks like a command, at least started with a question mark
# find out if it really is one
# go the extra mile and identify commands in private messages to the bot
if ($msg =~ /^\s*([a-z]+)\s*(.*)/) {
$command = lc($1);
- $string = defined($2) ? $2 : '';
+ $string = defined($2) ? $2 : '';
# find out if it a command
if (is_valid_command($command)) {
# - 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 $word = shift;
+ my $default = shift;
my $translation = translate($language, $word);
if (!defined($translation)) {
# - translated text, or undef
sub translate {
my $language = shift;
- my $word = shift;
-
+ my $word = shift;
my $translation = config_get_key3('translations', $language, $word);
if (!defined($translation)) {
# - array with translations, or undef
sub translations {
my $language = shift;
- my $word = shift;
+ my $word = shift;
my $translation = config_get_key3('translations', $language, $word);
if (!defined($translation)) {
# return:
# - translation key, or undef
sub find_translation {
- my $language = shift;
- my $word = shift;
+ my $language = shift;
+ my $word = shift;
my $lowercase = 1;
if (defined($_[0])) {
$lowercase = shift;
# return:
# - translated text (or default text)
sub translate_text_for_channel {
- my $channel = shift;
- my $text_key = shift;
+ my $channel = shift;
+ my $text_key = shift;
my $default_text = shift;
my $text = $default_text;
# none
sub add_nick {
my ($heap, $who, $channel, $session) = @_;
+
print_msg("add_nick($who, channel: $channel, session: $session)", DEBUG2);
my %channels = %{$heap->{'chan_data_' . $session}};
# none
sub remove_nick {
my ($heap, $who, $channel, $session) = @_;
+
if (defined($channel)) {
print_msg("remove_nick($who, channel: $channel, session: $session)", DEBUG2);
} else {
# none
sub remove_channel {
my ($heap, $channel, $session) = @_;
+
print_msg("remove_channel($channel, session: $session)", DEBUG2);
my %channels = %{$heap->{'chan_data_' . $session}};
# - array with channels
sub find_nick {
my ($heap, $who, $session) = @_;
+
print_msg("find_nick($who, session: $session)", DEBUG2);
my %channels = %{$heap->{'chan_data_' . $session}};
return substr($string, 1);
}
-
return '';
}
# - text to send back to the sender
sub handle_command {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
}
}
-
return '';
}
# - text to send back to the sender
sub handle_command_quit {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
$poe_kernel->delay_add( execute_shutdown => 5 );
$shutdown = 1;
-
return '';
}
# - text to send back to the sender
sub handle_command_status {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
$irc->yield( privmsg => $channel, 'Joined channels: ' . join(", ", @channels) );
$irc->yield( privmsg => $channel, 'Number of IRC (re)connects: ' . $main::statistics{'connects'} );
my @commands = ();
- push(@commands, 'search: ' . $main::statistics{'command_counter_search'});
- push(@commands, 'help: ' . $main::statistics{'command_counter_help'});
- push(@commands, 'info: ' . $main::statistics{'command_counter_info'});
- push(@commands, 'learn: ' . $main::statistics{'command_counter_learn'});
- push(@commands, 'forget: ' . $main::statistics{'command_counter_forget'});
- push(@commands, 'config: ' . $main::statistics{'command_counter_config'});
+ push(@commands, 'search: ' . $main::statistics{'command_counter_search'});
+ push(@commands, 'help: ' . $main::statistics{'command_counter_help'});
+ push(@commands, 'info: ' . $main::statistics{'command_counter_info'});
+ push(@commands, 'learn: ' . $main::statistics{'command_counter_learn'});
+ push(@commands, 'forget: ' . $main::statistics{'command_counter_forget'});
+ push(@commands, 'config: ' . $main::statistics{'command_counter_config'});
push(@commands, 'wallchan: ' . $main::statistics{'command_counter_wallchan'});
- push(@commands, 'say: ' . $main::statistics{'command_counter_say'});
- push(@commands, 'join: ' . $main::statistics{'command_counter_join'});
- push(@commands, 'leave: ' . $main::statistics{'command_counter_leave'});
- push(@commands, 'status: ' . $main::statistics{'command_counter_status'});
- push(@commands, 'lost: ' . $main::statistics{'command_counter_lost'});
- push(@commands, 'url: ' . $main::statistics{'command_counter_url'});
- push(@commands, 'key: ' . $main::statistics{'command_counter_key'});
+ push(@commands, 'say: ' . $main::statistics{'command_counter_say'});
+ push(@commands, 'join: ' . $main::statistics{'command_counter_join'});
+ push(@commands, 'leave: ' . $main::statistics{'command_counter_leave'});
+ push(@commands, 'status: ' . $main::statistics{'command_counter_status'});
+ push(@commands, 'lost: ' . $main::statistics{'command_counter_lost'});
+ push(@commands, 'url: ' . $main::statistics{'command_counter_url'});
+ push(@commands, 'key: ' . $main::statistics{'command_counter_key'});
# don't bother to add 'quit' statistic here
$irc->yield( privmsg => $channel, 'Number of executed IRC commands: ' . join(", ", @commands) );
$irc->yield( privmsg => $channel, 'Number of denied IRC requests: ' . $main::statistics{'command_access_denied'} );
$irc->yield( privmsg => $channel, 'Number of executed database queries: ' . $main::statistics{'database_queries'} );
$irc->yield( privmsg => $channel, 'Number of database (re)connects: ' . $main::statistics{'database_connects'} );
-
return '';
}
# - text to send back to the sender
sub handle_command_lost {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
# 'lost' goes to the command channel only
if (lc($channel) eq lc($irc->nick_name())) {
my $answer = 'The "lost" command is only allowed in the command channel';
- # translate error message
- $answer = translate_text_for_channel($channel, 'lost_only_in_commandchannel', $answer);
+ $answer = translate_text_for_channel($channel, 'lost_only_in_commandchannel', $answer);
return $answer;
}
if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
my $answer = 'The "lost" command is only allowed in the command channel';
- # translate error message
- $answer = translate_text_for_channel($channel, 'lost_only_in_commandchannel', $answer);
+ $answer = translate_text_for_channel($channel, 'lost_only_in_commandchannel', $answer);
return $answer;
}
my $st = $main::db->query($query);
if (!defined($st)) {
my $answer = "Database error";
- # translate error message
- $answer = translate_text_for_channel($channel, 'database_error', $answer);
+ $answer = translate_text_for_channel($channel, 'database_error', $answer);
return $answer;
}
my $rows = $st->rows;
}
}
-
return '';
}
# - text to send back to the sender
sub handle_command_url {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
# 'url' goes to the command channel only
if (lc($channel) eq lc($irc->nick_name())) {
my $answer = 'The "url" command is only allowed in the command channel';
- # translate error message
- $answer = translate_text_for_channel($channel, 'url_only_in_commandchannel', $answer);
+ $answer = translate_text_for_channel($channel, 'url_only_in_commandchannel', $answer);
return $answer;
}
if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
my $answer = 'The "url" command is only allowed in the command channel';
- # translate error message
- $answer = translate_text_for_channel($channel, 'url_only_in_commandchannel', $answer);
+ $answer = translate_text_for_channel($channel, 'url_only_in_commandchannel', $answer);
return $answer;
}
if (length($string) < 1) {
my $answer = 'The "url" command requires a parameter';
- $answer = translate_text_for_channel($channel, 'error_url_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_url_command_parameter', $answer);
return $answer;
}
$main::statistics{'command_counter_url'}++;
- my $query = "SELECT key FROM docbot_key WHERE kurl IN (SELECT id FROM docbot_url WHERE url = ?::TEXT) ORDER BY key";
+ my $query = "SELECT key
+ FROM docbot_key
+ WHERE kurl IN (SELECT id
+ FROM docbot_url
+ WHERE url = ?::TEXT)
+ ORDER BY key";
my $st = $main::db->query($query, $string);
if (!defined($st)) {
my $answer = "Database error";
- # translate error message
- $answer = translate_text_for_channel($channel, 'database_error', $answer);
+ $answer = translate_text_for_channel($channel, 'database_error', $answer);
return $answer;
}
my $rows = $st->rows;
}
}
-
return '';
}
# - text to send back to the sender
sub handle_command_key {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
# 'key' goes to the command channel only
if (lc($channel) eq lc($irc->nick_name())) {
my $answer = 'The "key" command is only allowed in the command channel';
- # translate error message
- $answer = translate_text_for_channel($channel, 'key_only_in_commandchannel', $answer);
+ $answer = translate_text_for_channel($channel, 'key_only_in_commandchannel', $answer);
return $answer;
}
if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
my $answer = 'The "key" command is only allowed in the command channel';
- # translate error message
- $answer = translate_text_for_channel($channel, 'key_only_in_commandchannel', $answer);
+ $answer = translate_text_for_channel($channel, 'key_only_in_commandchannel', $answer);
return $answer;
}
if (length($string) < 1) {
my $answer = 'The "key" command requires a parameter';
- $answer = translate_text_for_channel($channel, 'error_key_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_key_command_parameter', $answer);
return $answer;
}
$main::statistics{'command_counter_key'}++;
- my $query = "SELECT url FROM docbot_url WHERE id IN (SELECT kurl FROM docbot_key WHERE key = ?::TEXT) ORDER BY url";
+ my $query = "SELECT url
+ FROM docbot_url
+ WHERE id IN (SELECT kurl
+ FROM docbot_key
+ WHERE key = ?::TEXT)
+ ORDER BY url";
my $st = $main::db->query($query, $string);
if (!defined($st)) {
my $answer = "Database error";
- # translate error message
- $answer = translate_text_for_channel($channel, 'database_error', $answer);
+ $answer = translate_text_for_channel($channel, 'database_error', $answer);
return $answer;
}
my $rows = $st->rows;
}
}
-
return '';
}
# - text to send back to the sender
sub handle_command_wallchan {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
if (length($string) < 1) {
my $answer = 'The "wallchan" command requires a parameter';
- $answer = translate_text_for_channel($channel, 'error_wallchan_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_wallchan_command_parameter', $answer);
return $answer;
}
}
foreach my $tmp_channel (@channels) {
my $answer = 'Operator message';
- $answer = translate_text_for_channel($tmp_channel, 'wallchan_command_message', $answer);
+ $answer = translate_text_for_channel($tmp_channel, 'wallchan_command_message', $answer);
send_to_channel($tmp_channel, $answer . ': ' . $string);
}
-
return '';
}
# - text to send back to the sender
sub handle_command_say {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
if (length($string) < 1) {
my $answer = 'The "say" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_say_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_say_command_parameter', $answer);
return $answer;
}
my ($msg_channel, $message);
if ($string =~ /^([^\s]+)\s+(.+)$/) {
$msg_channel = $1;
- $message = $2;
+ $message = $2;
} else {
my $answer = 'The "say" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_say_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_say_command_parameter', $answer);
return $answer;
}
if (!is_a_channel($msg_channel)) {
my $answer = 'The "say" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_say_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_say_command_parameter', $answer);
return $answer;
}
if (!$msg_session) {
my $answer = 'The bot is not in this channel';
- $answer = translate_text_for_channel($channel, 'error_say_not_joined', $answer);
+ $answer = translate_text_for_channel($channel, 'error_say_not_joined', $answer);
return $answer;
}
send_to_channel($msg_channel, $message);
$main::statistics{'command_counter_say'}++;
-
return '';
}
# - text to send back to the sender
sub handle_command_join {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
if (length($string) < 1) {
my $answer = 'The "join" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
return $answer;
}
$join_channel = $1;
$join_session = $2;
} elsif ($string =~ /^([^\s]+)\s+(\d+)\s+([a-z]+)$/) {
- $join_channel = $1;
- $join_session = $2;
+ $join_channel = $1;
+ $join_session = $2;
$join_parameter1 = $3;
$join_parameter2 = '';
} elsif ($string =~ /^([^\s]+)\s+(\d+)\s+([a-z:A-Z0-9]+)\s+([a-z:A-Z0-9]+)$/) {
- $join_channel = $1;
- $join_session = $2;
+ $join_channel = $1;
+ $join_session = $2;
$join_parameter1 = $3;
$join_parameter2 = $4;
} else {
my $answer = 'The "join" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
return $answer;
}
if (!is_a_channel($join_channel)) {
my $answer = 'The "join" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
return $answer;
}
if (!defined($main::sessions{$join_session})) {
my $answer = 'The "join" command requires two parameters';
- $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_join_command_parameter', $answer);
return $answer;
}
my $join_irc = $main::sessions{$join_session}{'session'};
$join_language = 'en';
if ($join_parameter1 =~ /^lang:([a-z]+)$/) {
- $join_language = $1;
+ $join_language = $1;
$join_parameter1 = '';
}
if ($join_parameter2 =~ /^lang:([a-z])$/) {
- $join_language = $1;
+ $join_language = $1;
$join_parameter2 = '';
}
$join_parameter1 = '';
}
if ($join_parameter1 =~ /^password:(.+)$/) {
- $join_password = $1;
+ $join_password = $1;
$join_parameter1 = '';
}
if ($join_parameter2 =~ /^pass:(.+)$/) {
- $join_password = $1;
+ $join_password = $1;
$join_parameter2 = '';
}
if ($join_parameter2 =~ /^password:(.+)$/) {
- $join_password = $1;
+ $join_password = $1;
$join_parameter2 = '';
}
if (length($join_parameter1) > 0 or length($join_parameter2) > 0) {
my $answer = 'Invalid parameter';
- $answer = translate_text_for_channel($channel, 'invalid_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'invalid_parameter', $answer);
return $answer;
}
if (session_for_channel($join_channel)) {
my $answer = 'The bot already joined this channel';
- $answer = translate_text_for_channel($channel, 'error_join_already_joined', $answer);
+ $answer = translate_text_for_channel($channel, 'error_join_already_joined', $answer);
return $answer;
}
config_set_key3('channels', lc($join_channel), 'language', $join_language);
}
-
return '';
}
# - text to send back to the sender
sub handle_command_leave {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
if (length($string) < 1) {
my $answer = 'The "leave" command requires one parameter';
- $answer = translate_text_for_channel($channel, 'error_leave_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_leave_command_parameter', $answer);
return $answer;
}
$leave_channel = $1;
} else {
my $answer = 'The "leave" command requires one parameter';
- $answer = translate_text_for_channel($channel, 'error_leave_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_leave_command_parameter', $answer);
return $answer;
}
if (!is_a_channel($leave_channel)) {
my $answer = 'The "leave" command requires one parameter';
- $answer = translate_text_for_channel($channel, 'error_leave_command_parameter', $answer);
+ $answer = translate_text_for_channel($channel, 'error_leave_command_parameter', $answer);
return $answer;
}
my $leave_session = session_for_channel($leave_channel);
if (!$leave_session) {
my $answer = 'The bot is not in this channel';
- $answer = translate_text_for_channel($channel, 'error_leave_not_joined', $answer);
+ $answer = translate_text_for_channel($channel, 'error_leave_not_joined', $answer);
return $answer;
}
my $leave_irc = $main::sessions{$leave_session}{'session'};
$leave_irc->yield( part => $leave_channel );
$main::statistics{'command_counter_leave'}++;
-
return '';
}
# - text to send back to the sender
sub handle_command_search {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
my $session = find_irc_session($irc);
$replyto = $nick;
} elsif ($string =~ /^(.+)\s+>\s+(\w+)/i) {
if (grep(/^$channel$/i, find_nick($heap, $2, $session))) {
- $string = $1;
+ $string = $1;
$replyto = $2;
} else {
return '';
if ($string !~ /^[a-zA-Z0-9 ]+$/) {
my $answer = "Invalid search";
- # translate error message
- $answer = translate_text_for_channel($channel, 'invalid_search', $answer);
+ $answer = translate_text_for_channel($channel, 'invalid_search', $answer);
return $answer;
}
# compose the search
my @keys = split(/\s+/, $string);
- my $query_inner = "SELECT kurl FROM docbot_key WHERE LOWER(key) = ?";
- my $query = "SELECT url FROM docbot_url WHERE id IN (";
+ my $query_inner = "SELECT kurl
+ FROM docbot_key
+ WHERE LOWER(key) = ?";
+ my $query = "SELECT url
+ FROM docbot_url
+ WHERE id IN (";
$query .= join("\n INTERSECT\n" => map {"$query_inner\n"} @keys);
$query .= ")";
# FIXME: sort order
my $st = $main::db->query($query, @keys);
if (!defined($st)) {
my $answer = "Database error";
- # translate error message
- $answer = translate_text_for_channel($channel, 'database_error', $answer);
+ $answer = translate_text_for_channel($channel, 'database_error', $answer);
return $answer;
}
my $rows = $st->rows;
if ($rows == 0) {
my $answer = "Nothing found";
- # translate error message
- $answer = translate_text_for_channel($channel, 'nothing_found', $answer);
+ $answer = translate_text_for_channel($channel, 'nothing_found', $answer);
return $answer;
}
}
}
-
return '';
}
# - text to send back to the sender
sub handle_command_help {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
$replyto = $nick;
} elsif ($string =~ /^(.+)\s+>\s+(\w+)/i) {
if (grep(/^$channel$/i, find_nick($heap, $2, $session))) {
- $string = $1;
+ $string = $1;
$replyto = $2;
} else {
return '';
if (length($string) == 0) {
my $answer = "General help";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_1', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_1', $answer);
$irc->yield( privmsg => $replyto, $answer . ':' );
$answer = "Start a search with two question marks, followed by the search term";
if ($string eq 'search') {
my $answer = "Start a search with two question marks, followed by the search term";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_2', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_2', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'say') {
my $answer = "Use ?say #channel message";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_say', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_say', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'lost') {
my $answer = "Use ?lost";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_lost', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_lost', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'url') {
my $answer = "Use ?url <url>";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_url', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_url', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'url') {
my $answer = "Use ?key <key>";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_key', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_key', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'quit') {
my $answer = "Use ?quit";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_quit', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_quit', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'join') {
my $answer = "Use ?join <channel name> <session number> lang:<language> pass:<channel password>";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_join', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_join', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
if ($string eq 'leave') {
my $answer = "Use ?leave";
- # translate message
- $answer = translate_text_for_channel($replyto, 'help_general_line_leave', $answer);
+ $answer = translate_text_for_channel($replyto, 'help_general_line_leave', $answer);
$irc->yield( privmsg => $replyto, $answer );
}
# - text to send back to the sender
sub handle_command_learn {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
my $session = find_irc_session($irc);
if (scalar(@keywords) == 0 || !defined($url)) {
my $answer = "Bad parameters";
- # translate message
- $answer = translate_text_for_channel($channel, 'search_bad_parameters', $answer);
+ $answer = translate_text_for_channel($channel, 'search_bad_parameters', $answer);
return $answer;
}
my %keywords = map { $_, 1 } @keywords;
$main::db->rollback();
# insert keywords
- my $st = $main::db->query("SELECT id FROM docbot_url WHERE url = ?", $url);
+ my $st = $main::db->query("SELECT id
+ FROM docbot_url
+ WHERE url = ?", $url);
if (!$st) {
$main::db->rollback();
return $database_error;
my ($row2) = $st2->fetchrow;
if (!$row2) {
# keyword not yet linked to url
- if (!$main::db->query("INSERT INTO docbot_key (key, kurl) VALUES (?, ?)", $keyword, $kurl)) {
+ if (!$main::db->query("INSERT INTO docbot_key (key, kurl)
+ VALUES (?, ?)", $keyword, $kurl)) {
$main::db->rollback();
return $database_error;
}
return $answer;
} else {
my $answer = "Successfully added %1 keywords";
- $answer =~ s/\%1/$new_keys/;
+ $answer =~ s/\%1/$new_keys/;
print_msg($answer, DEBUG);
$answer = "Successfully added %1 keywords";
# translate message
return $answer;
} else {
my $answer = "Successfully added URL with %1 keywords";
- $answer =~ s/\%1/$new_keys/;
+ $answer =~ s/\%1/$new_keys/;
print_msg($answer, DEBUG);
$answer = "Successfully added URL with %1 keywords";
# translate message
}
}
-
return 'ERROR';
}
# - text to send back to the sender
sub handle_command_forget {
my $command = shift;
- my $string = shift;
- my $mode = shift;
- my $kernel = shift;
- my $heap = shift;
- my $who = shift;
- my $nick = shift;
- my $where = shift;
- my $msg = shift;
- my $sender = shift;
- my $irc = shift;
+ my $string = shift;
+ my $mode = shift;
+ my $kernel = shift;
+ my $heap = shift;
+ my $who = shift;
+ my $nick = shift;
+ my $where = shift;
+ my $msg = shift;
+ my $sender = shift;
+ my $irc = shift;
my $channel = shift;
my $session = find_irc_session($irc);
if (($keys[0] !~ /$url_pattern/i) and ($keys[1] =~ /$url_pattern/i) and (scalar(@keys) > 2)) {
my $answer = "Bad parameters";
- # translate message
- $answer = translate_text_for_channel($channel, 'search_bad_parameters', $answer);
+ $answer = translate_text_for_channel($channel, 'search_bad_parameters', $answer);
return $answer;
}
if (scalar(@keys) == 2 and $keys[1] =~ /$url_pattern/) {
# key url
- my $st = $main::db->query("DELETE FROM docbot_key WHERE key = ? AND kurl IN (SELECT id FROM docbot_url WHERE url = ?)", $keys[0], $keys[1]);
+ my $st = $main::db->query("DELETE FROM docbot_key
+ WHERE key = ?
+ AND kurl IN (SELECT id
+ FROM docbot_url
+ WHERE url = ?)", $keys[0], $keys[1]);
if (!$st) {
$main::db->rollback();
return $database_error;
return $answer;
} else {
my $answer = "Forgot %1 urls";
- $answer =~ s/\%1/$rows/;
+ $answer =~ s/\%1/$rows/;
print_msg($answer, DEBUG);
# translate message
$answer = translate_text_for_channel($channel, 'forget_forgot_n_urls', $answer);
return $answer;
} else {
my $answer = "Forgot %1 urls";
- $answer =~ s/\%1/$rows/;
+ $answer =~ s/\%1/$rows/;
print_msg($answer, DEBUG);
# translate message
$answer = translate_text_for_channel($channel, 'forget_forgot_n_urls', $answer);
return $answer;
} else {
my $answer = "Forgot %1 keys";
- $answer =~ s/\%1/$rows/;
+ $answer =~ s/\%1/$rows/;
print_msg($answer, DEBUG);
# translate message
$answer = translate_text_for_channel($channel, 'forget_forgot_n_keys', $answer);
}
-
return 'ERROR';
}
#
sub on_start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
- my $irc = $heap->{irc};
+
+ my $irc = $heap->{irc};
my $session = find_irc_session($irc);
print_msg("on_start(session: $session)", DEBUG);
$irc->plugin_add( 'Connector' => $heap->{connector} );
$irc->plugin_add( 'CTCP' => POE::Component::IRC::Plugin::CTCP->new(
- version => '2.0',
- userinfo => 'PostgreSQL docbot - session: ' . $session,
+ version => '2.0',
+ userinfo => 'PostgreSQL docbot - session: ' . $session,
clientinfo => 'http://pgfoundry.org/projects/docbot/',
- source => 'http://git.postgresql.org/gitweb/?p=docbot.git;a=summary',
+ source => 'http://git.postgresql.org/gitweb/?p=docbot.git;a=summary',
));
$irc->yield( connect => { Debug => $main::debug_traffic } );
# Since this is an irc_* event, we can get the component's object by
# accessing the heap of the sender. Then we register and connect to the
# specified server.
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("Session $session connected to " . $irc->server_name(), DEBUG);
- $main::sessions{$session}{'past_motd'} = 0;
+ $main::sessions{$session}{'past_motd'} = 0;
$main::sessions{$session}{'last_nick_change_attempt'} = time();
- $main::sessions{$session}{'last_connect_time'} = time();
- $main::sessions{$session}{'logged_in'} = 1;
+ $main::sessions{$session}{'last_connect_time'} = time();
+ $main::sessions{$session}{'logged_in'} = 1;
# might need this pointers in the maintenance routines
- $main::sessions{$session}{'kernel'} = \$kernel;
- $main::sessions{$session}{'heap'} = \$heap;
+ $main::sessions{$session}{'kernel'} = \$kernel;
+ $main::sessions{$session}{'heap'} = \$heap;
# get all channels for this session from config
my @channels = config_get_keys1('channels');
my @join_channels = ();
foreach my $channel (@channels) {
- my $channel_session = config_get_key3('channels', $channel, 'session');
+ my $channel_session = config_get_key3('channels', $channel, 'session');
my $channel_autojoin = config_get_key3('channels', $channel, 'autojoin');
if (!defined($channel_autojoin)) {
$channel_autojoin = '';
# autojoin is the default
my $channel_autojoin_result = 1;
given ($channel_autojoin) {
- when(/^0$/) {$channel_autojoin_result = 0;}
- when(/^n$/) {$channel_autojoin_result = 0;}
- when(/^no$/) {$channel_autojoin_result = 0;}
- when(/^1$/) {$channel_autojoin_result = 1;}
- when(/^y$/) {$channel_autojoin_result = 1;}
+ when(/^0$/) {$channel_autojoin_result = 0;}
+ when(/^n$/) {$channel_autojoin_result = 0;}
+ when(/^no$/) {$channel_autojoin_result = 0;}
+ when(/^1$/) {$channel_autojoin_result = 1;}
+ when(/^y$/) {$channel_autojoin_result = 1;}
when(/^yes$/) {$channel_autojoin_result = 1;}
}
if ($channel_session == $session and $channel_autojoin_result == 1) {
}
$heap->{'chan_data_' . $session} = \%chan_data;
-
return;
}
#
sub on_message {
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 $nick = ( split /!/, $who )[0];
+ my $channel = $where->[0];
+ my $replyto = $channel;
my $full_msg = $msg;
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_message($msg), session: $session", DEBUG);
}
}
-
}
my ($kernel, $heap, $detail, $sender) = @_[KERNEL, HEAP, ARG1, SENDER];
my $nick = ( split / /, $detail )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_whois_identified(session: $session, nick: $nick)", DEBUG);
my ($kernel, $heap, $detail, $sender) = @_[KERNEL, HEAP, ARG1, SENDER];
my $nick = ( split / /, $detail )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_whois_end(session: $session, nick: $nick)", DEBUG);
sub on_ping {
my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_ping(session: $session)", DEBUG);
sub do_autoping {
my ($sender, $kernel, $heap) = @_[SENDER, KERNEL, HEAP];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("do_autoping(session: $session)", DEBUG);
sub on_irc_registered {
my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
#print_msg("on_irc_registered(session: $session)", DEBUG);
sub on_irc_plugin_add {
my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
#print_msg("on_irc_plugin_add(session: $session)", DEBUG);
sub on_nickused {
my ($kernel, $heap, $nick_name) = @_[KERNEL, HEAP, ARG1];
- my $irc = $heap->{irc};
+ my $irc = $heap->{irc};
my $session = find_irc_session($irc);
print_msg("on_nickused(session: $session)", DEBUG);
sub on_end_motd {
my ($kernel, $heap) = @_[KERNEL, HEAP];
- my $irc = $heap->{irc};
+ my $irc = $heap->{irc};
my $session = find_irc_session($irc);
print_msg("on_end_motd(session: $session)", DEBUG);
}
}
-
$main::sessions{$session}{'past_motd'} = 1;
}
sub on_error {
my ($sender, $kernel, $heap, $text) = @_[SENDER, KERNEL, HEAP, ARG0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_error(session: $session, error: \"" . $text . "\")", DEBUG);
sub on_disconnected {
my ($sender, $kernel, $heap, $text) = @_[SENDER, KERNEL, HEAP, ARG0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_disconnected(session: $session, error: \"" . $text . "\")", DEBUG);
my ($sender, $kernel, $heap, $who, $channel) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
my $nick = ( split /!/, $who )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_join(session: $session, nick: $nick, channel: $channel)", DEBUG);
my ($sender, $kernel, $heap, $who, $channel) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
my $nick = ( split /!/, $who )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_part(session: $session, nick: $nick, channel: $channel)", DEBUG);
my ($sender, $kernel, $heap, $who) = @_[SENDER, KERNEL, HEAP, ARG0];
my $nick = ( split /!/, $who )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_quit(session: $session, nick: $nick)", DEBUG);
my ($sender, $kernel, $heap, $who, $new) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
my $nick = ( split /!/, $who )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_nick(session: $session, nick: $nick to nick: $new)", DEBUG);
}
}
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_names(session: $session)", DEBUG2);
sub on_kick {
my ($sender, $kernel, $heap, $kicker, $channel, $who, $reason) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
my $nick = ( split /!/, $who )[0];
- $kicker = ( split /!/, $kicker )[0];
+ $kicker = ( split /!/, $kicker )[0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_kick(session: $session, nick: $nick, channel: $channel, by: $kicker)", DEBUG);
sub on_cannot_join_channel {
my ($sender, $kernel, $heap, $arg0, $arg1, $arg2) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1, ARG2];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
print_msg("on_cannot_join_channel(session: $session): $arg1", DEBUG);
sub on_irc_raw {
my ($sender, $kernel, $heap, $raw) = @_[SENDER, KERNEL, HEAP, ARG0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
set_session_activity($session);
sub on_irc_raw_out {
my ($sender, $kernel, $heap, $raw) = @_[SENDER, KERNEL, HEAP, ARG0];
- my $irc = $sender->get_heap();
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
# do not mark session activity - if the session is timed out, it's not helpful if outgoing traffic marks new activity
sub on_irc_notice {
my ($sender, $kernel, $heap, $who, $notice) = @_[SENDER, KERNEL, HEAP, ARG0, ARG2];
- my $nick = ( split /!/, $who )[0];
- my $irc = $sender->get_heap();
+ my $nick = ( split /!/, $who )[0];
+ my $irc = $sender->get_heap();
my $session = find_irc_session($irc);
given ($who) {
my $print_it = 1;
given ($event) {
- when('autoping') { $print_it = 0; }
- when('irc_ping') { $print_it = 0; }
- when('irc_pong') { $print_it = 0; }
- when('irc_connected') { $print_it = 0; }
- when('irc_snotice') { $print_it = 0; }
- when('irc_whois') { $print_it = 0; }
- when('irc_mode') { $print_it = 0; }
- when('irc_topic') { $print_it = 0; }
- when('irc_ctcp_action') { $print_it = 0; }
- when('irc_ctcp') { $print_it = 0; }
- when('irc_isupport') { $print_it = 0; }
- when('irc_nick') { $print_it = 0; }
- when('autoping') { $print_it = 0; }
+ when('autoping') { $print_it = 0; }
+ when('irc_ping') { $print_it = 0; }
+ when('irc_pong') { $print_it = 0; }
+ when('irc_connected') { $print_it = 0; }
+ when('irc_snotice') { $print_it = 0; }
+ when('irc_whois') { $print_it = 0; }
+ when('irc_mode') { $print_it = 0; }
+ when('irc_topic') { $print_it = 0; }
+ when('irc_ctcp_action') { $print_it = 0; }
+ when('irc_ctcp') { $print_it = 0; }
+ when('irc_isupport') { $print_it = 0; }
+ when('irc_nick') { $print_it = 0; }
+ when('autoping') { $print_it = 0; }
when('irc_disconnected') { $print_it = 0; }
- when('irc_socketerr') { $print_it = 0; }
- when('irc_cap') { $print_it = 0; }
+ when('irc_socketerr') { $print_it = 0; }
+ when('irc_cap') { $print_it = 0; }
when('irc_notice') {
- if (@$args[0] =~ /^NickServ/) { $print_it = 0; }
- if (@$args[0] =~ /^ChanServ/) { $print_it = 0; }
+ if (@$args[0] =~ /^NickServ/) { $print_it = 0; }
+ if (@$args[0] =~ /^ChanServ/) { $print_it = 0; }
if (@$args[0] =~ /\.freenode\.net/i) { $print_it = 0; }
}
when('irc_ctcp_version') {
projects / docbot.git / commitdiff