#!/usr/bin/env perl
#
###########################################################
#                                                         #
# PostgreSQL IRC Info Bot                                 #
#                                                         #
# Copyright 2005-2012 by:                                 #
# Petr Jelinek, Devdas Bhagat, Steve Atkins, David Fetter #
# Andreas Scherbaum, Greg Sabino Mullane                  #
#                                                         #
# Released under BSD licence                              #
#                                                         #
###########################################################



######################################################################
# how to add new IRC command:
# - add the command in handle_command()
# - implement command handler function
# - add new statistic counter in init_statistics()
# - output command statistic in handle_command_status()
# - add the command to is_valid_command(), is_valid_operator_command() and/or is_valid_admin_command()
# - add help for the command in handle_command_help()
# - add the command to the command list in handle_command_help()
# - add any required translation to docbot.translations




######################################################################
# load modules
######################################################################

require("./config.pm");
require("./db.pm");

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 Component::IRC Component::IRC::Plugin::CTCP);
use POE::Component::IRC;
use Getopt::Long qw( :config no_ignore_case );
use FileHandle;
use Data::Dumper;
use POSIX ":sys_wait_h";
use Scalar::Util 'refaddr';
use YAML::XS qw (/./);
use URI::Escape;
use File::Pid;
use feature qw/switch/;
import docbot::config;
import docbot::db;


######################################################################
# initialize global variables
######################################################################

use constant DEBUG2 => 5;
use constant DEBUG  => 4;
use constant INFO   => 3;
use constant WARN   => 2;
use constant ERROR  => 1;

%main::loglevels = (
    5 => 'DEBUG2',
    4 => 'DEBUG',
    3 => 'INFO',
    2 => 'WARN',
    1 => 'ERROR',
);

$main::loglevel = INFO;



# list of sessions
%main::sessions = ();
# logfile name
$main::logfile = 'docbot.log';
# statistics
%main::statistics = ();
init_statistics();
# channel ringbuffer
%main::channels = ();


######################################################################
# handle command line arguments
######################################################################
# defaults
$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,
    )
) {
    # There were some errors with parsing command line options - show help.
    $main::help = 1;
}

my $shutdown = 0;









######################################################################
# Main
######################################################################


if ($main::help == 1) {
    print <<_END_OF_HELP_;

  $0 [options]

The following options are available:
  -h --help          This help
  -d --debug         Enable debug messages
  -D --debug-irc     Enable IRC traffic debugging
  -c --config        Config file (required)
  -l --logfile       Logfile
  -t --translations  Translations

_END_OF_HELP_
    exit(0);
}

init_terminal();

init_config();
if (length($main::config_file) > 0) {
    read_config($main::config_file);
} else {
    print_msg("No configfile!", ERROR);
    exit();
}


init_translations();
read_translations($main::translations_file);


# create pid file
my $pidfile_name = config_get_key2('system', 'pidfile');
my ($pidfile);
if (defined($pidfile_name)) {
    my $pidfile = File::Pid->new({ file => $pidfile_name, pid => $$ });
    my $pid_running = $pidfile->running;
    if (defined($pid_running)) {
        print_msg("Another docbot instance is running!", ERROR);
        print_msg("PID of the other instance: $pid_running", INFO);
        exit(1);
    }
    if (!defined($pidfile->write)) {
        my $error_msg = $!;
        print_msg("Not able to write PID file!", ERROR);
        print_msg("Error: $error_msg", INFO);
        exit(1);
    }
    print_msg("Wrote PID " . $pidfile->pid . " to file " . $pidfile_name . "", DEBUG);
}


init_database();
init_sessions();



print_msg("Creating new IRC bot");

# create a set of POE sessions
foreach my $session (keys(%main::sessions)) {
    my $name   = config_get_key2('irc', 'name');
    my $server = config_get_key2('irc', 'server');
    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'},
                  Ircname => $name,
                  Server  => $server,
                  Port    => $port,
                  Raw     => 1,
                  UseSSL  => $ssl,
              );
    if (!$irc) {
        print_msg("Could not spawn POE session: $!", ERROR);
        death();
    }
    $main::sessions{$session}{'session'} = $irc;

    # create a new POE session for each session
    POE::Session->create(
        inline_states => {
            _start           => \&on_start,
            _default         => \&_default,
            irc_001          => \&on_connect,
            irc_public       => \&on_message,
            irc_msg          => \&on_message,
            irc_376          => \&on_end_motd,
            irc_433          => \&on_nickused,
            irc_330          => \&on_whois_identified,
            irc_318          => \&on_whois_end,
            irc_join         => \&on_join,
            irc_part         => \&on_part,
            irc_nick         => \&on_nick,
            irc_quit         => \&on_quit,
            irc_kick         => \&on_kick,
            irc_353          => \&on_names,
            irc_475          => \&on_cannot_join_channel,
            irc_notice       => \&on_irc_notice,
            irc_ping         => \&on_ping,
            autoping         => \&do_autoping,
            irc_error        => \&on_error,
            irc_disconnected => \&on_disconnected,
            irc_registered   => \&on_irc_registered,
            irc_plugin_add   => \&on_irc_plugin_add,
            irc_raw          => \&on_irc_raw,
            irc_raw_out      => \&on_irc_raw_out,
            execute_shutdown => \&execute_shutdown,
        },
        heap => { irc => $irc },
    );



#    inline_states => {
#        irc_353          => \&on_names,
#        irc_part         => \&on_part,
#        irc_nick         => \&on_nick,
#        irc_330          => \&on_whois_identified,
#        irc_318          => \&on_whois_end,
#        irc_public       => \&on_message,
#        irc_msg          => \&on_message,
#        irc_cap          => \&on_irc_cap,
#        irc_isupport     => \&on_irc_isupport,
#        irc_notice       => \&on_irc_notice,
#        irc_ctcp         => \&on_irc_ctcp,
#        irc_372          => \&on_motd,
# nickserv

}



# this POE session will be the watchdog
# ticked every 10 seconds
POE::Session->create(
    inline_states => {
        _start => sub {
            # 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( TERM => 'got_sig_term' );
            $_[KERNEL]->sig( KILL => 'got_sig_kill' );
            $_[KERNEL]->sig( HUP  => 'got_sig_hup' );
        },

        # a tick every 10 seconds
        tick => sub {
            # make sure the next tick is initialized
            $_[HEAP]->{next_alarm_time} = $_[HEAP]->{next_alarm_time} + 10;
            $_[KERNEL]->alarm(tick => $_[HEAP]->{next_alarm_time});

            # 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,
        execute_shutdown => \&execute_shutdown,
    },
);


# this POE session will start maintenance operations
# ticked every n minutes
POE::Session->create(
    inline_states => {
        _start => sub {
            # start the next ticks
            $_[HEAP]->{next_alarm_time_1m} = int(time()) + 60;
            $_[KERNEL]->alarm(tick_1m => $_[HEAP]->{next_alarm_time_1m});
            $_[HEAP]->{next_alarm_time_5m} = int(time()) + 60 * 5;
            $_[KERNEL]->alarm(tick_5m => $_[HEAP]->{next_alarm_time_5m});
        },

        # a tick every minute
        tick_1m => sub {
            # make sure the next tick is initialized
            $_[HEAP]->{next_alarm_time_1m} = $_[HEAP]->{next_alarm_time_1m} + 60;
            $_[KERNEL]->alarm(tick_1m => $_[HEAP]->{next_alarm_time_1m});

            # call the real maintenance function
            maintenance_1m();
        },
        # a tick every 5 minutes
        tick_5m => sub {
            # make sure the next tick is initialized
            $_[HEAP]->{next_alarm_time_5m} = $_[HEAP]->{next_alarm_time_5m} + 60 * 5;
            $_[KERNEL]->alarm(tick_5m => $_[HEAP]->{next_alarm_time_5m});

            # call the real maintenance function
            maintenance_5m();
        },
        execute_shutdown => \&execute_shutdown,
    },
);





# run the bot until it is done.
$poe_kernel->run();
exit 0;





######################################################################
# regular functions used by the bot
######################################################################


# init_statistics()
#
# init statistic counters
#
# parameter:
#  none
# 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_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_grant'}      = 0;
    $main::statistics{'command_counter_revoke'}     = 0;
    $main::statistics{'command_counter_user'}       = 0;
    $main::statistics{'command_counter_learnuser'}  = 0;
    $main::statistics{'command_counter_forgetuser'} = 0;

    $main::statistics{'command_access_denied'}      = 0;

    $main::statistics{'database_connects'}          = 0;
    $main::statistics{'database_queries'}           = 0;

    $main::statistics{'connects'}                   = 0;
}


# init_database()
#
# init configuration
#
# parameter:
#  none
# 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('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');

    # validate formal database configuration
    if (!$main::db->verify_config()) {
        die("Database configuration is incomplete!\n");
    }
    # open database connection
    if (!$main::db->open_db_connection()) {
        die("Could not open database connection!\n");
    }
    # and test connectivity
    if (!$main::db->test_database()) {
        die("Could not test database connection!\n");
    }
    # and verify table existence
    if (!$main::db->verify_tables()) {
        die("Required tables are not available!\n");
    }
}


# init_config()
#
# init configuration
#
# parameter:
#  none
# return:
#  none
sub init_config {

    $main::config = docbot::config->new();
    $main::config->set_autosave("off");
}


# read_config()
#
# read configuration & set variables accordingly
#
# parameter:
#  - config file name
# return:
#  none
sub read_config {
    my $config_file = shift;

    print_msg("Read configuration file: $config_file", DEBUG);
    $main::config->read_config($config_file);

    validate_config();
}


# init_translations()
#
# init translations
#
# parameter:
#  none
# return:
#  none
sub init_translations {

    if (length($main::translations_file) == 0) {
        # translations not a commandline parameter
        # read filename from configuration
        my $translations_file = config_get_key2('translations', 'file');
        if (defined($translations_file) and -f $translations_file) {
            $main::translations_file = $translations_file;
        } elsif (defined($translations_file)) {
            print_msg("translations file (" . $translations_file . ") from configuration not found", ERROR);
            exit(1);
        }
    } elsif (!-f $main::translations_file) {
        print_msg("translations file (" . $main::translations_file . ") from commandline not found", ERROR);
        exit(1);
    }
}


# read_translations()
#
# read translations
#
# parameter:
#  - translations file name
# return:
#  none
sub read_translations {
    my $translations_file = shift;

    if (length($translations_file) > 0 and -f $translations_file) {
        print_msg("Read configuration file: $translations_file", DEBUG);
        $main::config->read_additional_config($translations_file);
    } else {
        print_msg("No translations file available", DEBUG);
    }
}


# config_get_key1()
#
# read configuration value
#
# parameter:
#  - config key 1
# return:
#  - config value
sub config_get_key1 {
    my $key1 = shift;

    return $main::config->config_get_key1($key1);
}


# config_get_key2()
#
# read configuration value
#
# parameter:
#  - config key 1
#  - config key 2
# return:
#  - config value
sub config_get_key2 {
    my $key1 = shift;
    my $key2 = shift;

    return $main::config->config_get_key2($key1, $key2);
}


# config_get_key3()
#
# read configuration value
#
# parameter:
#  - config key 1
#  - config key 2
#  - config key 3
# return:
#  - config value
sub config_get_key3 {
    my $key1 = shift;
    my $key2 = shift;
    my $key3 = shift;

    return $main::config->config_get_key3($key1, $key2, $key3);
}


# config_set_key1()
#
# set configuration value
#
# parameter:
#  - config key 1
#  - value
# return:
#  none
sub config_set_key1 {
    my $key1  = shift;
    my $value = shift;

    $main::config->config_set_key1($key1, $value);

    return;
}


