PageRenderTime 29ms CodeModel.GetById 19ms RepoModel.GetById 1ms app.codeStats 0ms

/beaubot/irssi/seen.pl

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