scripts/seen.pl

use strict;
use 5.005_62;       # for 'our'
use Irssi 20020428; # for Irssi::signal_continue
use vars qw($VERSION %IRSSI);

$VERSION = "1.8";
%IRSSI = (
    authors     => 'Marcin \'Qrczak\' Kowalczyk',
    contact     => 'qrczak@knm.org.pl',
    name        => 'Seen',
    description => 'Tell people when other people were online',
    license     => 'GPL',
    url         => 'http://qrnik.knm.org.pl/~qrczak/irssi/seen.pl',
);

######## User interface ########

# COMMANDS
# ========
#
# /seen <nick>
#     Show last seen info about nick.
#
# /say_seen [<to_whom>] <nick>
#     Say last seen info about nick in the current window. If to_whom
#     is present, answer as if that person issued a seen request.
#
# /listen on [[<chatnet>] <channel>]
#     Turn on listening for seen requests in the current or given channel.
#
# /listen off [[<chatnet>] <channel>]
#     Turn off listening for seen requests in the current or given channel.
#
# /listen delay [[<chatnet>] <channel>]
#     Turn on listening for seen requests in the current or given channel.
#     We will reply only if nobody else replies with a message containing
#     the given nick (probably a seen reply from another bot) in seen_delay
#     seconds.
#
# /listen private [[<chatnet>] <channel>]
#     Turn on listening for seen requests in the current or given channel.
#     The reply will be sent as a private notice.
#
# /listen disable [[<chatnet>] <channel>]
#     Same as "off", used to distinguish channels where we won't listen
#     for sure from channels we didn't specify anything about.
#
# /listen list
#     Show which channels we are listening for seen requests on.

# Forms of seen requests from other people:
#     Public message "<our_nick>: seen <nick>".
#     Public message "seen <nick>" on channels where we are listening.
#     Private message "seen <nick>".
#     Any of the above with "!seen" instead of "seen".
#     Any of the above with a question mark at the end.
#     Any of the above with "jest <nick>?", "by&sup3; <nick>?", "by&sup3;a <nick>?",
#       "<nick> jest?", "<nick> by&sup3;?", "<nick> by&sup3;a?", with optional
#       "czy" at the beginning - provided that we know that nick
#       (to avoid treating some other message as a seen request).

# VARIABLES
# =========
#
# seen_expire_after
#     After that number of days we forget about nicks and addresses.
#     Default 30.
#
# seen_expire_asked_after
#     After that number of days we forget that that somebody was
#     searched for and don't send a notice. Default 7.
#
# seen_delay   
#     On channels set to '/listen delay' we reply if after that number
#     of seconds nobody else replies. Default 60.

######## Internal structure of the database in memory ########

# %listen_on      = (chatnet => {channel => listening})
# %address_absent = (chatnet => {address => time})
# %nicks          = (chatnet => {address => [nick]})
# %last_nicks     = (chatnet => {address => nick})
# %how_quit       = (chatnet => {address => how_quit})
# %spoke          = (chatnet => {address => time})
# %nick_absent    = (chatnet => {nick => time})
# %addresses      = (chatnet => {nick => address})
# %orig_nick      = (chatnet => {nick => nick})
# %channels       = (chatnet => {nick => [channel]})
# %asked          = (chatnet => {nick => {nick_asks => time}})

# listening:
#   'on', undef = 'off', 'delay', 'private', 'disable'

# how_quit:
#   ['disappeared']
#   ['was_left', kanal]
#   ['left', channel, reason]
#   ['quit', channels, reason]
#   ['was_kicked', channel, kicker, reason]

######## Global variables ########

our %listen_on = ();
our %address_absent = ();
our %nicks = ();
our %last_nicks = ();
our %how_quit = ();
our %spoke = ();
our %nick_absent = ();
our %addresses = ();
our %orig_nick = ();
our %channels = ();
our %asked = ();

Irssi::settings_add_int "seen", "seen_expire_after", 30;      # days
Irssi::settings_add_int "seen", "seen_expire_asked_after", 7; # days
Irssi::settings_add_int "seen", "seen_delay", 60;             # seconds

our $database     = Irssi::get_irssi_dir . "/seen.dat";
our $database_tmp = Irssi::get_irssi_dir . "/seen.tmp";
our $database_old = Irssi::get_irssi_dir . "/seen.dat~";

######## Utilities ########

our $nick_regexp = qr/
  [A-Z\[\\\]^_`a-z{|}\200-\377]
  [\-0-9A-Z\[\\\]^_`a-z{|}\200-\377]*
  /x;
our $seen_regexp = qr/^ *!?seen +($nick_regexp) *\?* *$/i;
our $maybe_seen_regexp1 = qr/
  ^\ *
  (?:a\ +)?
  (?:(?:if|when|here)\ +)?
  (?:(?:dzi[&para;s]|today|last time|recently|ju[&iquest;z]|here|tutaj|mo[&iquest;z]e)\ +)*
  (?:in|by[&sup3;l]a?)\ +
  (?:(?:dzi[&para;s]|today|last time|recently|ju[&iquest;z]|here|tutaj|mo[&iquest;z]e)\ +)*
  ($nick_regexp)
  (?:\ +(?:dzi[&para;s]|today|last time|recently|ju[&iquest;z]|here|tutaj|mo[&iquest;z]e))*
  \ *\?+\ *$/ix;