# config_set_key2()
#
# read configuration value
#
# parameter:
#  - config key 1
#  - config key 2
#  - value
# return:
#  none
sub config_set_key2 {
    my $key1  = shift;
    my $key2  = shift;
    my $value = shift;

    $main::config->config_set_key2($key1, $key2, $value);

    return;
}


# config_set_key3()
#
# read configuration value
#
# parameter:
#  - config key 1
#  - config key 2
#  - config key 3
#  - value
# return:
#  none
sub config_set_key3 {
    my $key1  = shift;
    my $key2  = shift;
    my $key3  = shift;
    my $value = shift;

    $main::config->config_set_key3($key1, $key2, $key3, $value);

    return;
}


# config_get_keys1()
#
# read configuration keys
#
# parameter:
#  - config key 1
# return:
#  - array with 2nd config keys
sub config_get_keys1 {
    my $key1 = shift;

    return $main::config->config_get_keys1($key1);
}


# config_get_keys2()
#
# read configuration keys
#
# parameter:
#  - config key 1
#  - config key 2
# return:
#  - array with 3nd config keys
sub config_get_keys2 {
    my $key1 = shift;
    my $key2 = shift;

    return $main::config->config_get_keys2($key1, $key2);
}


# validate_config()
#
# read configuration & validate important settings
#
# parameter:
#  none
# return:
#  none
sub validate_config {

    if (!config_get_key2('bot', 'commandchannel')) {
        die("Please set config value 'bot:commandchannel'\n");
    }
    if (!config_get_key2('database', 'host')) {
        die("Please set config value 'database:host'\n");
    }
    if (!config_get_key2('database', 'name')) {
        die("Please set config value 'database:name'\n");
    }
    if (!config_get_key2('database', 'username')) {
        die("Please set config value 'database:username'\n");
    }
    if (!config_get_key2('irc', 'name')) {
        die("Please set config value 'irc:name'\n");
    }
    if (!config_get_key2('irc', 'server')) {
        die("Please set config value 'irc:server'\n");
    }

    if (!config_get_key2('search', 'maxresults')) {
        die("Please set config value 'search:maxresults'\n");
    }
    my $maxresults = config_get_key2('search', 'maxresults');
    if ($maxresults !~ /^\d+$/ or $maxresults < 1) {
        die("'search:maxresults' must be a positive integer\n");
    }
    if (!config_get_key2('search', 'maxwrap')) {
        die("Please set config value 'search:maxwrap'\n");
    }
    my $maxwrap = config_get_key2('search', 'maxwrap');
    if ($maxwrap !~ /^\d+$/ or $maxwrap < 1) {
        die("'search:maxwrap' must be a positive integer\n");
    }

    my @sessions = config_get_keys1('sessions');
    my %seen_nicknames       = ();
    my %seen_sessions        = ();
    my %channels_for_session = ();
    foreach my $session (@sessions) {
        if ($session !~ /^\d+$/) {
            die("Session name ($session) must be numeric!\n");
        }
        my $nickname = config_get_key3('sessions', $session, 'nickname');
        if (defined($seen_nicknames{$nickname}) and $seen_nicknames{$nickname} == 1) {
            die("Please use different nicknames for each session!\n");
        }
        if ($nickname !~ /^[a-zA-Z0-9_\-]+$/) {
            die("Please use a different nickname: $nickname\n");
        }
        $seen_nicknames{$nickname}      = 1;
        $seen_sessions{$session}        = 1;
        $channels_for_session{$session} = 0;
    }

    my @channels = config_get_keys1('channels');
    foreach my $channel (@channels) {
        my $channel_session = config_get_key3('channels', $channel, 'session');
        # cannot use session_for_channel() here, because sessions are not yet initialized
        if (!defined($channel_session) or $channel_session !~ /^\d+$/) {
            die("Session ($channel_session) for channel '$channel' is invalid\n");
        }
        if (!defined($seen_sessions{$channel_session}) or $seen_sessions{$channel_session} != 1) {
            die("Unknown session ($channel_session) for channel '$channel'\n");
        }
        $channels_for_session{$channel_session}++;
        if ($channels_for_session{$channel_session} > 20) {
            die("More than 20 channels for session '$channel_session' configured, please change\n");
        }
    }

    print_msg("Configuration validated", DEBUG);
}


# print_msg()
#
# print out a message on stderr
#
# parameter:
#  - message
#  - loglevel (optional)
# return:
#  none
sub print_msg {
    my $msg   = shift;
    my $level = shift || $main::loglevel;

    if ($level > $main::loglevel) {
        return;
    }

    my $timestamp = localtime;
    $msg =~ s/\n//g;
    print "$timestamp ";
    printf "%-8s", "[" . $main::loglevels{$level} . "]";
    print "- $msg\n";

    return 1;
}


# init_terminal()
#
# initialise the terminal, logfiles and fork the bot into the background
#
# parameters:
#  none
# return:
#  none
# notes:
#  - will exit after fork()
sub init_terminal {

    # Fork and log to a file unless the debug command line argument is given, in
    # which case log to STDOUT and don't fork.

    close(STDIN);

    if ($main::debug == 0) {
        close(STDOUT);
        close(STDERR);
        if (!open (STDOUT, ">>$main::logfile")) {
            death("Can't open logfile $main::logfile: $!\n");
            exit(1);
        }
        if (!open (STDERR, ">>$main::logfile")) {
            death("Can't open the logfile $main::logfile for STDERR: $!\n");
            exit(1);
        }
        autoflush STDOUT 1;
        if (fork ()) {
            exit(0);
        }
    }
}


# init_sessions()
#
# initialise all session variables (not the sessions itself)
#
# parameter:
#  none
# return:
#  none
sub init_sessions {

    my @sessions = config_get_keys1('sessions');
    my @channels = config_get_keys1('channels');

    # validate_config() already made sure, that the session names are integers

    foreach my $session (@sessions) {
        $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}{'joined_channels'} = [];
        # for the watchdog
        stop_session_activity($session);
        $main::sessions{$session}{'last_nick_change_attempt'} = time();
        $main::sessions{$session}{'last_connect_time'}        = undef;
    }
}


# send_to_channel()
#
# send a message to a channel
#
# parameter:
#  - message
# return:
#  none
sub send_to_channel {
    my $channel = shift;
    my $msg     = shift;

    $msg =~ s/\n//g;

    my $session = session_for_channel($channel);

    if (defined($session)) {
        my $irc = $main::sessions{$session}{'session'};
        $irc->yield( privmsg => $channel, $msg );
    }
}


# find_irc_session()
#
# find an IRC session in the internal state
#
# parameter:
#  - irc session
# return:
#  - session number
sub find_irc_session {
    my $irc = shift;

    my $session = undef;
    foreach $session (keys(%main::sessions)) {
        if (refaddr($irc) == refaddr($main::sessions{$session}{'session'})) {
            return $session;
        }
    }

    # do error handling here, it's worthless to add this in every caller
    print_msg("Could not find IRC session (irc: $irc)!", ERROR);
    death();

    return undef;
}


# watchdog()
#
# verify network connections
#
# parameter:
#  none
# return:
#  none
BEGIN {
    # last time the watchdog was called
    # initialize to now()
    my $watchdog_last_call = time();

    sub watchdog {

        if ((time() - $watchdog_last_call) < 5) {
            # repeated call
            return;
        }
        $watchdog_last_call = time();

        foreach my $session (keys(%main::sessions)) {
            if (defined(read_session_activity($session))) {
                if (read_session_activity($session) < (time() - 180)) {
                    if (read_session_activity($session) > (time() - 240)) {
                        print_msg("Session $session timed out", INFO);
                    }
                    # automatic reconnects should be done by a plugin
                } else {
                    my $irc = $main::sessions{$session}{'session'};

                    # validate nickname
                    my $logged_in = $main::sessions{$session}{'logged_in'};
                    my $nick_name = $irc->nick_name();
                    if ($logged_in and $main::sessions{$session}{'past_motd'} == 1) {
                        if ($nick_name ne $main::sessions{$session}{'nickname'}) {
                            if ($main::sessions{$session}{'last_nick_change_attempt'} < (time() - 35)) {
                                # the bot is not using the desired nickname, try changing this
                                print_msg("nickname is: $nick_name, desired nickname is: " . $main::sessions{$session}{'nickname'} . ", issuing nick change", INFO);
                                $irc->yield( nick => $main::sessions{$session}{'nickname'} );
                                $main::sessions{$session}{'last_nick_change_attempt'} = time();
                                my $password = config_get_key3('sessions', $session, 'password');
                                if (defined($password) and length($password) > 0) {
                                    $irc->yield( privmsg => 'nickserv', 'identify ' . $password );
                                }
                            }
                        }
                    }
                }
            }
        }

    }
}


# maintenance_1m()
#
# do some maintenance
#
# parameter:
#  none
# return:
#  none
sub maintenance_1m {

    # see if channels from configuration are not joined
    if ((time() - $main::statistics{'docbot_start'}) > 60) {
        foreach my $session (keys(%main::sessions)) {
            my $irc = $main::sessions{$session}{'session'};
            if ($irc->connected and $main::sessions{$session}{'past_motd'} == 1 and $main::sessions{$session}{'logged_in'} == 1) {

                my @channels = config_get_keys1('channels');
                my @join_channels = ();
                foreach my $channel (@channels) {
                    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(/^yes$/) {$channel_autojoin_result = 1;}
                    }
                    if ($channel_session == $session and $channel_autojoin_result == 1) {
                        if (!session_for_channel($channel)) {
                            push(@join_channels, $channel);
                        }
                    }
                }
                if (scalar(@join_channels) > 0) {
                    print_msg("Channel list for session $session: " . join(", ", @join_channels), DEBUG);
                    # get stored heap pointer
                    my $heap = $main::sessions{$session}{'heap'};
                    $heap = $$heap;
                    set_session_activity($session);
                    my %chan_data = %{$heap->{'chan_data_' . $session}};

                    foreach my $channel (@join_channels) {
                        my $channel_password = config_get_key3('channels', $channel, 'password');
                        if (defined($channel_password) and length($channel_password) > 0) {
                            $irc->yield( join => $channel, $channel_password );
                        } else {
                            $irc->yield( join => $channel );
                        }
                        $chan_data{$channel} = {};
                    }
                    $heap->{'chan_data_' . $session} = \%chan_data;
                }
            }
        }
    }
}


# maintenance_5m()
#
# verify database connection, do some maintenance
#
# parameter:
#  none
# return:
#  none
sub maintenance_5m {

    if (!$main::db->test_database()) {
        print_msg("Database not connected!", ERROR);
    }

    # FIXME: update website cache
}


# send_to_commandchannel()
#
# send a message to the command channel
#
# parameter:
#  - message
# return:
#  none
sub send_to_commandchannel {
    my $msg = shift;

    $msg =~ s/\n//g;

    my $commandchannel = config_get_key2('bot', 'commandchannel');

    if (!session_for_channel($commandchannel)) {
        print_msg("commandchannel: $msg", DEBUG);
        print_msg("commandchannel ($commandchannel) not joined!", ERROR);
        return;
    }

    print_msg("commandchannel: $msg", DEBUG);
    send_to_channel(config_get_key2('bot', 'commandchannel'), $msg)
}


# session_for_channel()
#
# find a session for a specific channel
#
# parameter:
#  - channel name
# return:
#  - session number, or undef
sub session_for_channel {
    my $channel = shift;

    foreach my $session (keys(%main::sessions)) {
        if (grep {lc($_) eq lc($channel)} @{$main::sessions{$session}{'joined_channels'}}) {
            # so far the first session is used:
            # based on the current configuration method, each channel can only be assigned to one session
            return $session;
        }
    }

    return undef;
}


