Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1199 lines (1093 sloc) 39.5 KB
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³ <nick>?", "by³a <nick>?",
# "<nick> jest?", "<nick> by³?", "<nick> by³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[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
(?:in|by[³l]a?)\ +
(?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
($nick_regexp)
(?:\ +(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e))*
\ *\?+\ *$/ix;
our $maybe_seen_regexp2 = qr/
^\ *
(?:a\ +)?
(?:(?:czy|kiedy|gdzie)\ +)?
(?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
($nick_regexp)?\ +
(?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
(?:in|by[³l]a?)
(?:\ +(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e))*
\ *\?+\ *$/ix;
our $exclude_regexp = qr/^(?:kto[¶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;
};