our $maybe_seen_regexp2 = qr/
  ^\ *
  (?:a\ +)?
  (?:(?:czy|kiedy|gdzie)\ +)?
  (?:(?:dzi[&para;s]|today|last time|recently|ju[&iquest;z]|here|tutaj|mo[&iquest;z]e)\ +)*
  ($nick_regexp)?\ +
  (?:(?:dzi[&para;s]|today|last time|recently|ju[&iquest;z]|here|tutaj|mo[&iquest;z]e)\ +)*
  (?:in|by[&sup3;l]a?)
  (?:\ +(?:dzi[&para;s]|today|last time|recently|ju[&iquest;z]|here|tutaj|mo[&iquest;z]e))*
  \ *\?+\ *$/ix;
our $exclude_regexp = qr/^(?:kto[&para;s]?|who?|that?|that|ladna|i|a)$/i;

sub lc_irc($) {
    my ($str) = @_;
    $str =~ tr/A-Z[\\]/a-z{|}/;
    return $str;
}

sub uc_irc($) {
    my ($str) = @_;
    $str =~ tr/a-z{|}/A-Z[\\]/;
    return $str;
}

our %lc_regexps = ();

sub lc_irc_regexp($) {
    my ($str) = @_;
    $str =~ s/(.)/my $lc = lc_irc $1; my $uc = uc_irc $1; "[\Q$lc$uc\E]"/eg;
    return $str;
}

sub canonical($) {
    my ($address) = @_;
    $address =~ s/^[\^~+=-]//;
    return $address;
}