# is_one_of_my_nicks()
#
# find out if a specific nick belongs to the bot
#
# parameter:
#  - nick name
# return:
#  - 0/1
sub is_one_of_my_nicks {
    my $nick = shift;

    foreach my $session (keys(%main::sessions)) {
        my $irc = $main::sessions{$session}{'session'};
        if (lc($irc->nick_name()) eq lc($nick)) {
            return 1;
        }
    }

    return 0;
}


# death()
#
# general shutdown procedure after all kind of errors
#
# parameters:
#  none
# return:
#  none
sub death {
    my $text = '';
    if (defined($_[0])) {
        $text = shift;
    }

    print_msg("death()", DEBUG);

    if (length($text) > 0) {
        $text = "Error: $text - shutting down";
    } else {
        $text = "Error: shutting down";
    }

    # loop through all sessions and send a QUIT to the irc server
    foreach my $session (keys(%main::sessions)) {
        my $irc = $main::sessions{$session}{'session'};
        if ($irc->connected) {
            # this forces the current session to quit from irc, resulting in an "on_error" event
            $irc->yield( quit => $text );
        }
    }

    # have to shutdown here, else Component::IRC Component::IRC::Plugin::Connector will reconnect
    $poe_kernel->delay_add( execute_shutdown => 5 );
    $shutdown = 1;

    return;
}


# interrupt_handler_quit()
#
# handles all interrupts which should lead to a quit
#
# parameters:
#  none
# return:
#  none
sub interrupt_handler_quit {
    my ($kernel, $text) = @_[KERNEL, ARG0];
    print_msg("interrupt_handler()", DEBUG);


    if ($text =~ m/^(INT|TERM|KILL|HUP)$/) {
        $text = "Signal received: $text - shutting down";
    } elsif (length($text) > 0) {
        $text = "Error: $text - shutting down";
    } else {
        $text = "Error: shutting down";
    }

    # loop through all sessions and send a QUIT to the irc server
    foreach my $session (keys(%main::sessions)) {
        my $irc = $main::sessions{$session}{'session'};
        if ($irc->connected) {
            # this forces the current session to quit from irc, resulting in an "on_error" event
            $irc->yield( quit => $text );
        }
    }

    # have to shutdown here, else Component::IRC Component::IRC::Plugin::Connector will reconnect
    $poe_kernel->delay_add( execute_shutdown => 10 );
    $shutdown = 1;

    $kernel->sig_handled();

    return;
}


# execute_shutdown()
#
# really quits the bot
#
# parameters:
#  none
# return:
#  none
sub execute_shutdown {
    # this is called by delay_add()
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    # just to be sure
    $poe_kernel->yield( unregister => 'all' );
    $poe_kernel->yield( 'shutdown' );

    exit();
}


# set_session_activity()
#
# set last activity for a session
#
# parameter:
#  - session id
# return:
#  none
sub set_session_activity {
    my $session = shift;

    if (defined($session)) {
        $main::sessions{$session}{'last_activity'} = time();
    }
}


# stop_session_activity()
#
# set last activity for a session
#
# parameter:
#  - session id
# return:
#  none
sub stop_session_activity {
    my $session = shift;

    $main::sessions{$session}{'last_activity'} = undef;
}


# set_session_activity()
#
# set last activity for a session
#
# parameter:
#  - session id
# return:
#  - timestamp with last activity
sub read_session_activity {
    my $session = shift;

    return $main::sessions{$session}{'last_activity'};
}


# 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  = defined($2) ? $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');
        # undefined channel language triggers 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);
        }
    }

    if (!is_a_channel($channel)) {
        # 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 : '';

            # find out if it a command
            if (is_valid_command($command)) {
                return ($command, $string);
            }

            # not defined channel language triggers a full search across all languages
            # this is just fine
            my $translation = find_translation(undef, $command);
            if (defined($translation) and is_valid_command($translation)) {
                return ($translation, $string);
            }
        }
    }

    if ($msg =~ /^\s*\?\?(.+)/) {
        # a valid search
        return ('search', $1);
    }

    return undef;
}


# is_valid_command()
#
# find out if this is a valid command (includes valid admin and operator commands)
#
# parameter:
#  - command
# return:
#  - 0/1
sub is_valid_command {
    my $command = shift;

    my $status;

    $status = is_valid_operator_command($command);
    if ($status == 1) {
        return 1;
    }
    $status = is_valid_admin_command($command);
    if ($status == 1) {
        return 1;
    }

    if ($command eq 'help') {
        return 1;
    } elsif ($command eq 'info') {
        return 1;
    } elsif ($command eq 'search') {
        return 1;
    } elsif ($command eq 'user') {
        return 1;
    }

    return 0;
}


