1use strict; 2use 5.005_62; # for 'our' 3use Irssi 20020428; # for Irssi::signal_continue 4use 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 103our %listen_on = (); 104our %address_absent = (); 105our %nicks = (); 106our %last_nicks = (); 107our %how_quit = (); 108our %spoke = (); 109our %nick_absent = (); 110our %addresses = (); 111our %orig_nick = (); 112our %channels = (); 113our %asked = (); 114 115Irssi::settings_add_int "seen", "seen_expire_after", 30; # days 116Irssi::settings_add_int "seen", "seen_expire_asked_after", 7; # days 117Irssi::settings_add_int "seen", "seen_delay", 60; # seconds 118 119our $database = Irssi::get_irssi_dir . "/seen.dat"; 120our $database_tmp = Irssi::get_irssi_dir . "/seen.tmp"; 121our $database_old = Irssi::get_irssi_dir . "/seen.dat~"; 122 123######## Utilities ######## 124 125our $nick_regexp = qr/ 126 [A-Z\[\\\]^_`a-z{|}\200-\377] 127 [\-0-9A-Z\[\\\]^_`a-z{|}\200-\377]* 128 /x; 129our $seen_regexp = qr/^ *!?seen +($nick_regexp) *\?* *$/i; 130our $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; 140our $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; 150our $exclude_regexp = qr/^(?:kto[�s]?|who?|that?|that|ladna|i|a)$/i; 151 152sub lc_irc($) { 153 my ($str) = @_; 154 $str =~ tr/A-Z[\\]/a-z{|}/; 155 return $str; 156} 157 158sub uc_irc($) { 159 my ($str) = @_; 160 $str =~ tr/a-z{|}/A-Z[\\]/; 161 return $str; 162} 163 164our %lc_regexps = (); 165 166sub 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 172sub canonical($) { 173 my ($address) = @_; 174 $address =~ s/^[\^~+=-]//; 175 return $address; 176} 177 178sub show_list(@) { 179 @_ == 0 and return ""; 180 @_ == 1 and return $_[0]; 181 return join(", ", @_[0..$#_-1]) . " i " . $_[$#_]; 182} 183 184sub 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 203sub 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 216sub is_private($) { 217 my ($channel) = @_; 218 return $channel && $channel->{mode} =~ /^[^ ]*[ps]/; 219} 220 221sub mark_private($$) { 222 my ($channel, $name) = @_; 223 return is_private $channel ? "-$name" : $name; 224} 225 226######## Actions on the database in memory ######## 227 228sub 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 237sub 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 252sub 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 260sub 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 271sub 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 279sub 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 294sub 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 301sub 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 310sub 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 319sub append_to_database(@) { 320 open DATABASE, ">>$database"; 321 print DATABASE map {"$_\n"} @_; 322 close DATABASE; 323} 324 325sub on_listen($$$) { 326 my ($chatnet, $channel, $state) = @_; 327 do_listen $chatnet, $channel, $state; 328 append_to_database "listen $state $chatnet $channel"; 329} 330 331sub 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 337sub 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 344sub 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 353sub 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 361sub 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 368sub 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 376sub 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 385sub syntax_error() { 386 die "Syntax error in $database: $_"; 387} 388 389our %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 411sub 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 418our %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 458sub 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 471sub 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 525sub 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 550sub 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 601sub 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 608sub 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 621sub 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 634sub on_channels(@) { 635 return @_ == 1 ? "on the channel $_[0]" : "on the channels " . show_list(@_); 636} 637 638our %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 687sub 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 693sub 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 722sub 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 765read_database; 766expire_database; 767initialize_database; 768write_database; 769 770Irssi::timeout_add 60*60*1000, sub {expire_database; write_database}, undef; 771 772######## Irssi signal handlers ######## 773 774sub 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 780sub 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 791sub 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 809Irssi::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 824Irssi::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 834Irssi::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 843Irssi::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 854Irssi::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 868Irssi::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 879Irssi::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 891Irssi::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 909Irssi::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 946sub 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 973Irssi::command_bind "listen", sub { 974 my ($args, $server, $target) = @_; 975 Irssi::command_runsub "listen", $args, $server, $target; 976}; 977 978Irssi::command_bind "listen on", sub { 979 my ($args, $server, $target) = @_; 980 cmd_listen_switch "on", $args, $server, $target; 981}; 982 983Irssi::command_bind "listen off", sub { 984 my ($args, $server, $target) = @_; 985 cmd_listen_switch "off", $args, $server, $target; 986}; 987 988Irssi::command_bind "listen delay", sub { 989 my ($args, $server, $target) = @_; 990 cmd_listen_switch "delay", $args, $server, $target; 991}; 992 993Irssi::command_bind "listen private", sub { 994 my ($args, $server, $target) = @_; 995 cmd_listen_switch "private", $args, $server, $target; 996}; 997 998Irssi::command_bind "listen disable", sub { 999 my ($args, $server, $target) = @_; 1000 cmd_listen_switch "disable", $args, $server, $target; 1001}; 1002 1003our @joined_text = (" ", "joined"); 1004 1005Irssi::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 1048Irssi::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 1071our $last_reply = undef; 1072our $last_asked = undef; 1073 1074our %pending_replies = (); 1075 1076sub 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 1092sub 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 1105sub 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 1117our %reply_method = ( 1118 on => \&seen_reply, 1119 off => undef, 1120 delay => \&delayed_seen_reply, 1121 private => \&private_seen_reply, 1122 disable => undef, 1123); 1124 1125sub 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 1141Irssi::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 1167Irssi::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 1173Irssi::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 1195Irssi::signal_add "message irc action", sub { 1196 my ($server, $msg, $nick, $address, $target) = @_; 1197 on_spoke lc $server->{chatnet}, canonical $address; 1198}; 1199