sub show_list(@) {
    @_ == 0 and return "";
    @_ == 1 and return $_[0];
    return join(", ", @_[0..$#_-1]) . " i " . $_[$#_];
}

sub show_time_since($) {
    my ($time) = @_;
    my $diff = time() - $time;
    $diff >= 0 or return "nie wiem kiedy (zegarek mi sie popsul)";
    my $s = $diff % 60; $diff = int(($diff - $s) / 60);
    my $m = $diff % 60; $diff = int(($diff - $m) / 60);
    my $h = $diff % 24; $diff = int(($diff - $h) / 24);
    my $d = $diff;
    my $s_txt = $s ? "${s}s " : "";
    my $m_txt = $m ? "${m}m " : "";
    my $h_txt = $h ? "${h}h " : "";
    my $d_txt = $d ? "${d}d " : "";
    return
      $d ? "$d_txt${h_txt}ago" :
      $h ? "$h_txt${m_txt}ago" :
      $m ? "$m_txt${s_txt}ago" :
      "${s}s ago";
}

sub all_channels($@) {
    my ($chatnet, @nicks) = @_;
    my %chans = ();
    foreach my $nick (@nicks) {
        if ($channels{$chatnet}{lc_irc $nick}) {
            foreach my $channel (@{$channels{$chatnet}{lc_irc $nick}}) {
                $chans{$channel} = 1;
            }
        }
    }
    return keys %chans;
}

sub is_private($) {
    my ($channel) = @_;
    return $channel && $channel->{mode} =~ /^[^ ]*[ps]/;
}

sub mark_private($$) {
    my ($channel, $name) = @_;
    return is_private $channel ? "-$name" : $name;
}

######## Actions on the database in memory ########

sub do_listen($$$) {
    my ($chatnet, $channel, $state) = @_;
    if ($state eq 'off') {
        delete $listen_on{$chatnet}{$channel};
    } else {
        $listen_on{$chatnet}{$channel} = $state;
    }
}

sub do_join($$$$) {
    my ($chatnet, $address, $nick, $channel) = @_;
    my $lc_nick = lc_irc $nick;
    my $lc_channel = lc_irc $channel;
    delete $address_absent{$chatnet}{$address};
    push @{$nicks{$chatnet}{$address}}, $nick
      unless grep {lc_irc $_ eq $lc_nick} @{$nicks{$chatnet}{$address}};
    push @{$channels{$chatnet}{$lc_nick}}, $channel
      unless grep {lc_irc $_ eq $lc_channel} @{$channels{$chatnet}{$lc_nick}};
    delete $how_quit{$chatnet}{$address};
    delete $nick_absent{$chatnet}{$lc_nick};
    $addresses{$chatnet}{$lc_nick} = $address;
    $orig_nick{$chatnet}{$lc_nick} = $nick;
}

sub do_quit_all($$$$$) {
    my ($time, $chatnet, $address, $nick, $reason) = @_;
    $address_absent{$chatnet}{$address} = $time;
    delete $nicks{$chatnet}{$address};
    $last_nicks{$chatnet}{$address} = $nick;
    $how_quit{$chatnet}{$address} = $reason;
}

sub do_quit($$$$) {
    my ($time, $chatnet, $address, $nick) = @_;
    my $lc_nick = lc_irc $nick;
    $nicks{$chatnet}{$address} =
      [grep {lc_irc $_ ne $lc_nick} @{$nicks{$chatnet}{$address}}];
    delete $channels{$chatnet}{$lc_nick};
    $nick_absent{$chatnet}{$lc_nick} = $time;
    $addresses{$chatnet}{$lc_nick} = $address;
    $orig_nick{$chatnet}{$lc_nick} = $nick;
}

sub do_part($$$$) {
    my ($chatnet, $address, $nick, $channel) = @_;
    my $lc_nick = lc_irc $nick;
    my $lc_channel = lc_irc $channel;
    $channels{$chatnet}{$lc_nick} =
      [grep {lc_irc $_ ne $lc_channel} @{$channels{$chatnet}{$lc_nick}}];
}

sub do_nick($$$$$) {
    my ($time, $chatnet, $address, $old_nick, $new_nick) = @_;
    my $lc_old_nick = lc_irc $old_nick;
    my $lc_new_nick = lc_irc $new_nick;
    $nicks{$chatnet}{$address} =
      [(grep {lc_irc $_ ne $lc_old_nick} @{$nicks{$chatnet}{$address}}), $new_nick];
    my $chans = $channels{$chatnet}{$lc_old_nick};
    delete $channels{$chatnet}{$lc_old_nick};
    $channels{$chatnet}{$lc_new_nick} = $chans;
    $nick_absent{$chatnet}{$lc_old_nick} = $time;
    delete $nick_absent{$chatnet}{$lc_new_nick};
    $addresses{$chatnet}{$lc_new_nick} = $address;
    $orig_nick{$chatnet}{$lc_new_nick} = $new_nick;
}

sub do_spoke($$$) {
    my ($time, $chatnet, $address) = @_;
    my $old_time = $spoke{$chatnet}{$address};
    $spoke{$chatnet}{$address} = $time
      unless defined $old_time && $old_time > $time;
}

sub do_ask($$$$) {
    my ($time, $chatnet, $nick, $nick_asks) = @_;
    my $lc_nick = lc_irc $nick;
    my $lc_nick_asks = lc_irc $nick_asks;
    my $old_time = $asked{$chatnet}{$lc_nick}{$lc_nick_asks};
    $asked{$chatnet}{$lc_nick}{$lc_nick_asks} = $time
      unless defined $old_time && $old_time > $time;
}

sub do_forget_ask($$$) {
    my ($chatnet, $nick, $nick_asks) = @_;
    my $lc_nick = lc_irc $nick;
    my $lc_nick_asks = lc_irc $nick_asks;
    delete $asked{$chatnet}{$lc_nick}{$lc_nick_asks};
}

######## Actions on the database in memory and in the file ########

sub append_to_database(@) {
    open DATABASE, ">>$database";
    print DATABASE map {"$_\n"} @_;
    close DATABASE;
}

sub on_listen($$$) {
    my ($chatnet, $channel, $state) = @_;
    do_listen $chatnet, $channel, $state;
    append_to_database "listen $state $chatnet $channel";
}

sub on_join($$$$) {
    my ($chatnet, $address, $nick, $channel) = @_;
    do_join $chatnet, $address, $nick, $channel;
    append_to_database "join $chatnet $address $nick $channel";
}

sub on_quit_all($$$$) {
    my ($chatnet, $address, $nick, $reason) = @_;
    my $time = time();
    do_quit_all $time, $chatnet, $address, $nick, $reason;
    append_to_database "quit_all $time $chatnet $address $nick @$reason";
}

sub on_quit($$$$) {
    my ($chatnet, $address, $nick, $reason) = @_;
    my $time = time();
    do_quit $time, $chatnet, $address, $nick;
    append_to_database "quit $time $chatnet $address $nick";
    on_quit_all $chatnet, $address, $nick, $reason
      unless @{$nicks{$chatnet}{$address}};
}

sub on_part($$$$$) {
    my ($chatnet, $address, $nick, $channel, $reason) = @_;
    do_part $chatnet, $address, $nick, $channel;
    append_to_database "part $chatnet $address $nick $channel";
    on_quit $chatnet, $address, $nick, $reason
      unless @{$channels{$chatnet}{lc_irc $nick}};
}

sub on_nick($$$$) {
    my ($chatnet, $address, $old_nick, $new_nick) = @_;
    my $time = time();
    do_nick $time, $chatnet, $address, $old_nick, $new_nick;
    append_to_database "nick $time $chatnet $address $old_nick $new_nick";
}

sub on_spoke($$) {
    my ($chatnet, $address) = @_;
    my $time = time();
    return if $spoke{$chatnet}{$address} == $time;
    do_spoke $time, $chatnet, $address;
    append_to_database "spoke $time $chatnet $address";
}

sub on_ask($$$) {
    my ($chatnet, $nick, $nick_asks) = @_;
    my $time = time();
    do_ask $time, $chatnet, $nick, $nick_asks;
    append_to_database "ask $time $chatnet $nick $nick_asks";
}

######## Reading the database from file ########

sub syntax_error() {
    die "Syntax error in $database: $_";
}

our %parse_how_quit = (
    disappeared => sub {
        return ['disappeared'];
    },
    was_left => sub {
        $_[0] =~ /^ ([^ ]*)$/ or syntax_error;
        return ['was_left', $1];
    },
    left => sub {
        $_[0] =~ /^ ([^ ]*) (.*)$/ or syntax_error;
        return ['left', $1, $2];
    },
    quit => sub {
        $_[0] =~ /^ ([^ ]*) (.*)$/ or syntax_error;
        return ['quit', $1, $2];
    },
    was_kicked => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
        return ['was_kicked', $1, $2, $3];
    },
);

sub parse_how_quit($) {
    my ($how_quit) = @_;
    $how_quit =~ /^([^ ]*)(| .*)$/ or syntax_error;
    my $func = $parse_how_quit{$1} or syntax_error;
    return $func->($2);
}

our %parse_database = (
    listen => sub {
        $_[0] =~ /^ (on|off|delay|private|disable) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_listen $2, $3, $1;
    },
    join => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_join $1, $2, $3, $4;
    },
    quit_all => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
        my ($time, $chatnet, $address, $nick, $how_quit) = ($1, $2, $3, $4, $5);
        do_quit_all $time, $chatnet, $address, $nick, parse_how_quit($how_quit);
    },
    quit => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_quit $1, $2, $3, $4;
    },
    part => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_part $1, $2, $3, $4;
    },
    nick => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_nick $1, $2, $3, $4, $5;
    },
    spoke => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_spoke $1, $2, $3;
    },
    ask => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_ask $1, $2, $3, $4;
    },
    forget_ask => sub {
        $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
        do_forget_ask $1, $2, $3;
    },
);

