html/seen.pl
1 use strict;
2 use 5.005_62; # for 'our'
3 use Irssi 20020428; # for Irssi::signal_continue
4 use vars qw($VERSION %IRSSI);
5
6 $VERSION = "1.8";
7 %IRSSI = (
8 authors => 'Marcin \'Qrczak\' Kowalczyk',
9 contact => 'qrczak@knm.org.pl',
10 name => 'Seen',
11 description => 'Tell people when other people were online',
12 license => 'GPL',
13 url => 'http://qrnik.knm.org.pl/~qrczak/irssi/seen.pl',
14 );
15
16 ######## User interface ########
17
18 # COMMANDS
19 # ========
20 #
21 # /seen <nick>
22 # Show last seen info about nick.
23 #
24 # /say_seen [<to_whom>] <nick>
25 # Say last seen info about nick in the current window. If to_whom
26 # is present, answer as if that person issued a seen request.
27 #
28 # /listen on [[<chatnet>] <channel>]
29 # Turn on listening for seen requests in the current or given channel.
30 #
31 # /listen off [[<chatnet>] <channel>]
32 # Turn off listening for seen requests in the current or given channel.
33 #
34 # /listen delay [[<chatnet>] <channel>]
35 # Turn on listening for seen requests in the current or given channel.
36 # We will reply only if nobody else replies with a message containing
37 # the given nick (probably a seen reply from another bot) in seen_delay
38 # seconds.
39 #
40 # /listen private [[<chatnet>] <channel>]
41 # Turn on listening for seen requests in the current or given channel.
42 # The reply will be sent as a private notice.
43 #
44 # /listen disable [[<chatnet>] <channel>]
45 # Same as "off", used to distinguish channels where we won't listen
46 # for sure from channels we didn't specify anything about.
47 #
48 # /listen list
49 # Show which channels we are listening for seen requests on.
50
51 # Forms of seen requests from other people:
52 # Public message "<our_nick>: seen <nick>".
53 # Public message "seen <nick>" on channels where we are listening.
54 # Private message "seen <nick>".
55 # Any of the above with "!seen" instead of "seen".
56 # Any of the above with a question mark at the end.
57 # Any of the above with "jest <nick>?", "by³ <nick>?", "by³a <nick>?",
58 # "<nick> jest?", "<nick> by³?", "<nick> by³a?", with optional
59 # "czy" at the beginning - provided that we know that nick
60 # (to avoid treating some other message as a seen request).
61
62 # VARIABLES
63 # =========
64 #
65 # seen_expire_after
66 # After that number of days we forget about nicks and addresses.
67 # Default 30.
68 #
69 # seen_expire_asked_after
70 # After that number of days we forget that that somebody was
71 # searched for and don't send a notice. Default 7.
72 #
73 # seen_delay
74 # On channels set to '/listen delay' we reply if after that number
75 # of seconds nobody else replies. Default 60.
76
77 ######## Internal structure of the database in memory ########
78
79 # %listen_on = (chatnet => {channel => listening})
80 # %address_absent = (chatnet => {address => time})
81 # %nicks = (chatnet => {address => [nick]})
82 # %last_nicks = (chatnet => {address => nick})
83 # %how_quit = (chatnet => {address => how_quit})
84 # %spoke = (chatnet => {address => time})
85 # %nick_absent = (chatnet => {nick => time})
86 # %addresses = (chatnet => {nick => address})
87 # %orig_nick = (chatnet => {nick => nick})
88 # %channels = (chatnet => {nick => [channel]})
89 # %asked = (chatnet => {nick => {nick_asks => time}})
90
91 # listening:
92 # 'on', undef = 'off', 'delay', 'private', 'disable'
93
94 # how_quit:
95 # ['disappeared']
96 # ['was_left', kanal]
97 # ['left', channel, reason]
98 # ['quit', channels, reason]
99 # ['was_kicked', channel, kicker, reason]
100
101 ######## Global variables ########
102
103 our %listen_on = ();
104 our %address_absent = ();
105 our %nicks = ();
106 our %last_nicks = ();
107 our %how_quit = ();
108 our %spoke = ();
109 our %nick_absent = ();
110 our %addresses = ();
111 our %orig_nick = ();
112 our %channels = ();
113 our %asked = ();
114
115 Irssi::settings_add_int "seen", "seen_expire_after", 30; # days
116 Irssi::settings_add_int "seen", "seen_expire_asked_after", 7; # days
117 Irssi::settings_add_int "seen", "seen_delay", 60; # seconds
118
119 our $database = Irssi::get_irssi_dir . "/seen.dat";
120 our $database_tmp = Irssi::get_irssi_dir . "/seen.tmp";
121 our $database_old = Irssi::get_irssi_dir . "/seen.dat~";
122
123 ######## Utilities ########
124
125 our $nick_regexp = qr/
126 [A-Z\[\\\]^_`a-z{|}\200-\377]
127 [\-0-9A-Z\[\\\]^_`a-z{|}\200-\377]*
128 /x;
129 our $seen_regexp = qr/^ *!?seen +($nick_regexp) *\?* *$/i;
130 our $maybe_seen_regexp1 = qr/
131 ^\ *
132 (?:a\ +)?
133 (?:(?:if|when|here)\ +)?
134 (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
135 (?:in|by[³l]a?)\ +
136 (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
137 ($nick_regexp)
138 (?:\ +(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e))*
139 \ *\?+\ *$/ix;
140 our $maybe_seen_regexp2 = qr/
141 ^\ *
142 (?:a\ +)?
143 (?:(?:czy|kiedy|gdzie)\ +)?
144 (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
145 ($nick_regexp)?\ +
146 (?:(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e)\ +)*
147 (?:in|by[³l]a?)
148 (?:\ +(?:dzi[¶s]|today|last time|recently|ju[¿z]|here|tutaj|mo[¿z]e))*
149 \ *\?+\ *$/ix;
150 our $exclude_regexp = qr/^(?:kto[¶s]?|who?|that?|that|ladna|i|a)$/i;
151
152 sub lc_irc($) {
153 my ($str) = @_;
154 $str =~ tr/A-Z[\\]/a-z{|}/;
155 return $str;
156 }
157
158 sub uc_irc($) {
159 my ($str) = @_;
160 $str =~ tr/a-z{|}/A-Z[\\]/;
161 return $str;
162 }
163
164 our %lc_regexps = ();
165
166 sub lc_irc_regexp($) {
167 my ($str) = @_;
168 $str =~ s/(.)/my $lc = lc_irc $1; my $uc = uc_irc $1; "[\Q$lc$uc\E]"/eg;
169 return $str;
170 }
171
172 sub canonical($) {
173 my ($address) = @_;
174 $address =~ s/^[\^~+=-]//;
175 return $address;
176 }
177
178 sub show_list(@) {
179 @_ == 0 and return "";
180 @_ == 1 and return $_[0];
181 return join(", ", @_[0..$#_-1]) . " i " . $_[$#_];
182 }
183
184 sub show_time_since($) {
185 my ($time) = @_;
186 my $diff = time() - $time;
187 $diff >= 0 or return "nie wiem kiedy (zegarek mi sie popsul)";
188 my $s = $diff % 60; $diff = int(($diff - $s) / 60);
189 my $m = $diff % 60; $diff = int(($diff - $m) / 60);
190 my $h = $diff % 24; $diff = int(($diff - $h) / 24);
191 my $d = $diff;
192 my $s_txt = $s ? "${s}s " : "";
193 my $m_txt = $m ? "${m}m " : "";
194 my $h_txt = $h ? "${h}h " : "";
195 my $d_txt = $d ? "${d}d " : "";
196 return
197 $d ? "$d_txt${h_txt}ago" :
198 $h ? "$h_txt${m_txt}ago" :
199 $m ? "$m_txt${s_txt}ago" :
200 "${s}s ago";
201 }
202
203 sub all_channels($@) {
204 my ($chatnet, @nicks) = @_;
205 my %chans = ();
206 foreach my $nick (@nicks) {
207 if ($channels{$chatnet}{lc_irc $nick}) {
208 foreach my $channel (@{$channels{$chatnet}{lc_irc $nick}}) {
209 $chans{$channel} = 1;
210 }
211 }
212 }
213 return keys %chans;
214 }
215
216 sub is_private($) {
217 my ($channel) = @_;
218 return $channel && $channel->{mode} =~ /^[^ ]*[ps]/;
219 }
220
221 sub mark_private($$) {
222 my ($channel, $name) = @_;
223 return is_private $channel ? "-$name" : $name;
224 }
225
226 ######## Actions on the database in memory ########
227
228 sub do_listen($$$) {
229 my ($chatnet, $channel, $state) = @_;
230 if ($state eq 'off') {
231 delete $listen_on{$chatnet}{$channel};
232 } else {
233 $listen_on{$chatnet}{$channel} = $state;
234 }
235 }
236
237 sub do_join($$$$) {
238 my ($chatnet, $address, $nick, $channel) = @_;
239 my $lc_nick = lc_irc $nick;
240 my $lc_channel = lc_irc $channel;
241 delete $address_absent{$chatnet}{$address};
242 push @{$nicks{$chatnet}{$address}}, $nick
243 unless grep {lc_irc $_ eq $lc_nick} @{$nicks{$chatnet}{$address}};
244 push @{$channels{$chatnet}{$lc_nick}}, $channel
245 unless grep {lc_irc $_ eq $lc_channel} @{$channels{$chatnet}{$lc_nick}};
246 delete $how_quit{$chatnet}{$address};
247 delete $nick_absent{$chatnet}{$lc_nick};
248 $addresses{$chatnet}{$lc_nick} = $address;
249 $orig_nick{$chatnet}{$lc_nick} = $nick;
250 }
251
252 sub do_quit_all($$$$$) {
253 my ($time, $chatnet, $address, $nick, $reason) = @_;
254 $address_absent{$chatnet}{$address} = $time;
255 delete $nicks{$chatnet}{$address};
256 $last_nicks{$chatnet}{$address} = $nick;
257 $how_quit{$chatnet}{$address} = $reason;
258 }
259
260 sub do_quit($$$$) {
261 my ($time, $chatnet, $address, $nick) = @_;
262 my $lc_nick = lc_irc $nick;
263 $nicks{$chatnet}{$address} =
264 [grep {lc_irc $_ ne $lc_nick} @{$nicks{$chatnet}{$address}}];
265 delete $channels{$chatnet}{$lc_nick};
266 $nick_absent{$chatnet}{$lc_nick} = $time;
267 $addresses{$chatnet}{$lc_nick} = $address;
268 $orig_nick{$chatnet}{$lc_nick} = $nick;
269 }
270
271 sub do_part($$$$) {
272 my ($chatnet, $address, $nick, $channel) = @_;
273 my $lc_nick = lc_irc $nick;
274 my $lc_channel = lc_irc $channel;
275 $channels{$chatnet}{$lc_nick} =
276 [grep {lc_irc $_ ne $lc_channel} @{$channels{$chatnet}{$lc_nick}}];
277 }
278
279 sub do_nick($$$$$) {
280 my ($time, $chatnet, $address, $old_nick, $new_nick) = @_;
281 my $lc_old_nick = lc_irc $old_nick;
282 my $lc_new_nick = lc_irc $new_nick;
283 $nicks{$chatnet}{$address} =
284 [(grep {lc_irc $_ ne $lc_old_nick} @{$nicks{$chatnet}{$address}}), $new_nick];
285 my $chans = $channels{$chatnet}{$lc_old_nick};
286 delete $channels{$chatnet}{$lc_old_nick};
287 $channels{$chatnet}{$lc_new_nick} = $chans;
288 $nick_absent{$chatnet}{$lc_old_nick} = $time;
289 delete $nick_absent{$chatnet}{$lc_new_nick};
290 $addresses{$chatnet}{$lc_new_nick} = $address;
291 $orig_nick{$chatnet}{$lc_new_nick} = $new_nick;
292 }
293
294 sub do_spoke($$$) {
295 my ($time, $chatnet, $address) = @_;
296 my $old_time = $spoke{$chatnet}{$address};
297 $spoke{$chatnet}{$address} = $time
298 unless defined $old_time && $old_time > $time;
299 }
300
301 sub do_ask($$$$) {
302 my ($time, $chatnet, $nick, $nick_asks) = @_;
303 my $lc_nick = lc_irc $nick;
304 my $lc_nick_asks = lc_irc $nick_asks;
305 my $old_time = $asked{$chatnet}{$lc_nick}{$lc_nick_asks};
306 $asked{$chatnet}{$lc_nick}{$lc_nick_asks} = $time
307 unless defined $old_time && $old_time > $time;
308 }
309
310 sub do_forget_ask($$$) {
311 my ($chatnet, $nick, $nick_asks) = @_;
312 my $lc_nick = lc_irc $nick;
313 my $lc_nick_asks = lc_irc $nick_asks;
314 delete $asked{$chatnet}{$lc_nick}{$lc_nick_asks};
315 }
316
317 ######## Actions on the database in memory and in the file ########
318
319 sub append_to_database(@) {
320 open DATABASE, ">>$database";
321 print DATABASE map {"$_\n"} @_;
322 close DATABASE;
323 }
324
325 sub on_listen($$$) {
326 my ($chatnet, $channel, $state) = @_;
327 do_listen $chatnet, $channel, $state;
328 append_to_database "listen $state $chatnet $channel";
329 }
330
331 sub on_join($$$$) {
332 my ($chatnet, $address, $nick, $channel) = @_;
333 do_join $chatnet, $address, $nick, $channel;
334 append_to_database "join $chatnet $address $nick $channel";
335 }
336
337 sub on_quit_all($$$$) {
338 my ($chatnet, $address, $nick, $reason) = @_;
339 my $time = time();
340 do_quit_all $time, $chatnet, $address, $nick, $reason;
341 append_to_database "quit_all $time $chatnet $address $nick @$reason";
342 }
343
344 sub on_quit($$$$) {
345 my ($chatnet, $address, $nick, $reason) = @_;
346 my $time = time();
347 do_quit $time, $chatnet, $address, $nick;
348 append_to_database "quit $time $chatnet $address $nick";
349 on_quit_all $chatnet, $address, $nick, $reason
350 unless @{$nicks{$chatnet}{$address}};
351 }
352
353 sub on_part($$$$$) {
354 my ($chatnet, $address, $nick, $channel, $reason) = @_;
355 do_part $chatnet, $address, $nick, $channel;
356 append_to_database "part $chatnet $address $nick $channel";
357 on_quit $chatnet, $address, $nick, $reason
358 unless @{$channels{$chatnet}{lc_irc $nick}};
359 }
360
361 sub on_nick($$$$) {
362 my ($chatnet, $address, $old_nick, $new_nick) = @_;
363 my $time = time();
364 do_nick $time, $chatnet, $address, $old_nick, $new_nick;
365 append_to_database "nick $time $chatnet $address $old_nick $new_nick";
366 }
367
368 sub on_spoke($$) {
369 my ($chatnet, $address) = @_;
370 my $time = time();
371 return if $spoke{$chatnet}{$address} == $time;
372 do_spoke $time, $chatnet, $address;
373 append_to_database "spoke $time $chatnet $address";
374 }
375
376 sub on_ask($$$) {
377 my ($chatnet, $nick, $nick_asks) = @_;
378 my $time = time();
379 do_ask $time, $chatnet, $nick, $nick_asks;
380 append_to_database "ask $time $chatnet $nick $nick_asks";
381 }
382
383 ######## Reading the database from file ########
384
385 sub syntax_error() {
386 die "Syntax error in $database: $_";
387 }
388
389 our %parse_how_quit = (
390 disappeared => sub {
391 return ['disappeared'];
392 },
393 was_left => sub {
394 $_[0] =~ /^ ([^ ]*)$/ or syntax_error;
395 return ['was_left', $1];
396 },
397 left => sub {
398 $_[0] =~ /^ ([^ ]*) (.*)$/ or syntax_error;
399 return ['left', $1, $2];
400 },
401 quit => sub {
402 $_[0] =~ /^ ([^ ]*) (.*)$/ or syntax_error;
403 return ['quit', $1, $2];
404 },
405 was_kicked => sub {
406 $_[0] =~ /^ ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
407 return ['was_kicked', $1, $2, $3];
408 },
409 );
410
411 sub parse_how_quit($) {
412 my ($how_quit) = @_;
413 $how_quit =~ /^([^ ]*)(| .*)$/ or syntax_error;
414 my $func = $parse_how_quit{$1} or syntax_error;
415 return $func->($2);
416 }
417
418 our %parse_database = (
419 listen => sub {
420 $_[0] =~ /^ (on|off|delay|private|disable) ([^ ]*) ([^ ]*)$/ or syntax_error;
421 do_listen $2, $3, $1;
422 },
423 join => sub {
424 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
425 do_join $1, $2, $3, $4;
426 },
427 quit_all => sub {
428 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) (.*)$/ or syntax_error;
429 my ($time, $chatnet, $address, $nick, $how_quit) = ($1, $2, $3, $4, $5);
430 do_quit_all $time, $chatnet, $address, $nick, parse_how_quit($how_quit);
431 },
432 quit => sub {
433 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
434 do_quit $1, $2, $3, $4;
435 },
436 part => sub {
437 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
438 do_part $1, $2, $3, $4;
439 },
440 nick => sub {
441 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
442 do_nick $1, $2, $3, $4, $5;
443 },
444 spoke => sub {
445 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
446 do_spoke $1, $2, $3;
447 },
448 ask => sub {
449 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
450 do_ask $1, $2, $3, $4;
451 },
452 forget_ask => sub {
453 $_[0] =~ /^ ([^ ]*) ([^ ]*) ([^ ]*)$/ or syntax_error;
454 do_forget_ask $1, $2, $3;
455 },
456 );
457
458 sub read_database() {
459 open DATABASE, $database or return;
460 while (<DATABASE>) {
461 chomp;
462 /^([^ ]*)(| .*)$/ or syntax_error;
463 my $func = $parse_database{$1} or syntax_error;
464 $func->($2);
465 }
466 close DATABASE;
467 }
468
469 ######## Writing the database to file ########
470
471 sub write_database {
472 open DATABASE, ">$database_tmp";
473 foreach my $chatnet (keys %listen_on) {
474 foreach my $channel (keys %{$listen_on{$chatnet}}) {
475 my $state = $listen_on{$chatnet}{$channel};
476 print DATABASE "listen $state $chatnet $channel\n";
477 }
478 }
479 foreach my $chatnet (keys %nick_absent) {
480 foreach my $nick (keys %{$nick_absent{$chatnet}}) {
481 my $time = $nick_absent{$chatnet}{$nick};
482 my $address = $addresses{$chatnet}{$nick};
483 my $orig = $orig_nick{$chatnet}{$nick};
484 print DATABASE "quit $time $chatnet $address $orig\n";
485 }
486 }
487 foreach my $chatnet (keys %address_absent) {
488 foreach my $address (keys %{$address_absent{$chatnet}}) {
489 my $time = $address_absent{$chatnet}{$address};
490 my $nick = $last_nicks{$chatnet}{$address};
491 my $reason = $how_quit{$chatnet}{$address};
492 print DATABASE "quit_all $time $chatnet $address $nick @$reason\n";
493 }
494 }
495 foreach my $chatnet (keys %spoke) {
496 foreach my $address (keys %{$spoke{$chatnet}}) {
497 my $time = $spoke{$chatnet}{$address};
498 print DATABASE "spoke $time $chatnet $address\n";
499 }
500 }
501 foreach my $chatnet (keys %nicks) {
502 foreach my $address (keys %{$nicks{$chatnet}}) {
503 foreach my $nick (@{$nicks{$chatnet}{$address}}) {
504 foreach my $channel (@{$channels{$chatnet}{lc_irc $nick}}) {
505 print DATABASE "join $chatnet $address $nick $channel\n";
506 }
507 }
508 }
509 }
510 foreach my $chatnet (keys %asked) {
511 foreach my $nick (keys %{$asked{$chatnet}}) {
512 foreach my $nick_asked (keys %{$asked{$chatnet}{$nick}}) {
513 my $time = $asked{$chatnet}{$nick}{$nick_asked};
514 print DATABASE "ask $time $chatnet $nick $nick_asked\n";
515 }
516 }
517 }
518 close DATABASE;
519 rename $database, $database_old;
520 rename $database_tmp, $database;
521 }
522
523 ######## Update the database to reflect currently joined users ########
524
525 sub initialize_database() {
526 my $time = time();
527 foreach my $chatnet (keys %nicks) {
528 my @addresses = keys %{$nicks{$chatnet}};
529 foreach my $address (@addresses) {
530 my @nicks = @{$nicks{$chatnet}{$address}};
531 foreach my $nick (@nicks) {
532 do_quit $time, $chatnet, $address, $nick;
533 }
534 do_quit_all $time, $chatnet, $address, $nicks[0], ['disappeared'];
535 }
536 }
537 foreach my $server (Irssi::servers()) {
538 foreach my $channel ($server->channels()) {
539 foreach my $nick ($channel->nicks()) {
540 do_join lc $server->{chatnet},
541 canonical $nick->{host}, $nick->{nick}, $channel->{name}
542 if $nick->{host} ne "";
543 }
544 }
545 }
546 }
547
548 ######## Expire old entries ########
549
550 sub expire_database() {
551 my $days = Irssi::settings_get_int("seen_expire_after");
552 my $time = time() - $days*24*60*60;
553 my %reachable_addresses = ();
554 foreach my $chatnet (keys %addresses) {
555 foreach my $address (values %{$addresses{$chatnet}}) {
556 $reachable_addresses{$chatnet}{$address} = 1;
557 }
558 }
559 foreach my $chatnet (keys %address_absent) {
560 foreach my $address (keys %{$address_absent{$chatnet}}) {
561 if ($address_absent{$chatnet}{$address} <= $time ||
562 !$reachable_addresses{$chatnet}{$address}) {
563 delete $address_absent{$chatnet}{$address};
564 delete $last_nicks{$chatnet}{$address};
565 delete $how_quit{$chatnet}{$address};
566 }
567 }
568 }
569 foreach my $chatnet (keys %spoke) {
570 foreach my $address (keys %{$spoke{$chatnet}}) {
571 if ($spoke{$chatnet}{$address} <= $time ||
572 !$reachable_addresses{$chatnet}{$address}) {
573 delete $spoke{$chatnet}{$address};
574 }
575 }
576 }
577 foreach my $chatnet (keys %nick_absent) {
578 foreach my $nick (keys %{$nick_absent{$chatnet}}) {
579 if ($nick_absent{$chatnet}{$nick} <= $time) {
580 delete $nick_absent{$chatnet}{$nick};
581 delete $addresses{$chatnet}{$nick};
582 delete $orig_nick{$chatnet}{$nick};
583 }
584 }
585 }
586 my $days_asked = Irssi::settings_get_int("seen_expire_asked_after");
587 my $time_asked = time() - $days_asked*24*60*60;
588 foreach my $chatnet (keys %asked) {
589 foreach my $nick (keys %{$asked{$chatnet}}) {
590 foreach my $nick_asks (keys %{$asked{$chatnet}{$nick}}) {
591 if ($asked{$chatnet}{$nick}{$nick_asks} <= $time_asked) {
592 delete $asked{$chatnet}{$nick}{$nick_asks};
593 }
594 }
595 }
596 }
597 }
598
599 ######## Compose a description when did we see that person ########
600
601 sub show_reason($) {
602 my ($reason) = @_;
603 return ":" if $reason eq "";
604 $reason =~ s/\cc\d\d?(,\d\d?)?|[\000-\037]//g;
605 return ": $reason";
606 }
607
608 sub only_public(@$) {
609 my $can_show = pop @_;
610 my @channels = ();
611 foreach my $channel (@_) {
612 if ($channel =~ /^-(.*)$/) {
613 push @channels, $1 if $can_show->($1);
614 } else {
615 push @channels, $channel;
616 }
617 }
618 return wantarray ? @channels : $channels[0];
619 }
620
621 sub is_here(\@$) {
622 my ($channels, $where_asks) = @_;
623 return if !defined $where_asks;
624 my $lc_where_asks = lc_irc $where_asks;
625 foreach my $i (0..$#{$channels}) {
626 if (lc_irc $channels->[$i] eq $lc_where_asks) {
627 splice @{$channels}, $i, 1;
628 return 1;
629 }
630 }
631 return 0;
632 }
633
634 sub on_channels(@) {
635 return @_ == 1 ? "on the channel $_[0]" : "on the channels " . show_list(@_);
636 }
637
638 our %show_how_quit = (
639 disappeared => sub {
640 return "they disappeared. No more information is available.";
641 },
642 was_left => sub {
643 my ($true_channel, $where_asks, $can_show) = @_;
644 my $channel = only_public $true_channel, $can_show;
645 return
646 defined $channel ?
647 lc_irc $channel eq lc_irc $where_asks ?
648 "byla here i wtedy stad wyszedlem." :
649 "byla na kanale $channel, z ktorego wtedy wyszedlem." :
650 "byla na kanale, z ktorego wtedy wyszedlem.";
651 },
652 left => sub {
653 my ($true_channel, $reason, $where_asks, $can_show) = @_;
654 my $channel = only_public $true_channel, $can_show;
655 return
656 (defined $channel ?
657 lc_irc $channel eq lc_irc $where_asks ?
658 "person left" : "they left the channel $channel" :
659 "left because") .
660 show_reason($reason);
661 },
662 quit => sub {
663 my ($true_channels, $reason, $where_asks, $can_show) = @_;
664 my @channels = only_public split(/,/, $true_channels), $can_show;
665 my $is_here = is_here @channels, $where_asks;
666 return
667 (@channels == 0 ?
668 $is_here ? "they left " : "" :
669 ($is_here ? "byla tutaj oraz " : "they were seen quitting ") .
670 on_channels(@channels) .
671 " ") .
672 "with the message" . show_reason($reason);
673 },
674 was_kicked => sub {
675 my ($true_channel, $kicker, $reason, $where_asks, $can_show) = @_;
676 my $channel = only_public $true_channel, $can_show;
677 return
678 "they " .
679 (defined $channel ?
680 lc_irc $channel eq lc_irc $where_asks ?
681 "were kicked" : "were kicked from $channel" :
682 "kicked") .
683 " by $kicker" . show_reason($reason);
684 },
685 );
686
687 sub show_how_quit($$$) {
688 my ($how_quit, $where_asks, $can_show) = @_;
689 return $show_how_quit{$how_quit->[0]}
690 (@{$how_quit}[1..$#{$how_quit}], $where_asks, $can_show);
691 }
692
693 sub show_where_is($$$$$$$) {
694 my ($server, $nick, $address, $where_asks, $can_show, $asked_and, $spoke_and) = @_;
695 my $chatnet = lc $server->{chatnet};
696 my $lc_nick = lc_irc $nick;
697 my @nicks = @{$nicks{$chatnet}{$address}};
698 @nicks = sort @nicks;
699 my @channels = all_channels($chatnet, @nicks);
700 @channels =
701 only_public
702 map ({mark_private($server->channel_find($_), $_)} sort @channels),
703 $can_show;
704 my $is_here = is_here @channels, $where_asks;
705 my $this_nick_absent = $nick_absent{$chatnet}{$lc_nick};
706 return
707 (defined $this_nick_absent ?
708 "Osoba, ktora uzywala nicka $nick " .
709 show_time_since($this_nick_absent) .
710 ", $asked_and${spoke_and}teraz jest jako " .
711 show_list(@nicks) .
712 " " :
713 "Queried user $asked_and${spoke_and}$nick is currently " .
714 (@nicks == 1 ? "" : "(rowniez jako " .
715 show_list(grep {lc_irc $_ ne $lc_nick} @nicks) . ") ")) .
716 (@channels == 0 ?
717 $is_here ? "in this channel" : "on IRC" :
718 ($is_here ? "here on " : "") . on_channels(@channels)) .
719 ".";
720 }
721
722 sub seen($$$$$$) {
723 my ($server, $nick, $who_asks, $where_asks, $can_show, $asked) = @_;
724 my $chatnet = lc $server->{chatnet};
725 my $lc_nick = lc_irc $nick;
726 my $address = $addresses{$chatnet}{$lc_nick};
727 unless (defined $address) {
728 if (defined $asked) {return "You asked- $asked about $nick.", 0, 0}
729 return "Sorry, I don't know of $nick.", 0, 0;
730 }
731 $nick = $orig_nick{$chatnet}{$lc_nick};
732 if ($address eq canonical $server->{userhost}) {
733 return "I am $nick!", 1, 0;
734 }
735 if (defined $who_asks && $address eq $who_asks) {
736 return "You are $nick!", 1, 0;
737 }
738 my $asked_and = defined $asked ? "$asked; " : "";
739 my $spoke = $spoke{$chatnet}{$address};
740 my $spoke_and = defined $spoke ?
741 "last spoke " . show_time_since($spoke) . ". " : "";
742 if (defined $address_absent{$chatnet}{$address}) {
743 my $last_nick = $last_nicks{$chatnet}{$address};
744 my $when_address = show_time_since $address_absent{$chatnet}{$address};
745 if (lc_irc $last_nick eq $lc_nick) {
746 return "The person with the nick $nick $asked_and$spoke_and$when_address " .
747 show_how_quit($how_quit{$chatnet}{$address},
748 $where_asks, $can_show), 1, 1;
749 } else {
750 my $when_nick = show_time_since $nick_absent{$chatnet}{$lc_nick};
751 return "Person, who $when_nick used nick $nick, " .
752 "$asked_and$spoke_and$when_address jako $last_nick " .
753 show_how_quit($how_quit{$chatnet}{$address},
754 $where_asks, $can_show), 1, 1;
755 }
756 } else {
757 return show_where_is($server, $nick, $address,
758 $where_asks, $can_show,
759 $asked_and, $spoke_and), 1, 0;
760 }
761 }
762
763 ######## Initialization ########
764
765 read_database;
766 expire_database;
767 initialize_database;
768 write_database;
769
770 Irssi::timeout_add 60*60*1000, sub {expire_database; write_database}, undef;
771
772 ######## Irssi signal handlers ########
773
774 sub can_show_this_channel($) {
775 my ($channel) = @_;
776 my $lc_channel = lc_irc $channel;
777 return sub {lc_irc $_[0] eq $lc_channel};
778 }
779
780 sub can_show_his_channels($$) {
781 my ($chatnet, $nick) = @_;
782 my $lc_nick = lc_irc $nick;
783 my @channels = $channels{$chatnet}{$lc_nick} ?
784 @{$channels{$chatnet}{$lc_nick}} : ();
785 return sub {
786 my $channel = lc_irc $_[0];
787 return grep {lc_irc $_ eq $channel} @channels;
788 };
789 }
790
791 sub check_asked($$$) {
792 my ($chatnet, $server, $nick) = @_;
793 my $lc_nick = lc_irc $nick;
794 my $who_asked = $asked{$chatnet}{$lc_nick};
795 return unless $who_asked;
796 foreach my $nick_asked (sort {$who_asked->{$a} <=> $who_asked->{$b}}
797 keys %{$who_asked}) {
798 my $when_asked = show_time_since $who_asked->{$nick_asked};
799 my ($reply, $found, $remember_asked) =
800 seen $server, $nick_asked, undef, undef,
801 can_show_his_channels($chatnet, $nick),
802 "szukala Cie $when_asked";
803 $server->command("notice $nick $reply");
804 do_forget_ask $chatnet, $nick, $nick_asked;
805 append_to_database "forget_ask $chatnet $nick $nick_asked";
806 }
807 }
808
809 Irssi::signal_add "channel wholist", sub {
810 my ($channel) = @_;
811 my $server = $channel->{server};
812 my $chatnet = lc $server->{chatnet};
813 foreach my $nick ($channel->nicks()) {
814 my $lc_nick = lc_irc $nick->{nick};
815 my $lc_channel = lc_irc $channel->{name};
816 on_join $chatnet, canonical $nick->{host}, $nick->{nick}, $channel->{name}
817 unless $nick->{host} eq "" ||
818 $channels{$chatnet}{$lc_nick} &&
819 grep {lc_irc $_ eq $lc_channel} @{$channels{$chatnet}{$lc_nick}};
820 check_asked $chatnet, $server, $nick->{nick};
821 }
822 };
823
824 Irssi::signal_add_first "channel destroyed", sub {
825 my ($channel) = @_;
826 my $chatnet = lc $channel->{server}{chatnet};
827 foreach my $nick ($channel->nicks()) {
828 on_part $chatnet, canonical $nick->{host}, $nick->{nick}, $channel->{name},
829 ['was_left', mark_private($channel, $channel->{name})]
830 unless $nick->{host} eq "";
831 }
832 };
833
834 Irssi::signal_add "event join", sub {
835 my ($server, $args, $nick, $address) = @_;
836 $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
837 my $channel = $1;
838 my $chatnet = lc $server->{chatnet};
839 on_join $chatnet, canonical $address, $nick, $channel;
840 check_asked $chatnet, $server, $nick;
841 };
842
843 Irssi::signal_add "event part", sub {
844 my ($server, $args, $nick, $address) = @_;
845 $args =~ /^([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+)$/ or $args =~ /^([^ ]+)()$/ or return;
846 my ($channel, $reason) = ($1, $2);
847 my $chatnet = lc $server->{chatnet};
848 return if defined $nick_absent{$chatnet}{lc_irc $nick};
849 $reason = "" if $reason eq $nick;
850 on_part $chatnet, canonical $address, $nick, $channel,
851 ['left', mark_private($server->channel_find($channel), $channel), $reason];
852 };
853
854 Irssi::signal_add "event quit", sub {
855 my ($server, $args, $nick, $address) = @_;
856 $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or $args =~ /^()$/ or return;
857 my $reason = $1;
858 my $chatnet = lc $server->{chatnet};
859 my $lc_nick = lc_irc $nick;
860 return if defined $nick_absent{$chatnet}{$lc_nick};
861 $reason = "" if $reason =~ /^(Quit: )?(leaving)?$/;
862 my @channels = $channels{$chatnet}{$lc_nick} ?
863 @{$channels{$chatnet}{$lc_nick}} : ();
864 on_quit $chatnet, canonical $address, $nick,
865 ['quit', join(",", map {mark_private($server->channel_find($_), $_)} sort @channels), $reason];
866 };
867
868 Irssi::signal_add "event kick", sub {
869 my ($server, $args, $kicker, $kicker_address) = @_;
870 $args =~ /^([^ ]+) +([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+) +([^ ]+)$/ or
871 $args =~ /^([^ ]+) +([^ ]+)()$/ or return;
872 my ($channel, $nick, $reason) = ($1, $2, $3);
873 my $chatnet = lc $server->{chatnet};
874 $reason = "" if $reason eq $kicker;
875 on_part $chatnet, $addresses{$chatnet}{lc_irc $nick}, $nick, $channel,
876 ['was_kicked', mark_private($server->channel_find($channel), $channel), $kicker, $reason];
877 };
878
879 Irssi::signal_add "event nick", sub {
880 my ($server, $args, $old_nick, $address) = @_;
881 $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
882 my $new_nick = $1;
883 return if $address eq "";
884 my $chatnet = lc $server->{chatnet};
885 on_nick $chatnet, canonical $address, $old_nick, $new_nick;
886 check_asked $chatnet, $server, $new_nick;
887 };
888
889 ######## Commands ########
890
891 Irssi::command_bind "seen", sub {
892 my ($args, $server, $target) = @_;
893 my $nick;
894 if ($args =~ /^ *([^ ]+) *$/) {
895 $nick = $1;
896 } else {
897 Irssi::print "Usage: /seen <nick>";
898 return;
899 }
900 unless ($server && $server->{connected}) {
901 Irssi::print "Not connected to server";
902 return;
903 }
904 my ($reply, $found, $remember_asked) =
905 seen $server, $nick, undef, undef, sub {1}, undef;
906 Irssi::print $reply;
907 };
908
909 Irssi::command_bind "say_seen", sub {
910 my ($args, $server, $target) = @_;
911 my $chatnet = lc $server->{chatnet};
912 my ($nick_asks, $prefix, $nick);
913 if ($args =~ /^ *([^ ]+) *$/) {
914 $nick_asks = undef;
915 $prefix = "";
916 $nick = $1;
917 } elsif ($args =~ /^ *([^ ]+) +([^ ]+) *$/) {
918 $nick_asks = $1;
919 $prefix = "$1: ";
920 $nick = $2;
921 } else {
922 Irssi::print "Usage: /say_seen [<to_whom>] <nick>";
923 return;
924 }
925 unless ($server && $server->{connected}) {
926 Irssi::print "Not connected to server";
927 return;
928 }
929 unless ($target) {
930 Irssi::print "Not in a channel or query";
931 return;
932 }
933 my $can_show =
934 $target->{type} eq 'CHANNEL' ?
935 can_show_this_channel($target->{name}) :
936 $target->{type} eq 'QUERY' ?
937 can_show_his_channels($chatnet, $target->{name}) :
938 sub {0};
939 my ($reply, $found, $remember_asked) =
940 seen $server, $nick, undef, $target->{name}, $can_show, undef;
941 on_ask $chatnet, $nick, $nick_asks
942 if defined $nick_asks && $remember_asked;
943 $server->command("msg $target->{name} $prefix$reply");
944 };
945
946 sub cmd_listen_switch($$$$) {
947 my ($state, $args, $server, $target) = @_;
948 if ($args =~ /^ *$/) {
949 unless ($server && $server->{connected}) {
950 Irssi::print "Not connected to server";
951 return;
952 }
953 unless ($target && $target->{type} eq 'CHANNEL') {
954 Irssi::print "Not in a channel";
955 return;
956 }
957 on_listen lc $server->{chatnet}, lc_irc $target->{name}, $state;
958 } elsif ($args =~ /^ *([^ ]+) *$/)
959 {
960 unless ($server && $server->{connected}) {
961 Irssi::print "Not connected to server";
962 return;
963 }
964 on_listen lc $server->{chatnet}, lc_irc $1, $state;
965 } elsif ($args =~ /^ *([^ ]+) +([^ ]+) *$/)
966 {
967 on_listen lc $1, lc_irc $2, $state;
968 } else {
969 Irssi::print "Usage: /listen $state [[<chatnet>] <channel>]";
970 }
971 }
972
973 Irssi::command_bind "listen", sub {
974 my ($args, $server, $target) = @_;
975 Irssi::command_runsub "listen", $args, $server, $target;
976 };
977
978 Irssi::command_bind "listen on", sub {
979 my ($args, $server, $target) = @_;
980 cmd_listen_switch "on", $args, $server, $target;
981 };
982
983 Irssi::command_bind "listen off", sub {
984 my ($args, $server, $target) = @_;
985 cmd_listen_switch "off", $args, $server, $target;
986 };
987
988 Irssi::command_bind "listen delay", sub {
989 my ($args, $server, $target) = @_;
990 cmd_listen_switch "delay", $args, $server, $target;
991 };
992
993 Irssi::command_bind "listen private", sub {
994 my ($args, $server, $target) = @_;
995 cmd_listen_switch "private", $args, $server, $target;
996 };
997
998 Irssi::command_bind "listen disable", sub {
999 my ($args, $server, $target) = @_;
1000 cmd_listen_switch "disable", $args, $server, $target;
1001 };
1002
1003 our @joined_text = (" ", "joined");
1004
1005 Irssi::command_bind "listen list", sub {
1006 my ($args, $server, $target) = @_;
1007 if ($args =~ /^ *$/) {
1008 my %all_channels = ();
1009 foreach my $server (Irssi::servers()) {
1010 my $chatnet = lc $server->{chatnet};
1011 foreach my $channel ($server->channels()) {
1012 $all_channels{$chatnet}{lc_irc $channel->{name}}[0] = 1;
1013 }
1014 }
1015 foreach my $chatnet (keys %listen_on) {
1016 foreach my $channel (keys %{$listen_on{$chatnet}}) {
1017 $all_channels{$chatnet}{$channel}[1] = $listen_on{$chatnet}{$channel};
1018 }
1019 }
1020 my $max_chatnet_width = 1;
1021 my $max_channel_width = 1;
1022 foreach my $chatnet (keys %all_channels) {
1023 $max_chatnet_width = length $chatnet
1024 if length $chatnet > $max_chatnet_width;
1025 foreach my $channel (keys %{$all_channels{$chatnet}}) {
1026 $max_channel_width = length $channel
1027 if length $channel > $max_channel_width;
1028 }
1029 }
1030 Irssi::print "'seen' is listening:";
1031 foreach my $chatnet (sort keys %all_channels) {
1032 foreach my $channel (sort keys %{$all_channels{$chatnet}}) {
1033 Irssi::print
1034 $chatnet .
1035 " " x ($max_chatnet_width - length ($chatnet) + 1) .
1036 $channel .
1037 " " x ($max_channel_width - length ($channel) + 3) .
1038 $joined_text[$all_channels{$chatnet}{$channel}[0]] .
1039 " " .
1040 $all_channels{$chatnet}{$channel}[1];
1041 }
1042 }
1043 } else {
1044 Irssi::print "Usage: /listen list";
1045 }
1046 };
1047
1048 Irssi::command_bind "forget", sub {
1049 my ($args, $server, $target) = @_;
1050 my $nick;
1051 if ($args =~ /^ *([^ ]+) *$/) {
1052 $nick = $1;
1053 } else {
1054 Irssi::print "Usage: /forget <nick>";
1055 return;
1056 }
1057 unless ($server) {
1058 Irssi::print "Not connected to server";
1059 return;
1060 }
1061 my $chatnet = lc $server->{chatnet};
1062 return unless $asked{$chatnet}{$nick};
1063 foreach my $nick_asked (keys %{$asked{$chatnet}{$nick}}) {
1064 do_forget_ask $chatnet, $nick, $nick_asked;
1065 append_to_database "forget_ask $chatnet $nick $nick_asked";
1066 }
1067 };
1068
1069 ######## Listen to seen requests from other people ########
1070
1071 our $last_reply = undef;
1072 our $last_asked = undef;
1073
1074 our %pending_replies = ();
1075
1076 sub seen_reply($$$$$$) {
1077 my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
1078 my $chatnet = lc $server->{chatnet};
1079 my ($reply, $found, $remember_asked) =
1080 seen $server, $nick, $address, $target,
1081 can_show_this_channel($target), undef;
1082 return unless $sure || $found;
1083 unless ($reply eq $last_reply && $nick eq $last_asked) {
1084 Irssi::print "[$target] $nick_asks: $reply";
1085 $server->command("msg $target $nick_asks: $reply");
1086 $last_reply = $reply;
1087 $last_asked = $nick;
1088 }
1089 on_ask $chatnet, $nick, $nick_asks if $remember_asked;
1090 }
1091
1092 sub private_seen_reply($$$$$$) {
1093 my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
1094 my $chatnet = lc $server->{chatnet};
1095 my ($reply, $found, $remember_asked) =
1096 seen $server, $nick, $address, undef,
1097 can_show_his_channels($chatnet, $nick_asks), undef;
1098 return unless $sure || $found;
1099 $server->command("notice $nick_asks $reply");
1100 $server->command("notice $nick_asks " .
1101 "Pytac o obecnosc ludzi mozesz mnie tez prywatnie, np. /msg $server->{nick} seen $nick");
1102 on_ask $chatnet, $nick, $nick_asks if $remember_asked;
1103 }
1104
1105 sub delayed_seen_reply($$$$$$) {
1106 my ($server, $nick_asks, $address, $target, $nick, $sure) = @_;
1107 my $chatnet = lc $server->{chatnet};
1108 my $lc_nick = lc_irc $nick;
1109 return if defined $pending_replies{$chatnet}{$target}{$lc_nick};
1110 my $timeout = Irssi::settings_get_int("seen_delay") * 1000;
1111 $pending_replies{$chatnet}{$target}{$lc_nick} = Irssi::timeout_add_once $timeout, sub {
1112 delete $pending_replies{$chatnet}{$target}{$lc_nick};
1113 seen_reply $server, $nick_asks, $address, $target, $nick, $sure;
1114 }, undef;
1115 }
1116
1117 our %reply_method = (
1118 on => \&seen_reply,
1119 off => undef,
1120 delay => \&delayed_seen_reply,
1121 private => \&private_seen_reply,
1122 disable => undef,
1123 );
1124
1125 sub check_another_seen($$$$) {
1126 my ($chatnet, $channel, $msg, $nick_asks) = @_;
1127 my $lc_channel = lc_irc $channel;
1128 if ($listen_on{$chatnet}{$lc_channel} eq 'delay') {
1129 foreach my $nick (keys %{$pending_replies{$chatnet}{$channel}}) {
1130 my $nick_regexp = lc_irc_regexp $nick;
1131 if ($msg =~ /(^|[ \cb])$nick_regexp($|[ !,.:;?\cb])/ ||
1132 lc_irc $nick_asks eq $nick) {
1133 my $tag = $pending_replies{$chatnet}{$channel}{$nick};
1134 Irssi::timeout_remove $tag;
1135 delete $pending_replies{$chatnet}{$channel}{$nick};
1136 }
1137 }
1138 }
1139 }
1140
1141 Irssi::signal_add "message public", sub {
1142 my ($server, $msg, $nick_asks, $address, $channel) = @_;
1143 my $chatnet = lc $server->{chatnet};
1144 $address = canonical $address;
1145 on_spoke $chatnet, $address;
1146 my $lc_channel = lc_irc $channel;
1147 my ($msg_body, $func) =
1148 $msg =~ /^\Q$server->{nick}\E(?:|:|\cb:\cb) +(.*)$/i ? ($1, \&seen_reply) :
1149 ($msg, $reply_method{$listen_on{$chatnet}{$lc_channel} || 'off'});
1150 if (defined $func) {
1151 my $sure =
1152 $msg_body =~ $seen_regexp ? 1 :
1153 $msg_body =~ $maybe_seen_regexp1 ||
1154 $msg_body =~ $maybe_seen_regexp2 ? 0 :
1155 undef;
1156 if (defined $sure) {
1157 my $nick = $1;
1158 return if $sure == 0 && $nick =~ $exclude_regexp;
1159 Irssi::signal_continue @_;
1160 $func->($server, $nick_asks, $address, $channel, $nick, $sure);
1161 return;
1162 }
1163 }
1164 check_another_seen $chatnet, $channel, $msg, $nick_asks;
1165 };
1166
1167 Irssi::signal_add "message irc notice", sub {
1168 my ($server, $msg, $nick_asks, $address, $target) = @_;
1169 my $chatnet = lc $server->{chatnet};
1170 check_another_seen $chatnet, $target, $msg, $nick_asks;
1171 };
1172
1173 Irssi::signal_add "message private", sub {
1174 my ($server, $msg, $nick_asks, $address) = @_;
1175 my $chatnet = lc $server->{chatnet};
1176 on_spoke $chatnet, canonical $address;
1177 check_asked $chatnet, $server, $nick_asks;
1178 my $sure =
1179 $msg =~ $seen_regexp ? 1 :
1180 $msg =~ $maybe_seen_regexp1 ||
1181 $msg =~ $maybe_seen_regexp2 ? 0 :
1182 undef;
1183 if (defined $sure) {
1184 my $nick = $1;
1185 my ($reply, $found, $remember_asked) =
1186 seen $server, $nick, canonical $address, undef,
1187 can_show_his_channels($chatnet, $nick_asks), undef;
1188 return unless $sure || $found;
1189 Irssi::signal_continue @_;
1190 $server->command("msg $nick_asks $reply");
1191 on_ask $chatnet, $nick, $nick_asks if $remember_asked;
1192 }
1193 };
1194
1195 Irssi::signal_add "message irc action", sub {
1196 my ($server, $msg, $nick, $address, $target) = @_;
1197 on_spoke lc $server->{chatnet}, canonical $address;
1198 };