# is_valid_operator_command()
#
# find out if this is a valid operator command
#
# parameter:
#  - command
# return:
#  - 0/1
sub is_valid_operator_command {
    my $command = shift;

    if ($command eq 'learn') {
        return 1;
    } elsif ($command eq 'forget') {
        return 1;
    } elsif ($command eq 'url') {
        return 1;
    } elsif ($command eq 'key') {
        return 1;
    } elsif ($command eq 'learnuser') {
        return 1;
    } elsif ($command eq 'forgetuser') {
        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 'config') {
        return 1;
    } elsif ($command eq 'status') {
        return 1;
    } elsif ($command eq 'wallchan') {
        return 1;
    } elsif ($command eq 'say') {
        return 1;
    } elsif ($command eq 'join') {
        return 1;
    } elsif ($command eq 'leave') {
        return 1;
    } elsif ($command eq 'lost') {
        return 1;
    } elsif ($command eq 'quit') {
        return 1;
    } elsif ($command eq 'grant') {
        return 1;
    } elsif ($command eq 'revoke') {
        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;

    if (defined($language) and $language eq 'file') {
        # this references the translations file
        return undef;
    }

    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);
    }

    # get rid of the translations file
    @translation = grep { $_ ne 'file' } @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 = config_get_keys1('translations');

    # find a word in one or all languages
    foreach my $tmp (@languages) {
        if (defined($tmp) and $tmp eq 'file') {
            # don't try the translations file
            next;
        }
        if (!defined($language) or (defined($language) and $language eq $tmp)) {
            my @tmp2 = config_get_keys2('translations', $tmp);
            foreach my $tmp2 (@tmp2) {
                my $tmp3 = 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 (is_a_channel($channel)) {
        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;
}


# is_nick_allowed_admin_command()
#
# verify if a user (nick name) is allowed to execute admin commands
#
# parameter:
#  - nick name
# return:
#  - 0/1 (1 = allowed)
sub is_nick_allowed_admin_command {
    my $nick = shift;

    my $query = "SELECT 1
                   FROM docbot_user
                  WHERE LOWER(u_nick) = LOWER(?)
                    AND u_role = 'admin'";
    my $st = $main::db->query($query, $nick);
    if (!defined($st)) {
        print_msg("Database error", ERROR);
        return 0;
    }

    my $rows = $st->rows;
    $st->finish;

    if ($rows > 0) {
        # user is authorized as admin
        print_msg("User '$nick' is authed as admin", DEBUG);
        return 1;
    }

    print_msg("User '$nick' is not authed as admin", DEBUG);

    return 0;
}


# is_nick_allowed_operator_command()
#
# verify if a user (nick name) is allowed to execute operator commands
#
# parameter:
#  - nick name
# return:
#  - 0/1 (1 = allowed)
sub is_nick_allowed_operator_command {
    my $nick = shift;

    my $query = "SELECT 1
                   FROM docbot_user
                  WHERE LOWER(u_nick) = LOWER(?)
                    AND (u_role = 'op' OR u_role = 'admin')";
    my $st = $main::db->query($query, $nick);
    if (!defined($st)) {
        print_msg("Database error", ERROR);
        return 0;
    }

    my $rows = $st->rows;
    $st->finish;

    if ($rows > 0) {
        # user is authorized as operator
        print_msg("User '$nick' is authed as operator", DEBUG);
        return 1;
    }

    print_msg("User '$nick' is not authed as operator", DEBUG);

    return 0;
}


# format_time_short_exact()
#
# format a time in seconds into a human readable short output
#
# parameter:
#  - time in seconds
# return:
#  - formatted text
sub format_time_short_exact {
    my $time = shift;

    my @return = ();

    my $days = int($time / (24 * 60 * 60));
    $time -= $days * (24 * 60 * 60);

    my $hours = int($time / (60 * 60));
    $time -= $hours * (60 * 60);

    my $minutes = int($time / 60);
    $time -= $minutes * 60;

    my $seconds = $time;

    if ($days > 0) {
        push(@return, $days . 'd');
    }
    if ($hours > 0) {
        push(@return, $hours . 'h');
    }
    if ($minutes > 0) {
        push(@return, $minutes . 'm');
    }
    if ($seconds > 0) {
        push(@return, $seconds . 's');
    }

    my $return = join(" ", @return);
    if (length($return) == 0) {
        $return = '0s';
    }

    return $return;
}


# add_nick()
#
# add a new nick to the internal nickname per channel storage
#
# parameter:
#  - heap
#  - nickname
#  - channel
#  - session number
# return:
#  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}};
    my @nicknames = ();

    if (defined($channels{$channel}->{names})) {
        @nicknames = @{$channels{$channel}->{names}};
    }
    if (!grep {lc($_) eq lc($who)} @nicknames) {
        push(@nicknames, $who);
    }
    $channels{$channel}->{names} = \@nicknames;
    $heap->{'chan_data_' . $session} = \%channels;
}


# remove_nick()
#
# remove a new nick from the internal nickname per channel storage
#
# parameter:
#  - heap
#  - nickname
#  - channel
#  - session number
# return:
#  none
sub remove_nick {
    my ($heap, $who, $channel, $session) = @_;

    if (defined($channel)) {
        print_msg("remove_nick($who, channel: $channel, session: $session)", DEBUG2);
    } else {
        print_msg("remove_nick($who, session: $session)", DEBUG2);
    }

    my %channels = %{$heap->{'chan_data_' . $session}};

    if (defined($channel)) {
        if (defined($channels{$channel}->{names})) {
            my @nicknames;
            foreach my $nickname (@{$channels{$channel}->{names}}) {
                if (lc($who) eq lc($nickname)) {
                    next;
                }
                push @nicknames, $nickname;
            }
            $channels{$channel}->{names} = \@nicknames;
            $heap->{'chan_data_' . $session} = \%channels;
        }
    } else {
        foreach $channel ( keys %channels ) {
            if (defined($channels{$channel}->{names})) {
                my @nicknames;
                foreach my $nickname (@{$channels{$channel}->{names}}) {
                    if (lc($who) eq lc($nickname)) {
                        next;
                    }
                    push @nicknames, $nickname;
                }
                $channels{$channel}->{names} = \@nicknames;
            }
        }
        $heap->{'chan_data_' . $session} = \%channels;
    }
}


# remove_channel()
#
# remove a channel from the internal nickname per channel storage
#
# parameter:
#  - heap
#  - channel
#  - session number
# return:
#  none
sub remove_channel {
    my ($heap, $channel, $session) = @_;

    print_msg("remove_channel($channel, session: $session)", DEBUG2);

    my %channels = %{$heap->{'chan_data_' . $session}};

    if (defined($channels{$channel})) {
        undef($channels{$channel});
        $heap->{'chan_data_' . $session} = \%channels;
    }
}


# find_nick()
#
# find a nick in the internal nickname per channel storage
#
# parameter:
#  - heap
#  - nickname
#  - session number
# return:
#  - array with channels
sub find_nick {
    my ($heap, $who, $session) = @_;

    print_msg("find_nick($who, session: $session)", DEBUG2);

    my %channels = %{$heap->{'chan_data_' . $session}};
    my @channels;

    foreach my $channel (keys(%channels)) {
        if (defined($channels{$channel}->{names})) {
            if (grep {lc($who) eq lc($_)} @{$channels{$channel}->{names}}) {
                push(@channels, $channel);
            }
        }
    }

    return @channels;
}


# is_a_channel()
#
# find out if a nick/channel string is really a channel name
#
# parameter:
#  - nick/channel string
# return:
#  - 0/1
sub is_a_channel {
    my $string = shift;

    my $channel = extract_channel($string);


    if (length($channel) == 0) {
        return 0;
    }

    return 1;
}


# extract_channel()
#
# extract a channel name from a nick/channel string
#
# parameter:
#  - nick/channel string
# return:
#  - channel name, without prefix, or ''
sub extract_channel {
    my $string = shift;

    if (!defined($string)) {
        return '';
    }

    if (substr($string, 0, 1) eq '#') {
        return substr($string, 1);
    }
    if (substr($string, 0, 1) eq '&') {
        return substr($string, 1);
    }
    if (substr($string, 0, 1) eq '!') {
        return substr($string, 1);
    }
    if (substr($string, 0, 1) eq '+') {
        return substr($string, 1);
    }
    if (substr($string, 0, 1) eq '.') {
        return substr($string, 1);
    }
    if (substr($string, 0, 1) eq '~') {
        return substr($string, 1);
    }

    return '';
}


# store_channel_message_in_ringbuffer()
#
# store last x messages for each channel
#
# parameter:
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the message itself
#  - POE sender
#  - sender nick name
#  - the channel name
#  - session irc handle
#  - the sessiom handle
# return:
#  none
sub store_channel_message_in_ringbuffer {
    my $kernel = shift;
    my $heap = shift;
    my $who = shift;
    my $where = shift;
    my $msg = shift;
    my $sender = shift;
    my $nick = shift;
    my $channel = shift;
    my $irc = shift;
    my $session = shift;

    if (lc($channel) eq lc($irc->nick_name())) {
        return;
    }

    if (!defined($main::channels{$channel})) {
        $main::channels{$channel} = [];
        #print_msg("initialize channel ringbuffer: $channel", DEBUG);
    }

    push(@{$main::channels{$channel}}, $nick . ' = ' . $msg);
    #print_msg("have " . scalar(@{$main::channels{$channel}}) . " entries in ringbuffer for channel " . $channel, DEBUG);

    while (scalar(@{$main::channels{$channel}}) > 50) {
        shift(@{$main::channels{$channel}});
    }
    #print_msg("ringbuffer: " . join(" | ", @{$main::channels{$channel}}), DEBUG);
}


# handle_command()
#
# wrapper to handle all commands
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $channel = shift;


    given ($command) {
        when('search') {
            $main::statistics{'command_counter_search'}++;
            return handle_command_search($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('help') {
            $main::statistics{'command_counter_help'}++;
            return handle_command_help($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('info') {
            $main::statistics{'command_counter_info'}++;
        }
        when('learn') {
            $main::statistics{'command_counter_learn'}++;
            return handle_command_learn($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('forget') {
            $main::statistics{'command_counter_forget'}++;
            return handle_command_forget($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('config') {
            $main::statistics{'command_counter_config'}++;
        }
        when('status') {
            $main::statistics{'command_counter_status'}++;
            return handle_command_status($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('wallchan') {
            $main::statistics{'command_counter_wallchan'}++;
            return handle_command_wallchan($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('say') {
            return handle_command_say($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('join') {
            return handle_command_join($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('leave') {
            return handle_command_leave($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('lost') {
            $main::statistics{'command_counter_lost'}++;
            return handle_command_lost($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('url') {
            return handle_command_url($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('key') {
            return handle_command_key($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('quit') {
            return handle_command_quit($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('grant') {
            return handle_command_grant($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('revoke') {
            return handle_command_revoke($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('user') {
            return handle_command_user($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('learnuser') {
            return handle_command_learnuser($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
        when('forgetuser') {
            return handle_command_forgetuser($command, $string, $mode, $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
        }
    }

    return '';
}


# handle_command_grant()
#
# command handler for the 'grant' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - text to send back to the sender
sub handle_command_grant {
    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 $channel = shift;


    # 'grant' goes to the command channel only
    if (lc($channel) eq lc($irc->nick_name())) {
        return 'The "grant" command is only allowed in the command channel';
    }
    if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
        return 'The "grant" command is only allowed in the command channel';
    }

    if (length($string) < 1) {
        my $answer = 'The "grant" command requires two parameters';
           $answer = translate_text_for_channel($channel, 'error_grant_command_parameter', $answer);
        return $answer;
    }

    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;

    my ($msg_nick, $msg_level);
    if ($string =~ /^([^\s]+)\s+(.+)$/) {
        $msg_nick  = $1;
        $msg_level = $2;
    } else {
        my $answer = 'The "grant" command requires two parameters';
           $answer = translate_text_for_channel($channel, 'error_grant_command_parameter', $answer);
        return $answer;
    }


    if ($msg_level ne 'op' and $msg_level ne 'admin') {
        my $answer = 'The second parameter must be "op" or "admin"';
           $answer = translate_text_for_channel($channel, 'error_grant_second_parameter', $answer);
        return $answer;
    }


    print_msg("grant: '$msg_nick/$msg_level', by $nick", DEBUG);
    send_to_commandchannel("grant: '$msg_nick/$msg_level', by $nick");

    $main::statistics{'command_counter_grant'}++;


    my $query = "SELECT u_nick, u_role FROM docbot_user WHERE LOWER(u_nick) = LOWER(?::TEXT)";
    my $st    = $main::db->query($query, $msg_nick);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;
    if ($rows == 0) {
        # user not yet in database
        $query = "INSERT INTO docbot_user (u_nick, u_role, u_reason) VALUES (LOWER(?::TEXT), ?::TEXT, ?::TEXT)";
        $st    = $main::db->query($query, $msg_nick, $msg_level, 'Granted by ' . $nick);
        if (!defined($st)) {
            my $answer = "Database error";
               $answer = translate_text_for_channel($channel, 'database_error', $answer);
            return $answer;
        }
        $main::db->commit();
        my $answer = "User added";
           $answer = translate_text_for_channel($channel, 'error_grant_user_added', $answer);
        return $answer;
    } else {
        # user already in database, compare level
        my $row = $st->fetchrow_hashref;
        if ($row->{'u_role'} eq $msg_level) {
            my $answer = "User already in database with requested level";
               $answer = translate_text_for_channel($channel, 'error_grant_user_has_level', $answer);
            return $answer;
        } else {
            $query = "UPDATE docbot_user SET u_role = ?::TEXT, u_reason = ?::TEXT WHERE LOWER(u_nick) = LOWER(?::TEXT)";
            $st    = $main::db->query($query, $msg_level, 'Granted/changed by ' . $nick, $msg_nick);
            if (!defined($st)) {
                my $answer = "Database error";
                   $answer = translate_text_for_channel($channel, 'database_error', $answer);
                return $answer;
            }
            $main::db->commit();
            my $answer = "User changed";
               $answer = translate_text_for_channel($channel, 'error_grant_user_canged', $answer);
            return $answer;
        }
    }
}


# handle_command_user()
#
# command handler for the 'user' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - text to send back to the sender
sub handle_command_user {
    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 $channel = shift;


    if (length($string) < 1) {
        my $answer = 'The "user" command requires one';
           $answer = translate_text_for_channel($channel, 'error_user_command_parameter', $answer);
        return $answer;
    }

    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;

    my ($msg_nick, $msg_url);
    if ($string =~ /^([^\s]+)$/) {
        $msg_nick = $string;
        $msg_url = '';
    } else {
        my $answer = 'The "user" command requires one parameters';
           $answer = translate_text_for_channel($channel, 'error_user_command_parameter', $answer);
        return $answer;
    }


    print_msg("user search: '$msg_nick', by $nick", DEBUG);
    send_to_commandchannel("user search: '$msg_nick', by $nick");

    $main::statistics{'command_counter_user'}++;


    my $query = "SELECT u_nick, u_url FROM docbot_user WHERE LOWER(u_nick) = LOWER(?::TEXT)";
    my $st    = $main::db->query($query, $msg_nick);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;


    if ($rows == 0) {
        my $answer = "Nick not in database";
           $answer = translate_text_for_channel($channel, 'error_user_user_not_in_database', $answer);
        return $answer;
    }
    my $row = $st->fetchrow_hashref;
    if (length($row->{'u_url'}) == 0) {
        my $answer = "Nick not in database";
           $answer = translate_text_for_channel($channel, 'error_user_user_not_in_database', $answer);
        return $answer;
    }

    return $msg_nick . ': ' . $row->{'u_url'};
}


# handle_command_learnuser()
#
# command handler for the 'learnuser' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - text to send back to the sender
sub handle_command_learnuser {
    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 $channel = shift;


    if (length($string) < 1) {
        my $answer = 'The "learnuser" command requires two parameters';
           $answer = translate_text_for_channel($channel, 'error_learnuser_command_parameter', $answer);
        return $answer;
    }

    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;

    my ($msg_nick, $msg_url);
    if ($string =~ /^([^\s]+)\s+(http.+)$/) {
        $msg_nick = $1;
        $msg_url = $2;
    } else {
        my $answer = 'The "learnuser" command requires two parameters';
           $answer = translate_text_for_channel($channel, 'error_learnuser_command_parameter', $answer);
        return $answer;
    }


    print_msg("user learn: '$msg_nick/$msg_url', by $nick", DEBUG);
    send_to_commandchannel("user learn: '$msg_nick/$msg_url', by $nick");

    $main::statistics{'command_counter_learnuser'}++;


    my $query = "SELECT u_nick, u_url FROM docbot_user WHERE LOWER(u_nick) = LOWER(?::TEXT)";
    my $st    = $main::db->query($query, $msg_nick);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;


    if ($msg_url =~ /^http:\/\/wiki\.postgresql\.org\//) {
        my $answer = "Wiki links must begin with https";
           $answer = translate_text_for_channel($channel, 'error_learnuser_wiki_links_https', $answer);
        return $answer;
    }
    if ($msg_url !~ /^https:\/\/wiki\.postgresql\.org\/wiki\/User:[a-zA-Z0-9\+\-]+$/) {
        my $answer = "Only links to the PostgreSQL wiki are allowed as user links";
           $answer = translate_text_for_channel($channel, 'error_learnuser_wiki_links', $answer);
        return $answer;
    }

    if ($rows == 0) {
        # user not yet in database
        $query = "INSERT INTO docbot_user (u_nick, u_role, u_reason, u_url) VALUES (LOWER(?::TEXT), 'user', 'Added for url', '')";
        $st    = $main::db->query($query, $msg_nick);
        if (!defined($st)) {
            my $answer = "Database error";
               $answer = translate_text_for_channel($channel, 'database_error', $answer);
            return $answer;
        }
        $main::db->commit();
        my $answer = "User added";
           $answer = translate_text_for_channel($channel, 'error_learnuser_user_added', $answer);
        return $answer;
    } else {
        # user already in database, update link
        my $row = $st->fetchrow_hashref;
        $query = "UPDATE docbot_user SET u_url = ?::TEXT WHERE LOWER(u_nick) = LOWER(?::TEXT)";
        $st    = $main::db->query($query, $msg_url, $msg_nick);
        if (!defined($st)) {
            my $answer = "Database error";
               $answer = translate_text_for_channel($channel, 'database_error', $answer);
            return $answer;
        }
        $main::db->commit();
        my $answer = "User changed";
           $answer = translate_text_for_channel($channel, 'error_learnuser_user_canged', $answer);
        return $answer;
    }
}


# handle_command_forgetuser()
#
# command handler for the 'forgetuser' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - text to send back to the sender
sub handle_command_forgetuser {
    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 $channel = shift;


    if (length($string) < 1) {
        my $answer = 'The "forgetuser" command requires one parameter';
           $answer = translate_text_for_channel($channel, 'error_forgetuser_command_parameter', $answer);
        return $answer;
    }

    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;

    my ($msg_nick, $msg_url);
    if ($string =~ /^([^\s]+)$/) {
        $msg_nick = $1;
    } else {
        my $answer = 'The "forgetuser" command requires one parameter';
           $answer = translate_text_for_channel($channel, 'error_forgetuser_command_parameter', $answer);
        return $answer;
    }


    print_msg("user forget: '$msg_nick', by $nick", DEBUG);
    send_to_commandchannel("user forget: '$msg_nick', by $nick");

    $main::statistics{'command_counter_forgetuser'}++;


    my $query = "SELECT u_nick, u_url FROM docbot_user WHERE LOWER(u_nick) = LOWER(?::TEXT)";
    my $st    = $main::db->query($query, $msg_nick);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;


    if ($rows == 0) {
        my $answer = "User not in database";
           $answer = translate_text_for_channel($channel, 'error_forgetuser_not_in_database', $answer);
        return $answer;
    }

    $query = "UPDATE docbot_user SET u_url = '' WHERE LOWER(u_nick) = LOWER(?::TEXT)";
    $st    = $main::db->query($query, $msg_nick);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    $main::db->commit();
    my $answer = "User changed";
       $answer = translate_text_for_channel($channel, 'error_forgetuser_user_canged', $answer);
    return $answer;
}


# handle_command_revoke()
#
# command handler for the 'revoke' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - text to send back to the sender
sub handle_command_revoke {
    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 $channel = shift;


    # 'grant' goes to the command channel only
    if (lc($channel) eq lc($irc->nick_name())) {
        return 'The "revoke" command is only allowed in the command channel';
    }
    if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
        return 'The "revoke" command is only allowed in the command channel';
    }

    if (length($string) < 1) {
        my $answer = 'The "revoke" command requires one parameter';
           $answer = translate_text_for_channel($channel, 'error_revoke_command_parameter', $answer);
        return $answer;
    }

    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    print_msg("revoke: '$string', by $nick", DEBUG);
    send_to_commandchannel("revoke: '$string', by $nick");

    $main::statistics{'command_counter_revoke'}++;


    my $query = "DELETE FROM docbot_user WHERE LOWER(u_nick) = LOWER(?::TEXT)";
    my $st    = $main::db->query($query, $string);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;
    if ($rows == 0) {
        # user not in database
        my $answer = "User not in database";
           $answer = translate_text_for_channel($channel, 'error_revoke_user_not_in_db', $answer);
        return $answer;
    } else {
        # user now removed
        my $answer = "User removed from database";
           $answer = translate_text_for_channel($channel, 'error_revoke_user_removed_from_db', $answer);
        return $answer;
    }
}


# handle_command_quit()
#
# command handler for the 'quit' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $channel = shift;


    # 'quit' goes to the command channel only
    if (lc($channel) eq lc($irc->nick_name())) {
        return 'The "quit" command is only allowed in the command channel';
    }
    if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
        return 'The "quit" command is only allowed in the command channel';
    }


    send_to_commandchannel('Received "quit" command from: ' . $nick);
    print_msg('Received "quit" command from: ' . $nick, INFO);


    # loop through all sessions and send a QUIT to the irc server
    foreach my $tmp_session (keys(%main::sessions)) {
        my $tmp_irc = $main::sessions{$tmp_session}{'session'};
        if ($tmp_irc->connected) {
            # this forces the current session to quit from irc, resulting in an "on_error" event
            $tmp_irc->yield( quit => "Quit" );
        }
    }

    # have to shutdown here, else Component::IRC Component::IRC::Plugin::Connector will reconnect
    $poe_kernel->delay_add( execute_shutdown => 5 );
    $shutdown = 1;

    return '';
}


# handle_command_status()
#
# command handler for the 'status' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $channel = shift;


    # 'status' goes to the command channel only
    if (lc($channel) eq lc($irc->nick_name())) {
        return 'The "status" command is only allowed in the command channel';
    }
    if (lc($channel) ne lc(config_get_key2('bot', 'commandchannel'))) {
        return 'The "status" command is only allowed in the command channel';
    }


    $irc->yield( privmsg => $channel, 'Bot uptime: ' . format_time_short_exact(time() - $main::statistics{'docbot_start'}) );
    $irc->yield( privmsg => $channel, 'Number of parallel sessions: ' . scalar(keys(%main::sessions)) );
    my @nicks = ();
    my @channels = ();
    foreach my $tmp_session (keys(%main::sessions)) {
        push(@nicks, $main::sessions{$tmp_session}{'session'}->nick_name());
        push(@channels, @{$main::sessions{$tmp_session}{'joined_channels'}});
    }
    $irc->yield( privmsg => $channel, 'Nick names: ' . join(", ", @nicks) );
    $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, '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, 'grant: '       . $main::statistics{'command_counter_grant'});
    push(@commands, 'revoke: '      . $main::statistics{'command_counter_revoke'});
    push(@commands, 'user: '        . $main::statistics{'command_counter_user'});
    push(@commands, 'user learn: '  . $main::statistics{'command_counter_learnuser'});
    push(@commands, 'user forget: ' . $main::statistics{'command_counter_forgetuser'});
    # 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 '';
}


# handle_command_lost()
#
# command handler for the 'lost' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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';
           $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';
           $answer = translate_text_for_channel($channel, 'lost_only_in_commandchannel', $answer);
        return $answer;
    }


    my $query = "SELECT url FROM docbot_url WHERE id NOT IN (SELECT kurl FROM docbot_key) ORDER BY id";
    my $st = $main::db->query($query);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;
    if ($rows == 0) {
        my $answer = "No unconnected urls in database";
        return $answer;
    }


    # fetch the result
    my @rows = ();
    while (my @row = $st->fetchrow_array) {
        push(@rows, $row[0]);
    }


    my @lines = ();
    my $maxresults = config_get_key2('search', 'maxresults');
    if ($maxresults == 0) {
        # set a reasonable high default
        $maxresults = 50;
    }
    if ($maxresults < 20) {
        $maxresults = 20;
    }
    my $maxwrap = config_get_key2('search', 'maxwrap');
    for (my $a = 1; $a <= int($maxresults / $maxwrap); $a++) {
        my @line = ();
        for (my $b = 1; $b <= $maxwrap; $b++) {
            if (defined($rows[0])) {
                push(@line, shift(@rows));
            }
        }
        if (scalar(@line) > 0) {
            push(@lines, join(" :: ", @line));
        }
    }

    if (scalar(@lines) > 0) {
        $irc->yield( privmsg => $channel, "$rows unconnected urls in database:" );
        foreach my $line (@lines) {
            $irc->yield( privmsg => $channel, $line );
        }
    }

    return '';
}


# handle_command_url()
#
# command handler for the 'url' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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';
           $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';
           $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);
        return $answer;
    }

    print_msg("url: '$string', by $nick", DEBUG);
    send_to_commandchannel("url: '$string', by $nick");
    $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 $st = $main::db->query($query, $string);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;
    if ($rows == 0) {
        my $answer = "URL not in database or no keys connected";
        return $answer;
    }


    # fetch the result
    my @rows = ();
    while (my @row = $st->fetchrow_array) {
        push(@rows, $row[0]);
    }


    my @lines = ();
    my $maxresults = config_get_key2('search', 'maxresults');
    if ($maxresults == 0) {
        # set a reasonable high default
        $maxresults = 50;
    }
    if ($maxresults < 20) {
        $maxresults = 20;
    }
    my $maxwrap = config_get_key2('search', 'maxwrap');
    if ($maxwrap > 1 and $maxwrap < 5) {
        # set a more reasonable default for number of keys
        $maxwrap = 5;
    }
    for (my $a = 1; $a <= int($maxresults / $maxwrap); $a++) {
        my @line = ();
        for (my $b = 1; $b <= $maxwrap; $b++) {
            if (defined($rows[0])) {
                push(@line, shift(@rows));
            }
        }
        if (scalar(@line) > 0) {
            push(@lines, join(" :: ", @line));
        }
    }

    if (scalar(@lines) > 0) {
        $irc->yield( privmsg => $channel, "$rows keys in database for url '$string':" );
        foreach my $line (@lines) {
            $irc->yield( privmsg => $channel, $line );
        }
    }

    return '';
}


# handle_command_key()
#
# command handler for the 'key' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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';
           $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';
           $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);
        return $answer;
    }

    print_msg("key: '$string', by $nick", DEBUG);
    send_to_commandchannel("key: '$string', by $nick");
    $main::statistics{'command_counter_key'}++;


    my $query = "SELECT url
                   FROM docbot_url
                  WHERE id IN (SELECT kurl
                                 FROM docbot_key
                                WHERE LOWER(key) = ?::TEXT)
               ORDER BY url";
    my $st = $main::db->query($query, lc($string));
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;
    if ($rows == 0) {
        my $answer = "Key not in database or no urls connected";
        return $answer;
    }


    # fetch the result
    my @rows = ();
    while (my @row = $st->fetchrow_array) {
        push(@rows, $row[0]);
    }


    my @lines = ();
    my $maxresults = config_get_key2('search', 'maxresults');
    if ($maxresults == 0) {
        # set a reasonable high default
        $maxresults = 50;
    }
    if ($maxresults < 20) {
        $maxresults = 20;
    }
    my $maxwrap = config_get_key2('search', 'maxwrap');
    if ($maxwrap > 1 and $maxwrap < 5) {
        # set a more reasonable default for number of keys
        $maxwrap = 5;
    }
    for (my $a = 1; $a <= int($maxresults / $maxwrap); $a++) {
        my @line = ();
        for (my $b = 1; $b <= $maxwrap; $b++) {
            if (defined($rows[0])) {
                push(@line, shift(@rows));
            }
        }
        if (scalar(@line) > 0) {
            push(@lines, join(" :: ", @line));
        }
    }

    if (scalar(@lines) > 0) {
        $irc->yield( privmsg => $channel, "$rows urls in database for key '" . lc($string) . "':" );
        foreach my $line (@lines) {
            $irc->yield( privmsg => $channel, $line );
        }
    }

    return '';
}


# handle_command_wallchan()
#
# command handler for the 'wallchan' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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);
        return $answer;
    }

    print_msg("wallchan: '$string', by $nick", DEBUG);
    send_to_commandchannel("wallchan: '$string', by $nick");


    my @channels = ();
    foreach my $tmp_session (keys(%main::sessions)) {
        push(@channels, @{$main::sessions{$tmp_session}{'joined_channels'}});
    }
    foreach my $tmp_channel (@channels) {
        my $answer = 'Operator message';
           $answer = translate_text_for_channel($tmp_channel, 'wallchan_command_message', $answer);
        send_to_channel($tmp_channel, $answer . ': ' . $string);
    }

    return '';
}


# handle_command_say()
#
# command handler for the 'say' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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);
        return $answer;
    }


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    my ($msg_channel, $message);
    if ($string =~ /^([^\s]+)\s+(.+)$/) {
        $msg_channel = $1;
        $message     = $2;
    } else {
        my $answer = 'The "say" command requires two parameters';
           $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);
        return $answer;
    }

    my $msg_session = session_for_channel($msg_channel);

    if (!$msg_session) {
        my $answer = 'The bot is not in this channel';
           $answer = translate_text_for_channel($channel, 'error_say_not_joined', $answer);
        return $answer;
    }


    print_msg("say: '$message' in '$msg_channel', by $nick", DEBUG);
    send_to_commandchannel("say: '$message' in '$msg_channel', by $nick");


    send_to_channel($msg_channel, $message);
    $main::statistics{'command_counter_say'}++;

    return '';
}


# handle_command_join()
#
# command handler for the 'join' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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);
        return $answer;
    }


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    my ($join_channel, $join_session, $join_language, $join_password, $join_parameter1, $join_parameter2);
    if ($string =~ /^([^\s]+)\s+(\d+)$/) {
        $join_channel = $1;
        $join_session = $2;
    } elsif ($string =~ /^([^\s]+)\s+(\d+)\s+([a-z]+)$/) {
        $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_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);
        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);
        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);
        return $answer;
    }
    my $join_irc = $main::sessions{$join_session}{'session'};


    $join_language = 'en';
    if ($join_parameter1 =~ /^lang:([a-z]+)$/) {
        $join_language   = $1;
        $join_parameter1 = '';
    }
    if ($join_parameter2 =~ /^lang:([a-z])$/) {
        $join_language   = $1;
        $join_parameter2 = '';
    }

    $join_password = '';
    if ($join_parameter1 =~ /^pass:(.+)$/) {
        $join_password = $1;
        $join_parameter1 = '';
    }
    if ($join_parameter1 =~ /^password:(.+)$/) {
        $join_password   = $1;
        $join_parameter1 = '';
    }
    if ($join_parameter2 =~ /^pass:(.+)$/) {
        $join_password   = $1;
        $join_parameter2 = '';
    }
    if ($join_parameter2 =~ /^password:(.+)$/) {
        $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);
        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);
        return $answer;
    }


    print_msg("join: '$join_channel' in session '$join_session', by $nick", DEBUG);
    send_to_commandchannel("join: '$join_channel' in session '$join_session', by $nick");

    if (length($join_password) > 0) {
        $join_irc->yield( join => $join_channel, $join_password );
    } else {
        $join_irc->yield( join => $join_channel );
    }
    $main::statistics{'command_counter_join'}++;


    my $channel_language = config_get_key3('channels', lc($join_channel), 'language');
    if (!defined($channel_language)) {
        config_set_key3('channels', lc($join_channel), 'language', $join_language);
    }

    return '';
}


# handle_command_leave()
#
# command handler for the 'leave' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $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);
        return $answer;
    }


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    my ($leave_channel);
    if ($string =~ /^([^\s]+)/) {
        $leave_channel = $1;
    } else {
        my $answer = 'The "leave" command requires one parameter';
           $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);
        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);
        return $answer;
    }
    my $leave_irc = $main::sessions{$leave_session}{'session'};


    print_msg("leave: '$leave_channel' in session '$leave_session', by $nick", DEBUG);
    send_to_commandchannel("leave: '$leave_channel' in session '$leave_session', by $nick");

    $leave_irc->yield( part => $leave_channel );
    $main::statistics{'command_counter_leave'}++;

    return '';
}


# handle_command_search()
#
# command handler for the 'search' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $channel = shift;

    my $session = find_irc_session($irc);


    if (lc($channel) eq lc($irc->nick_name())) {
        print_msg("Search issued: '$string', by $nick", DEBUG2);
    } else {
        print_msg("Search issued: '$string', by $nick in $channel", DEBUG2);
    }


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;

    if (length($string) < 1) {
        if (lc($channel) eq lc($irc->nick_name())) {
            # return error to sender in private message
            return 'No search given';
        }
        # don't flood a channel with the error message
        return '';
    }


    # find out where to reply the answer
    my $replyto = $channel;
    if (lc($channel) eq lc($irc->nick_name())) {
        $replyto = $nick;
        if (is_one_of_my_nicks($replyto)) {
            return '';
        }
    } elsif ($string =~ /^(.+)\s+>\s+(\w+)/i) {
        if (grep(/^$channel$/i, find_nick($heap, $2, $session))) {
            $string  = $1;
            $replyto = $2;
            if (is_one_of_my_nicks($replyto)) {
                return '';
            }
        } else {
            return '';
        }
    }


    if ($string !~ /^[a-zA-Z0-9 _\-\.]+$/) {
        my $answer = "Invalid search";
           $answer = translate_text_for_channel($channel, 'invalid_search', $answer);
        return $answer;
    }


    # compose the search
    my @keys = split(/\s+/, lc($string));

    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 .= ")\n";
    $query .= "ORDER BY url LIKE 'irc%'";
    my $st = $main::db->query($query, @keys);
    if (!defined($st)) {
        my $answer = "Database error";
           $answer = translate_text_for_channel($channel, 'database_error', $answer);
        return $answer;
    }
    my $rows = $st->rows;
    if ($rows == 0) {
        my $answer = "Nothing found";
           $answer = translate_text_for_channel($channel, 'nothing_found', $answer);
        return $answer;
    }


    # fetch the result
    my @rows = ();
    while (my @row = $st->fetchrow_array) {
        push(@rows, $row[0]);
    }

    my @lines = ();
    my $maxresults = config_get_key2('search', 'maxresults');
    if ($maxresults == 0) {
        # set a reasonable high default
        $maxresults = 50;
    }
    my $maxwrap = config_get_key2('search', 'maxwrap');
    for (my $a = 1; $a <= int($maxresults / $maxwrap); $a++) {
        my @line = ();
        for (my $b = 1; $b <= $maxwrap; $b++) {
            if (defined($rows[0])) {
                push(@line, shift(@rows));
            }
        }
        if (scalar(@line) > 0) {
            push(@lines, join(" :: ", @line));
        }
    }
    if (scalar(@rows) > 0) {
        my $line = '';
        if (scalar(@rows) == 1) {
            $line = scalar(@rows) . " " . translate_text_for_channel($replyto, 'more_result', 'more result');
        } else {
            $line = scalar(@rows) . " " . translate_text_for_channel($replyto, 'more_results', 'more results');
        }
        my $searchsite = config_get_key2('search', 'searchsite');
        if (defined ($searchsite) and length($searchsite) > 0) {
            $line .= ': ' . $searchsite . uri_escape($string);
        }
        push(@lines, $line);
    }

    if (scalar(@lines) > 0) {
        foreach my $line (@lines) {
            $irc->yield( privmsg => $replyto, $line );
        }
    }

    return '';
}


# handle_command_help()
#
# command handler for the 'help' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# 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 $channel = shift;


    my $session = find_irc_session($irc);


    if (lc($channel) eq lc($irc->nick_name())) {
        print_msg("Help issued: '$string', by $nick", DEBUG2);
    } else {
        print_msg("Help issued: '$string', by $nick in $channel", DEBUG2);
    }


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    # find out where to reply the answer
    my $replyto = $channel;
    if (lc($channel) eq lc($irc->nick_name())) {
        $replyto = $nick;
    } elsif ($string =~ /^(.+)\s+>\s+(\w+)/i) {
        if (grep(/^$channel$/i, find_nick($heap, $2, $session))) {
            $string  = $1;
            $replyto = $2;
        } else {
            return '';
        }
    }


    if (length($string) == 0) {
        my $answer = "General help";
           $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";
        # translate message
        $answer = translate_text_for_channel($replyto, 'help_general_line_2', $answer);
        $irc->yield( privmsg => $replyto, $answer );

        $answer = "The following commands are also available";
        # translate message
        $answer = translate_text_for_channel($replyto, 'help_general_line_3', $answer);
        $answer .= ': ';
        $answer .= 'search, help, info, learn, forget, config, status, say, wallchan, lost, url, key, join, leave, quit, user, learnuser, forgetuser';
        $irc->yield( privmsg => $replyto, $answer );
    }


    if ($string eq 'search') {
        my $answer = "Start a search with two question marks, followed by the search term";
           $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";
           $answer = translate_text_for_channel($replyto, 'help_general_line_say', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'lost') {
        my $answer = "Use ?lost";
           $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>";
           $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>";
           $answer = translate_text_for_channel($replyto, 'help_general_line_key', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'quit') {
        my $answer = "Use ?quit";
           $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>";
           $answer = translate_text_for_channel($replyto, 'help_general_line_join', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'leave') {
        my $answer = "Use ?leave";
           $answer = translate_text_for_channel($replyto, 'help_general_line_leave', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'grant') {
        my $answer = "Use ?grant <nick> <op/admin>";
           $answer = translate_text_for_channel($replyto, 'help_general_line_grant', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'revoke') {
        my $answer = "Use ?revoke <nick>";
           $answer = translate_text_for_channel($replyto, 'help_general_line_revoke', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'user') {
        my $answer = "Use ?user [learn|forget] <nick> [url]";
           $answer = translate_text_for_channel($replyto, 'help_general_line_user', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'learnuser') {
        my $answer = "Use ?learnuser <nick> url";
           $answer = translate_text_for_channel($replyto, 'help_general_line_learnuser', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    if ($string eq 'forgetuser') {
        my $answer = "Use ?forgetuser <nick>";
           $answer = translate_text_for_channel($replyto, 'help_general_line_forgetuser', $answer);
        $irc->yield( privmsg => $replyto, $answer );
    }

    return '';
}


# handle_command_learn()
#
# command handler for the 'learn' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - 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 $channel = shift;

    my $session = find_irc_session($irc);


    # pre-translate this error message
    my $database_error = "Database error";
    # translate error message
    $database_error = translate_text_for_channel($channel, 'database_error', $database_error);


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    my ($url, @keywords);
    my @keys = split(/\s+/, $string);
    my $url_pattern = config_get_key2('search', 'urlpattern');

    # parse query
    foreach my $keyword (@keys) {
        if ($keyword =~ /^$url_pattern/) {
            $url = $keyword;
            # rewrite to current
            if ($url =~ /^https?:\/\/(.*?postgresql\.org\/docs\/)[0-9\.]+(\/.*)$/i) {
                $url = 'https://' . $1 . "current" . $2;
            }
            # rewrite to static
            if ($url =~ /^https?:\/\/(.*?postgresql\.org\/docs\/current\/)interactive(\/.*)$/i) {
                $url = 'https://' . $1 . "static" . $2;
            }
            last;
        }

        push(@keywords, lc($keyword));
    }


    if (scalar(@keywords) == 0 || !defined($url)) {
        my $answer = "Bad parameters";
           $answer = translate_text_for_channel($channel, 'search_bad_parameters', $answer);
        return $answer;
    }
    my %keywords = map { $_, 1 } @keywords;
    @keywords = keys(%keywords);

    if (is_a_channel($channel)) {
        send_to_commandchannel("learn, by $nick in $channel: $string");
    } else {
        send_to_commandchannel("learn, by $nick: $string");
    }

    $main::db->rollback();

    # insert keywords
    my $st = $main::db->query("SELECT id
                                 FROM docbot_url
                                WHERE url = ?", $url);
    if (!$st) {
        $main::db->rollback();
        return $database_error;
    }

    if ($st->rows > 0) {
        # url already exists in database
        my $kurl = $st->fetchrow_hashref;
        $kurl = $kurl->{'id'};
        print_msg("url id: " . $kurl, DEBUG);
        $st->finish;

        my $new_keys = 0;
        foreach my $keyword (@keywords) {
            my $st2 = $main::db->query("SELECT has_key (?, ?) AS has_key", $kurl, lc($keyword));
            if (!$st2) {
                $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 (?, ?)", lc($keyword), $kurl)) {
                    $main::db->rollback();
                    return $database_error;
                }
                $new_keys++;
            }
            $st2->finish;
        }
        $main::db->commit();

        if ($new_keys == 0) {
            # no new keys at all
            $main::db->rollback();
            my $answer = "All keywords already exist in database";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'search_no_new_keywords', $answer);
            return $answer;
        } else {
            # some new keys
            $main::db->commit();
            if ($new_keys == 1) {
                my $answer = "Successfully added 1 keyword";
                print_msg($answer, DEBUG);
                # translate message
                $answer = translate_text_for_channel($channel, 'search_add_1_keyword', $answer);
                return $answer;
            } else {
                my $answer = "Successfully added %1 keywords";
                   $answer =~ s/\%1/$new_keys/;
                print_msg($answer, DEBUG);
                $answer = "Successfully added %1 keywords";
                # translate message
                $answer = translate_text_for_channel($channel, 'search_add_n_keywords', $answer);
                $answer =~ s/\%1/$new_keys/;
                return $answer;
            }
        }
    } else {
        # url does not yet exist in database
        print_msg('url not yet in database', DEBUG);
        $st->finish;
        if (!$main::db->query("INSERT INTO docbot_url (url) VALUES (?)", $url)) {
            $main::db->rollback();
            return $database_error;
        }
        $main::db->commit();

        my $st2 = $main::db->query("SELECT currval(pg_get_serial_sequence('docbot_url', 'id'))");
        if (!$st2) {
            $main::db->rollback();
            return $database_error;
        }
        my ($kurl) = $st2->fetchrow;
        $st2->finish;
        print_msg("url id: " . $kurl, DEBUG);

        my $new_keys = 0;
        foreach my $keyword (@keywords) {
            if (!$main::db->query("INSERT INTO docbot_key (key, kurl) VALUES (?, ?)", lc($keyword), $kurl)) {
                $main::db->rollback();
                return $database_error;
            }
            $new_keys++;
        }
        $main::db->commit();

        if ($new_keys == 1) {
            my $answer = "Successfully added URL with 1 keyword";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'search_add_url_1_keyword', $answer);
            return $answer;
        } else {
            my $answer = "Successfully added URL with %1 keywords";
               $answer =~ s/\%1/$new_keys/;
            print_msg($answer, DEBUG);
            $answer = "Successfully added URL with %1 keywords";
            # translate message
            $answer = translate_text_for_channel($channel, 'search_add_url_n_keywords', $answer);
            $answer =~ s/\%1/$new_keys/;
            return $answer;
        }
    }

    return 'ERROR';
}


# handle_command_forget()
#
# command handler for the 'forget' command
#
# parameter:
#  - the command (lower case)
#  - the parameter string (may be empty)
#  - the command mode (admin/operator/user)
#  - POE kernel
#  - POE heap
#  - the full who of the message sender, including the nick name
#  - the nick name of the message sender
#  - the full origin of the message
#  - the message itself
#  - POE sender
#  - session irc handle
#  - the channel name
# return:
#  - 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 $channel = shift;

    my $session = find_irc_session($irc);


    # pre-translate this error message
    my $database_error = "Database error";
    # translate error message
    $database_error = translate_text_for_channel($channel, 'database_error', $database_error);


    # remove spaces at beginning and end
    $string =~ s/^[\s\t]+//gs;
    $string =~ s/[\s\t]+$//gs;


    my ($url, @keywords);
    my @keys = split(/\s+/, $string);
    my $url_pattern = config_get_key2('search', 'urlpattern');

    if (is_a_channel($channel)) {
        send_to_commandchannel("forget, by $nick in $channel: $string");
    } else {
        send_to_commandchannel("forget, by $nick: $string");
    }

    $main::db->rollback();


    if (($keys[0] !~ /$url_pattern/i) and ($keys[1] =~ /$url_pattern/i) and (scalar(@keys) > 2)) {
        my $answer = "Bad parameters";
           $answer = translate_text_for_channel($channel, 'search_bad_parameters', $answer);
        return $answer;
    }


    my $rows = 0;
    if (scalar(@keys) == 2 and $keys[1] =~ /$url_pattern/) {
        # key url

        my $st = $main::db->query("DELETE FROM docbot_key
                                         WHERE LOWER(key) = ?
                                           AND kurl IN (SELECT id
                                                          FROM docbot_url
                                                         WHERE url = ?)", lc($keys[0]), $keys[1]);
        if (!$st) {
            $main::db->rollback();
            return $database_error;
        }
        $rows = $st->rows;
        $main::db->commit();
        if ($rows == 0) {
            my $answer = "Nothing to forget";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_nothing_to_forget', $answer);
            return $answer;
        } elsif ($rows == 1) {
            my $answer = "Forgot 1 url";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_forgot_1_url', $answer);
            return $answer;
        } else {
            my $answer = "Forgot %1 urls";
               $answer =~ s/\%1/$rows/;
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_forgot_n_urls', $answer);
            $answer =~ s/\%1/$rows/;
            return $answer;
        }

    } elsif ($keys[0] =~ /$url_pattern/) {
        # one or more urls

        foreach my $keyword (@keys) {
            if ($keyword =~ /^$url_pattern/) {
                my $st = $main::db->query("DELETE FROM docbot_url WHERE url = ?", $keyword);
                if (!$st) {
                    $main::db->rollback();
                    return $database_error;
                }
                $rows += $st->rows;
            }
        }
        $main::db->commit();
        if ($rows == 0) {
            my $answer = "Nothing to forget";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_nothing_to_forget', $answer);
            return $answer;
        } elsif ($rows == 1) {
            my $answer = "Forgot 1 url";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_forgot_1_url', $answer);
            return $answer;
        } else {
            my $answer = "Forgot %1 urls";
               $answer =~ s/\%1/$rows/;
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_forgot_n_urls', $answer);
            $answer =~ s/\%1/$rows/;
            return $answer;
        }

    } else {
        # one or more keys

        foreach my $keyword (@keys) {
            my $st = $main::db->query("DELETE FROM docbot_key WHERE LOWER(key) = ?", lc($keyword));
            if (!$st) {
                $main::db->rollback();
                return $database_error;
            }
            $rows += $st->rows;
        }
        $main::db->commit();
        if ($rows == 0) {
            my $answer = "Nothing to forget";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_nothing_to_forget', $answer);
            return $answer;
        } elsif ($rows == 1) {
            my $answer = "Forgot 1 key";
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_forgot_1_key', $answer);
            return $answer;
        } else {
            my $answer = "Forgot %1 keys";
               $answer =~ s/\%1/$rows/;
            print_msg($answer, DEBUG);
            # translate message
            $answer = translate_text_for_channel($channel, 'forget_forgot_n_keys', $answer);
            $answer =~ s/\%1/$rows/;
            return $answer;
        }

    }

    return 'ERROR';
}


######################################################################
# IRC functions
######################################################################


# on_start()
#
# start the session
#
sub on_start {
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    my $irc     = $heap->{irc};
    my $session = find_irc_session($irc);
    print_msg("on_start(session: $session)", DEBUG);


    $irc->yield( register => 'all' );

    # 300 seconds is the default delay
    # the bot uses 60 seconds to response faster after timeouts
    # usually the old nick is still online, because the irc server has not yet recognized the timeout
    # means: usually a temporary nick has to be used
    $heap->{connector} = POE::Component::IRC::Plugin::Connector->new(delay => 60);
    $irc->plugin_add( 'Connector' => $heap->{connector} );

    $irc->plugin_add( 'CTCP' => POE::Component::IRC::Plugin::CTCP->new(
        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',
    ));

    $irc->yield( connect => { Debug => $main::debug_traffic } );

    # enable tracing
    #$_[SESSION]->option(trace => 1);

    $main::sessions{$session}{'logged_in'} = 0;

    return;
}


# irc_001
# on_connect()
#
# connected to irc server
#
sub on_connect {
    my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];

    # 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 $session = find_irc_session($irc);


    print_msg("Session $session connected to " . $irc->server_name(), DEBUG);

    $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;
    # might need this pointers in the maintenance routines
    $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_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(/^yes$/) {$channel_autojoin_result = 1;}
        }
        if ($channel_session == $session and $channel_autojoin_result == 1) {
            push(@join_channels, $channel);
            print_msg("assign irc channel '$channel' to session '$session'", DEBUG);
        }
    }
    print_msg("Channel list for session $session: " . join(", ", @join_channels), DEBUG);


    set_session_activity($session);
    $main::statistics{'connects'}++;


    # join all channels for this session
    $main::sessions{$session}{'joined_channels'} = [];
    my %chan_data = ();
    foreach my $channel (@join_channels) {
        # based on the current configuration, each channel can only be joined by one bot session
        my $channel_password = config_get_key3('channels', $channel, 'password');
        if (defined($channel_password) and length($channel_password) > 0) {
            $irc->yield( join => $channel, $channel_password );
        } else {
            $irc->yield( join => $channel );
        }
        $chan_data{$channel} = {};
    }
    $heap->{'chan_data_' . $session} = \%chan_data;

    return;
}


########
# 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 ($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 $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_message($msg), session: $session", DEBUG);


    # if this is a message sent to a channel
    if (lc($channel) ne lc($irc->nick_name())) {
        # store it in the ringbuffer
        store_channel_message_in_ringbuffer($kernel, $heap, $who, $where, $msg, $sender, $nick, $channel, $irc, $session);
    }


    # recognize valid command (admin, operator and unprivileged)
    my ($command, $string) = find_command($msg, (is_a_channel($channel)) ? $channel : undef);


    if (defined($command)) {
        my $answer = '';

        # handle authentication commands
        if (is_valid_admin_command($command) or is_valid_operator_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);
            }
            elsif (is_valid_admin_command($command)) {
                if (is_nick_allowed_admin_command($nick)) {
                    # execute desired command
                    #$answer = $admin_commands->{$command}($kernel, $nick, $channel, $string);
                    $answer = "Execute command: $command";
                    print_msg("Execute command: $command, $nick, $channel", INFO);
                    $answer = handle_command($command, $string, 'admin', $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
                } else {
                    # user is not allowed to execute admin commands
                    $answer = "Access denied";
                    # translate error message
                    $answer = translate_text_for_channel($channel, 'access_denied', $answer);
                }
            }
            elsif (is_valid_operator_command($command)) {
                if (is_nick_allowed_operator_command($nick)) {
                    # execute desired command
                    #$answer = $admin_commands->{$command}($kernel, $nick, $channel, $string);
                    $answer = "Execute command: $command";
                    print_msg("Execute command: $command, $nick, $channel", INFO);
                    $answer = handle_command($command, $string, 'operator', $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);
                } else {
                    # user is not allowed to execute admin commands
                    $answer = "Access denied";
                    # translate error message
                    $answer = translate_text_for_channel($channel, 'access_denied', $answer);
                }
            }
            # drop the callback for this nick
            undef ($heap->{whois_callback}->{$nick});

        } else {

            # execute desired command
            #$answer = $admin_commands->{$command}($kernel, $nick, $channel, $string);
            $answer = "Execute command: $command";
            print_msg("Execute command: $command, $nick, $channel", INFO);
            $answer = handle_command($command, $string, 'user', $kernel, $heap, $who, $nick, $where, $msg, $sender, $irc, $channel);

        }

        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;
        }

    }
}


# 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)", 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)", DEBUG);

    if (defined($heap->{whois_callback}->{$nick}->{event})) {
        $irc->send_event($heap->{whois_callback}->{$nick}->{event} => @{$heap->{whois_callback}->{$nick}->{args}});
    }
}


# on_ping()
#
# catch the ping and update activity
#
sub on_ping {
    my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_ping(session: $session)", DEBUG);

    set_session_activity($session);
}


# do_autoping()
#
# Ping ourselves, but only if we haven't seen any traffic since the
# last ping. This prevents us from pinging ourselves more than
# necessary (which tends to get noticed by server operators).
#
sub do_autoping {
    my ($sender, $kernel, $heap) = @_[SENDER, KERNEL, HEAP];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("do_autoping(session: $session)", DEBUG);


    set_session_activity($session);

    if (!$heap->{seen_traffic}) {
        # send ping to myself
        $irc->yield( ping => $irc->nick_name() );
    }
    $heap->{seen_traffic} = 0;
    $kernel->delay(autoping => 300);
}


# on_irc_registered()
#
# catch irc_registered and update activity
#
sub on_irc_registered {
    my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    #print_msg("on_irc_registered(session: $session)", DEBUG);

    set_session_activity($session);
}


# on_irc_plugin_add()
#
# catch irc_plugin_add and update activity
#
sub on_irc_plugin_add {
    my ($kernel, $heap, $sender ) = @_[KERNEL, HEAP, SENDER];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    #print_msg("on_irc_plugin_add(session: $session)", DEBUG);

    set_session_activity($session);
}


# on_nickused()
#
# called if the desired nick is already in use
#
# note:
#  - called on connect, if the requested nick is in use
#  - called on nickchange, if the requested nick is in use
#
sub on_nickused {
    my ($kernel, $heap, $nick_name) = @_[KERNEL, HEAP, ARG1];

    my $irc     = $heap->{irc};
    my $session = find_irc_session($irc);
    print_msg("on_nickused(session: $session)", DEBUG);


    # extract the nickname from the error message
    $nick_name =~ s/^(.+?) :Nickname is already in use./$1/;
    print_msg("nickname ($nick_name) not available, session: $session", INFO);


    # only try to change the nickname, if the session is not logged in
    # this happens if the desired nick is in use during reconnect
    if (!$main::sessions{$session}{'logged_in'}) {
        # try another nickname
        $nick_name .= '_';
        if ($nick_name =~ /^(.+?)(_+)$/) {
            if (length($2) > 2) {
                # too many '_' in the nick, let's start over again
                $nick_name = $1;
            }
        }
        print_msg("sending new nickname: $nick_name", INFO);
        $irc->yield( nick => $nick_name );
    }
}


# on_end_motd()
#
# catch the end of the MOTD
#
# note:
#  - used to find out when the session is finally logged in
#
sub on_end_motd {
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    my $irc     = $heap->{irc};
    my $session = find_irc_session($irc);
    print_msg("on_end_motd(session: $session)", DEBUG);


    # auth the nickname
    my $nickname = config_get_key3('sessions', $session, 'nickname');
    my $password = config_get_key3('sessions', $session, 'password');
    my $nickname_now = $irc->nick_name();
    if (lc($nickname_now) eq lc($nickname)) {
        if (defined($password) and length($password) > 0) {
            print_msg("authenticating against nickserv, session: $session", DEBUG);
            $irc->yield( privmsg => 'nickserv', 'identify ' . $password );
        }
    }

    $main::sessions{$session}{'past_motd'} = 1;
}


# on_error()
#
# catch any error during communication with irc
#
sub on_error {
    my ($sender, $kernel, $heap, $text) = @_[SENDER, KERNEL, HEAP, ARG0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);

    print_msg("on_error(session: $session, error: \"" . $text . "\")", DEBUG);

    if ($shutdown == 1) {
        print_msg("Shutting down in on_error(session: $session)", INFO);
        # the real shutdown will take place in execute_shutdown()
        # the call is triggered in death() or interrupt_handler_quit()
    } else {
        print_msg("Reconnect session: $session", INFO);
        # reconnect will be handled by Component::IRC Component::IRC::Plugin::Connector
    }

    $main::sessions{$session}{'logged_in'} = 0;
}


# on_disconnected()
#
# catch any error disconnect
#
sub on_disconnected {
    my ($sender, $kernel, $heap, $text) = @_[SENDER, KERNEL, HEAP, ARG0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);

    print_msg("on_disconnected(session: $session, error: \"" . $text . "\")", DEBUG);

    $main::sessions{$session}{'logged_in'} = 0;
}


# on_join()
#
# handle channel join events
#
sub on_join {
    my ($sender, $kernel, $heap, $who, $channel) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
    my $nick = ( split /!/, $who )[0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);

    print_msg("on_join(session: $session, nick: $nick, channel: $channel)", DEBUG);

    if ($irc->nick_name() eq $nick) {
        print_msg("I just joined channel $channel (session: $session)", DEBUG);
        # add this list to the list of session channels
        push(@{$main::sessions{$session}{'joined_channels'}}, $channel);
    }

    add_nick($heap, $nick, $channel, $session);

    set_session_activity($session);
}


# on_part()
#
# handle channel part events
#
sub on_part {
    my ($sender, $kernel, $heap, $who, $channel) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
    my $nick = ( split /!/, $who )[0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);

    print_msg("on_part(session: $session, nick: $nick, channel: $channel)", DEBUG);

    if ($irc->nick_name() eq $nick) {
        print_msg("I just left channel $channel (session: $session)", DEBUG);
        # remove this channel from the list of session channels
        my @new_channels = @{$main::sessions{$session}{'joined_channels'}};
        $main::sessions{$session}{'joined_channels'} = [];
        foreach my $temp_channel (@new_channels) {
            if (lc($temp_channel) ne lc($channel)) {
                push(@{$main::sessions{$session}{'joined_channels'}}, $temp_channel);
            }
        }
        remove_channel($heap, $channel, $session);
    } else {
        remove_nick($heap, $nick, $channel, $session);
    }

    set_session_activity($session);
}


# on_quit()
#
# handle quit events
#
sub on_quit {
    my ($sender, $kernel, $heap, $who) = @_[SENDER, KERNEL, HEAP, ARG0];
    my $nick = ( split /!/, $who )[0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_quit(session: $session, nick: $nick)", DEBUG);

    if ($irc->nick_name() eq $nick) {
        print_msg("I quit the IRC (session: $session)", INFO);
        # clean the session channel list
        $main::sessions{$session}{'joined_channels'} = [];
    }

    remove_nick($heap, $nick, undef, $session);

    set_session_activity($session);
}


# on_nick()
#
# handle nickchange events
#
sub on_nick {
    my ($sender, $kernel, $heap, $who, $new) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
    my $nick = ( split /!/, $who )[0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_nick(session: $session, nick: $nick to nick: $new)", DEBUG);

    my @channels = find_nick($heap, $nick, $session);

    foreach my $channel (@channels) {
        remove_nick($heap, $nick, $channel, $session);
        add_nick($heap, $new, $channel, $session);
    }

    set_session_activity($session);
}


# on_names()
#
# handle channel member list events
#
sub on_names {
    my ($sender, $kernel, $heap, $server, $detail) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1];
    my ($channel, $nicknames) = $detail =~ /^. (.*?) :(.*)$/;
    if (!defined($nicknames)) {
        ($channel, $nicknames) = $detail =~ /^\@ (.*?) \@(.*)$/;
        if (!defined($nicknames)) {
            print_msg("Parse failed in on_names() for $detail", ERROR);
            return;
        }
    }

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_names(session: $session)", DEBUG2);

    my @nicknames = split(/\s+/, $nicknames);
    for my $nick (@nicknames) {
        $nick =~ s/^@//;
        add_nick($heap, $nick, $channel, $session);
    }

    set_session_activity($session);
}


# on_kick()
#
# handle kick events
#
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];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_kick(session: $session, nick: $nick, channel: $channel, by: $kicker)", DEBUG);

    if ($irc->nick_name() eq $nick) {
        print_msg("I ($nick) was kicked from channel $channel by $kicker (session: $session, reason: $reason)", DEBUG);
        remove_channel($heap, $channel, $session);
        $irc->yield( join => $channel );
    } else {
        remove_nick($heap, $nick, $channel, $session);
    }

    set_session_activity($session);
}


# on_cannot_join_channel()
#
# handle "cannot join channel" events
#
sub on_cannot_join_channel {
    my ($sender, $kernel, $heap, $arg0, $arg1, $arg2) = @_[SENDER, KERNEL, HEAP, ARG0, ARG1, ARG2];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);
    print_msg("on_cannot_join_channel(session: $session): $arg1", DEBUG);

    send_to_commandchannel($arg1);

    set_session_activity($session);
}


# on_irc_raw()
#
# set session activity (incoming traffic)
#
sub on_irc_raw {
    my ($sender, $kernel, $heap, $raw) = @_[SENDER, KERNEL, HEAP, ARG0];

    my $irc     = $sender->get_heap();
    my $session = find_irc_session($irc);

    set_session_activity($session);


    # write current timestamp into monitoring file
    my $monitoring_file = config_get_key2('monitoring', 'file');
    if (defined($monitoring_file)) {
        my $monitoring_fh = new FileHandle;
        # question: is a file lock required?
        if (!open($monitoring_fh, ">", $monitoring_file)) {
            print_msg("cannot open monitoring file: $!", ERROR);
        } else {
            print $monitoring_fh time();
            close($monitoring_fh);
        }
    }
}


# on_irc_raw_out()
#
# set session activity (outgoing traffic)
#
sub on_irc_raw_out {
    my ($sender, $kernel, $heap, $raw) = @_[SENDER, KERNEL, HEAP, ARG0];

    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
    #set_session_activity($session);
}


# on_irc_notice()
#
# output irc notices to commandchannel
#
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 $session = find_irc_session($irc);

    given ($who) {
        when(/^NickServ/) {}
        when(/^ChanServ/) {}
        when(/\.freenode\.net/i) {}
        default {
            # send to commandchannel
            my $text = 'irc notice on session ' . $irc->nick_name() . ' from: ' . $nick;
            send_to_commandchannel($text);
            $text = 'text: ' . $notice;
            send_to_commandchannel($text);
        }
    }
}


## http://poe.perl.org/?POE_Cookbook/IRC_Bot_Debugging
## http://poe.perl.org/?POE_Cookbook/IRC_Bot_Disconnecting
## http://poe.perl.org/?POE_Cookbook/IRC_Bot_Reconnecting
## http://poe.perl.org/?POE_Cookbook
## http://poe.perl.org/?Tutorials
## http://poe.perl.org/?POE_Support_Resources
## http://www.mirc.net/raws/

# we registered for all events, this will produce some debug info.
sub _default {

    #foreach my $tmp (@_) {
    #    print "_default: $tmp\n";
    #}
    #exit();

    my ($sender, $event, $args) = @_[SENDER, ARG0 .. $#_];
    my @output = ( "$event: " );

    ##print "sender:\n" . Dumper($sender) . "\n";
    #print "class: " . $sender . "\n";
    #print "event: " . $event . "\n";
    #exit();

    if (substr($event, 0, 1) eq '_') {
      return;
    }

    my $irc = $sender->get_heap();
    if (!defined($irc)) {
        print_msg("No \$irc entry found in _default()", ERROR);
        death();
    }
    my $session = find_irc_session($irc);
    if (!defined($session)) {
        print_msg("No session found in _default()", ERROR);
        death();
    }

    set_session_activity($session);


    for my $arg (@$args) {
        if ( ref($arg) eq 'ARRAY' ) {
            push( @output, '[' . join(', ', @$arg ) . ']' );
        } elsif ( ref($arg) eq 'HASH' ) {
            push( @output, '[' . '(hash)' . ']' );
        } else {
            push ( @output, "'$arg'" );
        }
    }
    my $output = join(' ', @output);


    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('irc_disconnected') { $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] =~ /\.freenode\.net/i) { $print_it = 0; }
        }
        when('irc_ctcp_version') {
            if (@$args[0] =~ /^freenode\-connect/) { $print_it = 0; }
        }
        when(/^irc_\d+/) { $print_it = 0; }
    }
    #$print_it = 1;


    if ($main::debug_traffic == 1) {
        print $output . "\n";
    }
    if ($print_it == 1) {
        print_msg($output, DEBUG);
        send_to_commandchannel($output);
    }

    # don't handle POE signals
    return 0;
}



#
## vi: ts=4