sub read_database() {
    open DATABASE, $database or return;
    while (<DATABASE>) {
        chomp;
        /^([^ ]*)(| .*)$/ or syntax_error;
        my $func = $parse_database{$1} or syntax_error;
        $func->($2);
    }
    close DATABASE;
}

######## Writing the database to file ########

sub write_database {
    open DATABASE, ">$database_tmp";
    foreach my $chatnet (keys %listen_on) {
        foreach my $channel (keys %{$listen_on{$chatnet}}) {
            my $state = $listen_on{$chatnet}{$channel};
            print DATABASE "listen $state $chatnet $channel\n";
        }
    }
    foreach my $chatnet (keys %nick_absent) {
        foreach my $nick (keys %{$nick_absent{$chatnet}}) {
            my $time = $nick_absent{$chatnet}{$nick};
            my $address = $addresses{$chatnet}{$nick};
            my $orig = $orig_nick{$chatnet}{$nick};
            print DATABASE "quit $time $chatnet $address $orig\n";
        }
    }
    foreach my $chatnet (keys %address_absent) {
        foreach my $address (keys %{$address_absent{$chatnet}}) {
            my $time = $address_absent{$chatnet}{$address};
            my $nick = $last_nicks{$chatnet}{$address};
            my $reason = $how_quit{$chatnet}{$address};
            print DATABASE "quit_all $time $chatnet $address $nick @$reason\n";
        }
    }
    foreach my $chatnet (keys %spoke) {
        foreach my $address (keys %{$spoke{$chatnet}}) {
            my $time = $spoke{$chatnet}{$address};
            print DATABASE "spoke $time $chatnet $address\n";
        }
    }
    foreach my $chatnet (keys %nicks) {
        foreach my $address (keys %{$nicks{$chatnet}}) {
            foreach my $nick (@{$nicks{$chatnet}{$address}}) {
                foreach my $channel (@{$channels{$chatnet}{lc_irc $nick}}) {
                    print DATABASE "join $chatnet $address $nick $channel\n";
                }
            }
        }
    }
    foreach my $chatnet (keys %asked) {
        foreach my $nick (keys %{$asked{$chatnet}}) {
            foreach my $nick_asked (keys %{$asked{$chatnet}{$nick}}) {
                my $time = $asked{$chatnet}{$nick}{$nick_asked};
                print DATABASE "ask $time $chatnet $nick $nick_asked\n";
            }
        }
    }
    close DATABASE;
    rename $database, $database_old;
    rename $database_tmp, $database;
}

######## Update the database to reflect currently joined users ########

sub initialize_database() {
    my $time = time();
    foreach my $chatnet (keys %nicks) {
        my @addresses = keys %{$nicks{$chatnet}};
        foreach my $address (@addresses) {
            my @nicks = @{$nicks{$chatnet}{$address}};
            foreach my $nick (@nicks) {
                do_quit $time, $chatnet, $address, $nick;
            }
            do_quit_all $time, $chatnet, $address, $nicks[0], ['disappeared'];
        }
    }
    foreach my $server (Irssi::servers()) {
        foreach my $channel ($server->channels()) {
            foreach my $nick ($channel->nicks()) {
                do_join lc $server->{chatnet},
                  canonical $nick->{host}, $nick->{nick}, $channel->{name}
                  if $nick->{host} ne "";
            }
        }
    }
}

######## Expire old entries ########

sub expire_database() {
    my $days = Irssi::settings_get_int("seen_expire_after");
    my $time = time() - $days*24*60*60;
    my %reachable_addresses = ();
    foreach my $chatnet (keys %addresses) {
        foreach my $address (values %{$addresses{$chatnet}}) {
            $reachable_addresses{$chatnet}{$address} = 1;
        }
    }
    foreach my $chatnet (keys %address_absent) {
        foreach my $address (keys %{$address_absent{$chatnet}}) {
            if ($address_absent{$chatnet}{$address} <= $time ||
                !$reachable_addresses{$chatnet}{$address}) {
                delete $address_absent{$chatnet}{$address};
                delete $last_nicks{$chatnet}{$address};
                delete $how_quit{$chatnet}{$address};
            }
        }
    }
    foreach my $chatnet (keys %spoke) {
        foreach my $address (keys %{$spoke{$chatnet}}) {
            if ($spoke{$chatnet}{$address} <= $time ||
                !$reachable_addresses{$chatnet}{$address}) {
                delete $spoke{$chatnet}{$address};
            }
        }
    }
    foreach my $chatnet (keys %nick_absent) {
        foreach my $nick (keys %{$nick_absent{$chatnet}}) {
            if ($nick_absent{$chatnet}{$nick} <= $time) {
                delete $nick_absent{$chatnet}{$nick};
                delete $addresses{$chatnet}{$nick};
                delete $orig_nick{$chatnet}{$nick};
            }
        }
    }
    my $days_asked = Irssi::settings_get_int("seen_expire_asked_after");
    my $time_asked = time() - $days_asked*24*60*60;
    foreach my $chatnet (keys %asked) {
        foreach my $nick (keys %{$asked{$chatnet}}) {
            foreach my $nick_asks (keys %{$asked{$chatnet}{$nick}}) {
                if ($asked{$chatnet}{$nick}{$nick_asks} <= $time_asked) {
                    delete $asked{$chatnet}{$nick}{$nick_asks};
                }
            }
        }
    }
}

######## Compose a description when did we see that person ########

sub show_reason($) {
    my ($reason) = @_;
    return ":" if $reason eq "";
    $reason =~ s/\cc\d\d?(,\d\d?)?|[\000-\037]//g;
    return ": $reason";
}

sub only_public(@$) {
    my $can_show = pop @_;
    my @channels = ();
    foreach my $channel (@_) {
        if ($channel =~ /^-(.*)$/) {
            push @channels, $1 if $can_show->($1);
        } else {
            push @channels, $channel;
        }
    }
    return wantarray ? @channels : $channels[0];
}

sub is_here(\@$) {
    my ($channels, $where_asks) = @_;
    return if !defined $where_asks;
    my $lc_where_asks = lc_irc $where_asks;
    foreach my $i (0..$#{$channels}) {
        if (lc_irc $channels->[$i] eq $lc_where_asks) {
            splice @{$channels}, $i, 1;
            return 1;
        }
    }
    return 0;
}

sub on_channels(@) {
    return @_ == 1 ? "on the channel $_[0]" : "on the channels " . show_list(@_);
}

our %show_how_quit = (
    disappeared => sub {
        return "they disappeared.  No more information is available.";
    },
    was_left => sub {
        my ($true_channel, $where_asks, $can_show) = @_;
        my $channel = only_public $true_channel, $can_show;
        return
          defined $channel ?
            lc_irc $channel eq lc_irc $where_asks ?
              "byla here i wtedy stad wyszedlem." :
              "byla na kanale $channel, z ktorego wtedy wyszedlem." :
            "byla na kanale, z ktorego wtedy wyszedlem.";
    },
    left => sub {
        my ($true_channel, $reason, $where_asks, $can_show) = @_;
        my $channel = only_public $true_channel, $can_show;
        return
          (defined $channel ?
            lc_irc $channel eq lc_irc $where_asks ?
              "person left" : "they left the channel $channel" :
            "left because") .
          show_reason($reason);
    },
    quit => sub {
        my ($true_channels, $reason, $where_asks, $can_show) = @_;
        my @channels = only_public split(/,/, $true_channels), $can_show;
        my $is_here = is_here @channels, $where_asks;
        return
          (@channels == 0 ?
            $is_here ? "they left " : "" :
            ($is_here ? "byla tutaj oraz " : "they were seen quitting ") .
            on_channels(@channels) .
            " ") .
          "with the message" . show_reason($reason);
    },
    was_kicked => sub {
        my ($true_channel, $kicker, $reason, $where_asks, $can_show) = @_;
        my $channel = only_public $true_channel, $can_show;
        return
          "they " .
          (defined $channel ?
            lc_irc $channel eq lc_irc $where_asks ?
              "were kicked" : "were kicked from $channel" :
            "kicked") .
          " by $kicker" . show_reason($reason);
    },
);

sub show_how_quit($$$) {
    my ($how_quit, $where_asks, $can_show) = @_;
    return $show_how_quit{$how_quit->[0]}
      (@{$how_quit}[1..$#{$how_quit}], $where_asks, $can_show);
}

sub show_where_is($$$$$$$) {
    my ($server, $nick, $address, $where_asks, $can_show, $asked_and, $spoke_and) = @_;
    my $chatnet = lc $server->{chatnet};
    my $lc_nick = lc_irc $nick;
    my @nicks = @{$nicks{$chatnet}{$address}};
    @nicks = sort @nicks;
    my @channels = all_channels($chatnet, @nicks);
    @channels =
      only_public
      map ({mark_private($server->channel_find($_), $_)} sort @channels),
      $can_show;
    my $is_here = is_here @channels, $where_asks;
    my $this_nick_absent = $nick_absent{$chatnet}{$lc_nick};
    return
      (defined $this_nick_absent ?
        "Osoba, ktora uzywala nicka $nick " .
        show_time_since($this_nick_absent) .
        ", $asked_and${spoke_and}teraz jest jako " .
        show_list(@nicks) .
        " " :
        "Queried user $asked_and${spoke_and}$nick is currently " .
        (@nicks == 1 ? "" : "(rowniez jako " .
          show_list(grep {lc_irc $_ ne $lc_nick} @nicks) . ") ")) .
      (@channels == 0 ?
        $is_here ? "in this channel" : "on IRC" :
        ($is_here ? "here on " : "") . on_channels(@channels)) .
      ".";
}

sub seen($$$$$$) {
    my ($server, $nick, $who_asks, $where_asks, $can_show, $asked) = @_;
    my $chatnet = lc $server->{chatnet};
    my $lc_nick = lc_irc $nick;
    my $address = $addresses{$chatnet}{$lc_nick};
    unless (defined $address) {
        if (defined $asked) {return "You asked- $asked about $nick.", 0, 0}
        return "Sorry, I don't know of $nick.", 0, 0;
    }
    $nick = $orig_nick{$chatnet}{$lc_nick};
    if ($address eq canonical $server->{userhost}) {
        return "I am $nick!", 1, 0;
    }
    if (defined $who_asks && $address eq $who_asks) {
        return "You are $nick!", 1, 0;
    }
    my $asked_and = defined $asked ? "$asked; " : "";
    my $spoke = $spoke{$chatnet}{$address};
    my $spoke_and = defined $spoke ?
      "last spoke " . show_time_since($spoke) . ".  " : "";
    if (defined $address_absent{$chatnet}{$address}) {
        my $last_nick = $last_nicks{$chatnet}{$address};
        my $when_address = show_time_since $address_absent{$chatnet}{$address};
        if (lc_irc $last_nick eq $lc_nick) {
            return "The person with the nick $nick $asked_and$spoke_and$when_address " .
              show_how_quit($how_quit{$chatnet}{$address},
                            $where_asks, $can_show), 1, 1;
        } else {
            my $when_nick = show_time_since $nick_absent{$chatnet}{$lc_nick};
            return "Person, who $when_nick used nick $nick, " .
              "$asked_and$spoke_and$when_address jako $last_nick " .
              show_how_quit($how_quit{$chatnet}{$address},
                            $where_asks, $can_show), 1, 1;
        }
    } else {
        return show_where_is($server, $nick, $address,
                             $where_asks, $can_show,
                             $asked_and, $spoke_and), 1, 0;
    }
}

######## Initialization ########

read_database;
expire_database;
initialize_database;
write_database;

Irssi::timeout_add 60*60*1000, sub {expire_database; write_database}, undef;

######## Irssi signal handlers ########

sub can_show_this_channel($) {
    my ($channel) = @_;
    my $lc_channel = lc_irc $channel;
    return sub {lc_irc $_[0] eq $lc_channel};
}

sub can_show_his_channels($$) {
    my ($chatnet, $nick) = @_;
    my $lc_nick = lc_irc $nick;
    my @channels = $channels{$chatnet}{$lc_nick} ?
      @{$channels{$chatnet}{$lc_nick}} : ();
    return sub {
        my $channel = lc_irc $_[0];
        return grep {lc_irc $_ eq $channel} @channels;
    };
}

sub check_asked($$$) {
    my ($chatnet, $server, $nick) = @_;
    my $lc_nick = lc_irc $nick;
    my $who_asked = $asked{$chatnet}{$lc_nick};
    return unless $who_asked;
    foreach my $nick_asked (sort {$who_asked->{$a} <=> $who_asked->{$b}}
                            keys %{$who_asked}) {
        my $when_asked = show_time_since $who_asked->{$nick_asked};
        my ($reply, $found, $remember_asked) =
          seen $server, $nick_asked, undef, undef,
          can_show_his_channels($chatnet, $nick),
          "szukala Cie $when_asked";
        $server->command("notice $nick $reply");
        do_forget_ask $chatnet, $nick, $nick_asked;
        append_to_database "forget_ask $chatnet $nick $nick_asked";
    }
}

Irssi::signal_add "channel wholist", sub {
    my ($channel) = @_;
    my $server = $channel->{server};
    my $chatnet = lc $server->{chatnet};
    foreach my $nick ($channel->nicks()) {
        my $lc_nick = lc_irc $nick->{nick};
        my $lc_channel = lc_irc $channel->{name};
        on_join $chatnet, canonical $nick->{host}, $nick->{nick}, $channel->{name}
          unless $nick->{host} eq "" ||
          $channels{$chatnet}{$lc_nick} &&
          grep {lc_irc $_ eq $lc_channel} @{$channels{$chatnet}{$lc_nick}};
        check_asked $chatnet, $server, $nick->{nick};
    }
};

Irssi::signal_add_first "channel destroyed", sub {
    my ($channel) = @_;
    my $chatnet = lc $channel->{server}{chatnet};
    foreach my $nick ($channel->nicks()) {
        on_part $chatnet, canonical $nick->{host}, $nick->{nick}, $channel->{name},
          ['was_left', mark_private($channel, $channel->{name})]
          unless $nick->{host} eq "";
    }
};

Irssi::signal_add "event join", sub {
    my ($server, $args, $nick, $address) = @_;
    $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
    my $channel = $1;
    my $chatnet = lc $server->{chatnet};
    on_join $chatnet, canonical $address, $nick, $channel;
    check_asked $chatnet, $server, $nick;
};

Irssi::signal_add "event part", sub {
    my ($server, $args, $nick, $address) = @_;
    $args =~ /^([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+)$/ or $args =~ /^([^ ]+)()$/ or return;
    my ($channel, $reason) = ($1, $2);
    my $chatnet = lc $server->{chatnet};
    return if defined $nick_absent{$chatnet}{lc_irc $nick};
    $reason = "" if $reason eq $nick;
    on_part $chatnet, canonical $address, $nick, $channel,
      ['left', mark_private($server->channel_find($channel), $channel), $reason];
};

Irssi::signal_add "event quit", sub {
    my ($server, $args, $nick, $address) = @_;
    $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or $args =~ /^()$/ or return;
    my $reason = $1;
    my $chatnet = lc $server->{chatnet};
    my $lc_nick = lc_irc $nick;
    return if defined $nick_absent{$chatnet}{$lc_nick};
    $reason = "" if $reason =~ /^(Quit: )?(leaving)?$/;
    my @channels = $channels{$chatnet}{$lc_nick} ?
      @{$channels{$chatnet}{$lc_nick}} : ();
    on_quit $chatnet, canonical $address, $nick,
      ['quit', join(",", map {mark_private($server->channel_find($_), $_)} sort @channels), $reason];
};

Irssi::signal_add "event kick", sub {
    my ($server, $args, $kicker, $kicker_address) = @_;
    $args =~ /^([^ ]+) +([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+) +([^ ]+)$/ or
      $args =~ /^([^ ]+) +([^ ]+)()$/ or return;
    my ($channel, $nick, $reason) = ($1, $2, $3);
    my $chatnet = lc $server->{chatnet};
    $reason = "" if $reason eq $kicker;
    on_part $chatnet, $addresses{$chatnet}{lc_irc $nick}, $nick, $channel,
      ['was_kicked', mark_private($server->channel_find($channel), $channel), $kicker, $reason];
};

Irssi::signal_add "event nick", sub {
    my ($server, $args, $old_nick, $address) = @_;
    $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
    my $new_nick = $1;
    return if $address eq "";
    my $chatnet = lc $server->{chatnet};
    on_nick $chatnet, canonical $address, $old_nick, $new_nick;
    check_asked $chatnet, $server, $new_nick;
};

######## Commands ########

Irssi::command_bind "seen", sub {
    my ($args, $server, $target) = @_;
    my $nick;
    if ($args =~ /^ *([^ ]+) *$/) {
        $nick = $1;
    } else {
        Irssi::print "Usage: /seen <nick>";
        return;
    }
    unless ($server && $server->{connected}) {
        Irssi::print "Not connected to server";
        return;
    }
    my ($reply, $found, $remember_asked) =
      seen $server, $nick, undef, undef, sub {1}, undef;
    Irssi::print $reply;
};

Irssi::command_bind "say_seen", sub {
    my ($args, $server, $target) = @_;
    my $chatnet = lc $server->{chatnet};
    my ($nick_asks, $prefix, $nick);
    if ($args =~ /^ *([^ ]+) *$/) {
        $nick_asks = undef;
        $prefix = "";
        $nick = $1;
    } elsif ($args =~ /^ *([^ ]+) +([^ ]+) *$/) {
        $nick_asks = $1;
        $prefix = "$1: ";
        $nick = $2;
    } else {
        Irssi::print "Usage: /say_seen [<to_whom>] <nick>";
        return;
    }
    unless ($server && $server->{connected}) {
        Irssi::print "Not connected to server";
        return;
    }
    unless ($target) {
        Irssi::print "Not in a channel or query";
        return;
    }
    my $can_show =
      $target->{type} eq 'CHANNEL' ?
        can_show_this_channel($target->{name}) :
      $target->{type} eq 'QUERY' ?
        can_show_his_channels($chatnet, $target->{name}) :
      sub {0};
    my ($reply, $found, $remember_asked) =
      seen $server, $nick, undef, $target->{name}, $can_show, undef;
    on_ask $chatnet, $nick, $nick_asks
      if defined $nick_asks && $remember_asked;
    $server->command("msg $target->{name} $prefix$reply");
};

sub cmd_listen_switch($$$$) {
    my ($state, $args, $server, $target) = @_;
    if ($args =~ /^ *$/) {
        unless ($server && $server->{connected}) {
            Irssi::print "Not connected to server";
            return;
        }
        unless ($target && $target->{type} eq 'CHANNEL') {
            Irssi::print "Not in a channel";
            return;
        }
        on_listen lc $server->{chatnet}, lc_irc $target->{name}, $state;
    } elsif ($args =~ /^ *([^ ]+) *$/)
    {
        unless ($server && $server->{connected}) {
            Irssi::print "Not connected to server";
            return;
        }
        on_listen lc $server->{chatnet}, lc_irc $1, $state;
    } elsif ($args =~ /^ *([^ ]+) +([^ ]+) *$/)
    {
        on_listen lc $1, lc_irc $2, $state;
    } else {
        Irssi::print "Usage: /listen $state [[<chatnet>] <channel>]";
    }
}

Irssi::command_bind "listen", sub {
    my ($args, $server, $target) = @_;
    Irssi::command_runsub "listen", $args, $server, $target;
};

Irssi::command_bind "listen on", sub {
    my ($args, $server, $target) = @_;
    cmd_listen_switch "on", $args, $server, $target;
};

Irssi::command_bind "listen off", sub {
    my ($args, $server, $target) = @_;
    cmd_listen_switch "off", $args, $server, $target;
};

Irssi::command_bind "listen delay", sub {
    my ($args, $server, $target) = @_;
    cmd_listen_switch "delay", $args, $server, $target;
};

Irssi::command_bind "listen private", sub {
    my ($args, $server, $target) = @_;
    cmd_listen_switch "private", $args, $server, $target;
};

Irssi::command_bind "listen disable", sub {
    my ($args, $server, $target) = @_;
    cmd_listen_switch "disable", $args, $server, $target;
};

our @joined_text = ("      ", "joined");

Irssi::command_bind "listen list", sub {
    my ($args, $server, $target) = @_;
    if ($args =~ /^ *$/) {
        my %all_channels = ();
        foreach my $server (Irssi::servers()) {
            my $chatnet = lc $server->{chatnet};
            foreach my $channel ($server->channels()) {
                $all_channels{$chatnet}{lc_irc $channel->{name}}[0] = 1;
            }
        }
        foreach my $chatnet (keys %listen_on) {
            foreach my $channel (keys %{$listen_on{$chatnet}}) {
                $all_channels{$chatnet}{$channel}[1] = $listen_on{$chatnet}{$channel};
            }
        }
        my $max_chatnet_width = 1;
        my $max_channel_width = 1;
        foreach my $chatnet (keys %all_channels) {
            $max_chatnet_width = length $chatnet
              if length $chatnet > $max_chatnet_width;
            foreach my $channel (keys %{$all_channels{$chatnet}}) {
                $max_channel_width = length $channel
                  if length $channel > $max_channel_width;
            }
        }
        Irssi::print "'seen' is listening:";
        foreach my $chatnet (sort keys %all_channels) {
            foreach my $channel (sort keys %{$all_channels{$chatnet}}) {
                Irssi::print
                  $chatnet .
                  " " x ($max_chatnet_width - length ($chatnet) + 1) .
                  $channel .
                  " " x ($max_channel_width - length ($channel) + 3) .
                  $joined_text[$all_channels{$chatnet}{$channel}[0]] .
                  "   " .
                  $all_channels{$chatnet}{$channel}[1];
            }
        }
    } else {
        Irssi::print "Usage: /listen list";
    }
};

Irssi::command_bind "forget", sub {
    my ($args, $server, $target) = @_;
    my $nick;
    if ($args =~ /^ *([^ ]+) *$/) {
        $nick = $1;
    } else {
        Irssi::print "Usage: /forget <nick>";
        return;
    }
    unless ($server) {
        Irssi::print "Not connected to server";
        return;
    }
    my $chatnet = lc $server->{chatnet};
    return unless $asked{$chatnet}{$nick};
    foreach my $nick_asked (keys %{$asked{$chatnet}{$nick}}) {
        do_forget_ask $chatnet, $nick, $nick_asked;
        append_to_database "forget_ask $chatnet $nick $nick_asked";
    }
};

######## Listen to seen requests from other people ########

our $last_reply = undef;
our $last_asked = undef;

our %pending_replies = ();

sub seen_reply($$$$$$) {
    my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
    my $chatnet = lc $server->{chatnet};
    my ($reply, $found, $remember_asked) =
      seen $server, $nick, $address, $target,
        can_show_this_channel($target), undef;
    return unless $sure || $found;
    unless ($reply eq $last_reply && $nick eq $last_asked) {
        Irssi::print "[$target] $nick_asks: $reply";
        $server->command("msg $target $nick_asks: $reply");
        $last_reply = $reply;
        $last_asked = $nick;
    }
    on_ask $chatnet, $nick, $nick_asks if $remember_asked;
}

sub private_seen_reply($$$$$$) {
    my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
    my $chatnet = lc $server->{chatnet};
    my ($reply, $found, $remember_asked) =
      seen $server, $nick, $address, undef,
        can_show_his_channels($chatnet, $nick_asks), undef;
    return unless $sure || $found;
    $server->command("notice $nick_asks $reply");
    $server->command("notice $nick_asks " .
      "Pytac o obecnosc ludzi mozesz mnie tez prywatnie, np. /msg $server->{nick} seen $nick");
    on_ask $chatnet, $nick, $nick_asks if $remember_asked;
}

sub delayed_seen_reply($$$$$$) {
    my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
    my $chatnet = lc $server->{chatnet};
    my $lc_nick = lc_irc $nick;
    return if defined $pending_replies{$chatnet}{$target}{$lc_nick};
    my $timeout = Irssi::settings_get_int("seen_delay") * 1000;
    $pending_replies{$chatnet}{$target}{$lc_nick} = Irssi::timeout_add_once $timeout, sub {
        delete $pending_replies{$chatnet}{$target}{$lc_nick};
        seen_reply $server, $nick_asks, $address, $target, $nick, $sure;
    }, undef;
}

our %reply_method = (
    on => \&seen_reply,
    off => undef,
    delay => \&delayed_seen_reply,
    private => \&private_seen_reply,
    disable => undef,
);

sub check_another_seen($$$$) {
    my ($chatnet, $channel, $msg, $nick_asks) = @_;
    my $lc_channel = lc_irc $channel;
    if ($listen_on{$chatnet}{$lc_channel} eq 'delay') {
        foreach my $nick (keys %{$pending_replies{$chatnet}{$channel}}) {
            my $nick_regexp = lc_irc_regexp $nick;
            if ($msg =~ /(^|[ \cb])$nick_regexp($|[ !,.:;?\cb])/ ||
                lc_irc $nick_asks eq $nick) {
                my $tag = $pending_replies{$chatnet}{$channel}{$nick};
                Irssi::timeout_remove $tag;
                delete $pending_replies{$chatnet}{$channel}{$nick};
            }
        }
    }
}

Irssi::signal_add "message public", sub {
    my ($server, $msg, $nick_asks, $address, $channel) = @_;
    my $chatnet = lc $server->{chatnet};
    $address = canonical $address;
    on_spoke $chatnet, $address;
    my $lc_channel = lc_irc $channel;
    my ($msg_body, $func) =
      $msg =~ /^\Q$server->{nick}\E(?:|:|\cb:\cb) +(.*)$/i ? ($1, \&seen_reply) :
      ($msg, $reply_method{$listen_on{$chatnet}{$lc_channel} || 'off'});
    if (defined $func) {
        my $sure =
          $msg_body =~ $seen_regexp ? 1 :
          $msg_body =~ $maybe_seen_regexp1 ||
          $msg_body =~ $maybe_seen_regexp2 ? 0 :
          undef;
        if (defined $sure) {
            my $nick = $1;
            return if $sure == 0 && $nick =~ $exclude_regexp;
            Irssi::signal_continue @_;
            $func->($server, $nick_asks, $address, $channel, $nick, $sure);
            return;
        }
    }
    check_another_seen $chatnet, $channel, $msg, $nick_asks;
};

Irssi::signal_add "message irc notice", sub {
    my ($server, $msg, $nick_asks, $address, $target) = @_;
    my $chatnet = lc $server->{chatnet};
    check_another_seen $chatnet, $target, $msg, $nick_asks;
};

Irssi::signal_add "message private", sub {
    my ($server, $msg, $nick_asks, $address) = @_;
    my $chatnet = lc $server->{chatnet};
    on_spoke $chatnet, canonical $address;
    check_asked $chatnet, $server, $nick_asks;
    my $sure =
      $msg =~ $seen_regexp ? 1 :
      $msg =~ $maybe_seen_regexp1 ||
      $msg =~ $maybe_seen_regexp2 ? 0 :
      undef;
    if (defined $sure) {
        my $nick = $1;
        my ($reply, $found, $remember_asked) =
          seen $server, $nick, canonical $address, undef,
          can_show_his_channels($chatnet, $nick_asks), undef;
        return unless $sure || $found;
        Irssi::signal_continue @_;
        $server->command("msg $nick_asks $reply");
        on_ask $chatnet, $nick, $nick_asks if $remember_asked;
    }
};

Irssi::signal_add "message irc action", sub {
    my ($server, $msg, $nick, $address, $target) = @_;
    on_spoke lc $server->{chatnet}, canonical $address;
};