html/query.pl
1 # query - irssi 0.8.4.CVS
2 #
3 # $Id: query.pl,v 1.24 2009/03/29 12:23:10 peder Exp $
4 #
5 # Copyright (C) 2001, 2002, 2004, 2007 by Peder Stray <peder@ninja.no>
6 #
7
8 use strict;
9 use Irssi 20020428.1608;
10
11 use Text::Abbrev;
12 use POSIX;
13
14 #use Data::Dumper;
15
16 # ======[ Script Header ]===============================================
17
18 use vars qw{$VERSION %IRSSI};
19 ($VERSION) = '$Revision: 1.24 $' =~ / (\d+\.\d+) /;
20 %IRSSI = (
21 name => 'query',
22 authors => 'Peder Stray',
23 contact => 'peder@ninja.no',
24 url => 'http://ninja.no/irssi/query.pl',
25 license => 'GPL',
26 description => 'Give you more control over when to jump to query windows and when to just tell you one has been created. Enhanced autoclose.',
27 );
28
29 # ======[ Variables ]===================================================
30
31 use vars qw(%state);
32 *state = \%Query::state; # used for tracking idletime and state
33
34 my($own);
35 my(%defaults); # used for storing defaults
36 my($query_opts) = {}; # stores option abbrevs
37
38 # ======[ Helper functions ]============================================
39
40 # --------[ load_defaults ]---------------------------------------------
41
42 sub load_defaults {
43 my $file = Irssi::get_irssi_dir."/query";
44 local *FILE;
45
46 %defaults = ();
47 open FILE, "< $file";
48 while (<FILE>) {
49 my($mask,$maxage,$immortal) = split;
50 $defaults{$mask}{maxage} = $maxage;
51 $defaults{$mask}{immortal} = $immortal;
52 }
53 close FILE;
54 }
55
56 # --------[ save_defaults ]---------------------------------------------
57
58 sub save_defaults {
59 my $file = Irssi::get_irssi_dir."/query";
60 local *FILE;
61
62 open FILE, "> $file";
63 for (keys %defaults) {
64 my $d = $defaults{$_};
65 print FILE join("\t", $_,
66 exists $d->{maxage} ? $d->{maxage} : -1,
67 exists $d->{immortal} ? $d->{immortal} : -1,
68 ), "\n";
69 }
70 close FILE;
71 }
72
73 # --------[ sec2str ]---------------------------------------------------
74
75 sub sec2str {
76 my($sec) = @_;
77 my($ret);
78 use integer;
79
80 $ret = ($sec%60)."s ";
81 $sec /= 60;
82
83 $ret = ($sec%60)."m ".$ret;
84 $sec /= 60;
85
86 $ret = ($sec%24)."h ".$ret;
87 $sec /= 24;
88
89 $ret = $sec."d ".$ret;
90
91 $ret =~ s/\b0[dhms] //g;
92 $ret =~ s/ $//;
93
94 return $ret;
95 }
96
97 # --------[ str2sec ]---------------------------------------------------
98
99 sub str2sec {
100 my($str) = @_;
101
102 for ($str) {
103 s/\s+//g;
104 s/d/*24h/g;
105 s/h/*60m/g;
106 s/m/*60s/g;
107 s/s/+/g;
108 s/\+$//;
109 }
110
111 if ($str =~ /^[0-9*+]+$/) {
112 $str = eval $str;
113 }
114 else {
115 $str = 0;
116 }
117
118 return $str;
119 }
120
121 # --------[ set_defaults ]----------------------------------------------
122
123 sub set_defaults {
124 my($serv,$nick,$address) = @_;
125 my $tag = lc $serv->{tag};
126
127 return unless $address;
128 $state{$tag}{$nick}{address} = $address;
129
130 for my $mask (sort {userhost_cmp($serv,$a,$b)}keys %defaults) {
131 if ($serv->mask_match_address($mask, $nick, $address)) {
132 for my $key (keys %{$defaults{$mask}}) {
133 $state{$tag}{$nick}{$key} = $defaults{$mask}{$key}
134 if $defaults{$mask}{$key} >= 0;
135 }
136 }
137 }
138 }
139
140 # --------[ time2str ]--------------------------------------------------
141
142 sub time2str {
143 my($time) = @_;
144 return strftime("%c", localtime $time);
145 }
146
147 # --------[ userhost_cmp ]----------------------------------------------
148
149 sub userhost_cmp {
150 my($serv, $am, $bm) = @_;
151 my($an,$aa) = split "!", $am;
152 my($bn,$ba) = split "!", $bm;
153 my($t1,$t2);
154
155 $t1 = $serv->mask_match_address($bm, $an, $aa);
156 $t2 = $serv->mask_match_address($am, $bn, $ba);
157
158 return $t1 - $t2 if $t1 || $t2;
159
160 $an = $bn = '*';
161 $am = "$an!$aa";
162 $bm = "$bn!$ba";
163
164 $t1 = $serv->mask_match_address($bm, $an, $aa);
165 $t2 = $serv->mask_match_address($am, $bn, $ba);
166
167 return $t1 - $t2 if $t1 || $t2;
168
169 for ($am, $bm, $aa, $ba) {
170 s/(\*!)?[^*]*@/$1*/;
171 }
172
173 $t1 = $serv->mask_match_address($bm, $an, $aa);
174 $t2 = $serv->mask_match_address($am, $bn, $ba);
175
176 return $t1 - $t2 if $t1 || $t2;
177
178 return 0;
179
180 }
181
182 # ======[ Signal Hooks ]================================================
183
184 # --------[ sig_message_own_private ]-----------------------------------
185
186 sub sig_message_own_private {
187 my($server,$msg,$nick,$orig_target) = @_;
188 $own = $nick;
189 }
190
191 # --------[ sig_message_private ]---------------------------------------
192
193 sub sig_message_private {
194 my($server,$msg,$nick,$addr) = @_;
195 undef $own;
196 }
197
198 # --------[ sig_print_message ]-----------------------------------------
199
200 sub sig_print_message {
201 my($dest, $text, $strip) = @_;
202
203 return unless $dest->{level} & MSGLEVEL_MSGS;
204
205 my $server = $dest->{server};
206
207 return unless $server;
208
209 my $witem = $server->window_item_find($dest->{target});
210 my $tag = lc $server->{tag};
211
212 return unless $witem->{type} eq 'QUERY';
213
214 $state{$tag}{$witem->{name}}{time} = time;
215 }
216
217 # --------[ sig_query_address_changed ]---------------------------------
218
219 sub sig_query_address_changed {
220 my($query) = @_;
221
222 set_defaults($query->{server}, $query->{name}, $query->{address});
223
224 }
225
226 # --------[ sig_query_created ]-----------------------------------------
227
228 sub sig_query_created {
229 my ($query, $auto) = @_;
230 my $qwin = $query->window();
231 my $awin = Irssi::active_win();
232
233 my $serv = $query->{server};
234 my $nick = $query->{name};
235 my $tag = lc $query->{server_tag};
236
237 if ($auto && $qwin->{refnum} != $awin->{refnum}) {
238 if ($own eq $query->{name}) {
239 if (Irssi::settings_get_bool('query_autojump_own')) {
240 $qwin->set_active();
241 } else {
242 $awin->printformat(MSGLEVEL_CLIENTCRAP, 'query_created',
243 $nick, $query->{server_tag},
244 $qwin->{refnum})
245 if Irssi::settings_get_bool('query_noisy');
246 }
247 } else {
248 if (Irssi::settings_get_bool('query_autojump')) {
249 $qwin->set_active();
250 } else {
251 $awin->printformat(MSGLEVEL_CLIENTCRAP, 'query_created',
252 $nick, $query->{server_tag},
253 $qwin->{refnum})
254 if Irssi::settings_get_bool('query_noisy');
255 }
256 }
257 }
258 undef $own;
259
260 $state{$tag}{$nick} = { time => time };
261
262 $serv->redirect_event('userhost', 1, ":$nick", -1, undef,
263 {
264 "event 302" => "redir query userhost",
265 "" => "event empty",
266 });
267 $serv->send_raw("USERHOST :$nick");
268 }
269
270 # --------[ sig_query_destroyed ]---------------------------------------
271
272 sub sig_query_destroyed {
273 my($query) = @_;
274
275 delete $state{lc $query->{server_tag}}{$query->{name}};
276 }
277
278
279 # --------[ sig_query_nick_changed ]------------------------------------
280
281 sub sig_query_nick_changed {
282 my($query,$old_nick) = @_;
283 my($tag) = lc $query->{server_tag};
284
285 $state{$tag}{$query->{name}} = delete $state{$tag}{$old_nick};
286 }
287
288 # --------[ sig_redir_query_userhost ]----------------------------------
289
290 sub sig_redir_query_userhost {
291 my($serv,$data) = @_;
292
293 $data =~ s/^\S*\s*://;
294 for (split " ", $data) {
295 if (/([^=*]+)\*?=.(.+)/) {
296 set_defaults($serv, $1, $2);
297 }
298 }
299 }
300
301 # --------[ sig_session_restore ]---------------------------------------
302
303 sub sig_session_restore {
304 open STATE, sprintf "< %s/query.state", Irssi::get_irssi_dir;
305 %state = (); # only needed if bound as command
306 while (<STATE>) {
307 chomp;
308 my($tag,$nick,%data) = split "\t";
309 for my $key (keys %data) {
310 $state{lc $tag}{$nick}{$key} ||= $data{$key};
311 }
312 }
313 close STATE;
314 }
315
316 # --------[ sig_session_save ]------------------------------------------
317
318 sub sig_session_save {
319 open STATE, sprintf "> %s/query.state", Irssi::get_irssi_dir;
320 for my $tag (keys %state) {
321 for my $nick (keys %{$state{$tag}}) {
322 print STATE join("\t",$tag,$nick,%{$state{$tag}{$nick}}), "\n";
323 }
324 }
325 close STATE;
326 }
327
328 # ======[ Timers ]======================================================
329
330 # --------[ check_queries ]---------------------------------------------
331
332 sub check_queries {
333 my(@queries) = Irssi::queries;
334
335 my($defmax) = Irssi::settings_get_time('query_autoclose')/1000;
336 my($minage) = Irssi::settings_get_time('query_autoclose_grace')/1000;
337 my($win) = Irssi::active_win;
338
339 for my $query (@queries) {
340 my $tag = lc $query->{server_tag};
341 my $name = $query->{name};
342 my $state = $state{$tag}{$name};
343
344 my $age = time - $state->{time};
345 my $maxage = $defmax;
346
347 $maxage = $state->{maxage} if defined $state->{maxage};
348
349 # skip the ones we have marked as immortal
350 next if $state->{immortal};
351
352 # maxage = 0 means we have disabled autoclose
353 next unless $maxage;
354
355 # not old enough
356 next if $age < $maxage;
357
358 # unseen messages
359 next if $query->{data_level} > 1;
360
361 # active window
362 next if $query->is_active &&
363 $query->window->{refnum} == $win->{refnum};
364
365 # graceperiod
366 next if time - $query->{last_unread_msg} < $minage;
367
368 # kill it off
369 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'query_closed',
370 $query->{name}, $query->{server_tag})
371 if Irssi::settings_get_bool('query_noisy');
372 $query->destroy;
373
374 }
375 }
376
377 # ======[ Commands ]====================================================
378
379 # --------[ cmd_query ]-------------------------------------------------
380
381 sub cmd_query {
382 my($data,$server,$witem) = @_;
383 my(@data) = split " ", $data;
384
385 my(@params,@opts,$query,$tag,$nick);
386 my($state,$info,$save);
387
388 while (@data) {
389 my $param = shift @data;
390
391 if ($param =~ s/^-//) {
392 my $opt = $query_opts->{lc $param};
393
394 if ($opt) {
395
396 if ($opt eq 'window') {
397 push @opts, "-$param";
398
399 } elsif ($opt eq 'immortal') {
400 $state->{immortal} = 1;
401
402 } elsif ($opt eq 'info') {
403 $info = 1;
404
405 } elsif ($opt eq 'mortal') {
406 $state->{immortal} = 0;
407
408 } elsif ($opt eq 'timeout') {
409 $state->{maxage} = str2sec shift @data;
410
411 } elsif ($opt eq 'save') {
412 $save++;
413
414 } else {
415 # unhandled known opt
416
417 }
418
419 } elsif ($tag = Irssi::server_find_tag($param)) {
420 $tag = $tag->{tag};
421 push @opts, "-$tag";
422
423 } else {
424 # bogus opt...
425 push @opts, "-$param";
426
427 }
428
429 } else {
430 # normal parameter
431 push @params, $param;
432
433 }
434 }
435
436 if (@params) {
437 Irssi::signal_continue("@opts @params",$server,$witem);
438
439 # find the query...
440 my $serv = Irssi::server_find_tag($tag || $server->{tag});
441 return unless $serv;
442 $query = $serv->window_item_find($params[0]);
443
444 } else {
445
446 if ($witem && $witem->{type} eq 'QUERY') {
447 $query = $witem;
448 }
449
450 }
451
452 if ($query) {
453 $nick = $query->{name};
454 $tag = lc $query->{server_tag};
455
456 my $opts;
457 for (keys %$state) {
458 $state{$tag}{$nick}{$_} = $state->{$_};
459 $opts++;
460 }
461
462 $state = $state{$tag}{$nick};
463
464 if ($info) {
465 Irssi::signal_stop();
466 my(@items,$key,$val);
467
468 my $timeout = Irssi::settings_get_time('query_autoclose')/1000;
469 $timeout = $state->{maxage} if defined $state->{maxage};
470
471 if ($timeout) {
472 $timeout .= " (".sec2str($timeout).")";
473 } else {
474 $timeout .= " (Off)";
475 }
476
477 @items = (
478 Server => $query->{server_tag},
479 Nick => $nick,
480 Address => $state->{address},
481 Created => time2str($query->{createtime}),
482 Immortal => $state->{immortal}?'Yes':'No',
483 Timeout => $timeout,
484 Idle => sec2str(time - $state->{time}),
485 );
486
487 $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info_header');
488 while (($key,$val) = splice @items, 0, 2) {
489 $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info',
490 $key, $val);
491 }
492 $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info_footer');
493
494 return;
495 }
496
497 if ($save) {
498 Irssi::signal_stop;
499
500 unless ($state->{address}) {
501 $query->printformat(MSGLEVEL_CLIENTCRAP,
502 'query_crap', 'This query has no address yet');
503 return;
504 }
505
506 my $mask = Irssi::Irc::get_mask($nick, $state->{address},
507 Irssi::Irc::MASK_USER |
508 Irssi::Irc::MASK_DOMAIN
509 );
510
511 for (qw(immortal maxage)) {
512 if (exists $state->{$_}) {
513 $defaults{$mask}{$_} = $state->{$_};
514 } else {
515 delete $defaults{$mask}{$_};
516 }
517 }
518
519 save_defaults;
520
521 return;
522 }
523
524 if (!@params) {
525 Irssi::signal_stop;
526 return if $opts;
527
528 if ($state{$tag}{$nick}{immortal}) {
529 $witem->printformat(MSGLEVEL_CLIENTCRAP,
530 'query_crap', 'This query is immortal');
531 } else {
532 $witem->command("unquery")
533 if Irssi::settings_get_bool('query_unqueries');
534 }
535
536 }
537
538 }
539
540 }
541
542 # --------[ cmd_unquery ]-----------------------------------------------
543
544 sub cmd_unquery {
545 my($data,$server,$witem) = @_;
546 my($param) = split " ", $data;
547 my($query,$tag,$nick);
548
549 if ($param) {
550 $query = $server->query_find($param) if $server;
551 } else {
552 $query = $witem if $witem && $witem->{type} eq 'QUERY';
553 }
554
555 if ($query) {
556 $nick = $query->{name};
557 $tag = lc $query->{server_tag};
558
559 if ($state{$tag}{$nick}{immortal}) {
560 if ($param) {
561 $witem->printformat(MSGLEVEL_CLIENTCRAP,
562 'query_crap',
563 "Query with $nick is immortal");
564 } else {
565 $witem->printformat(MSGLEVEL_CLIENTCRAP,
566 'query_crap',
567 'This query is immortal');
568 }
569 Irssi::signal_stop;
570 }
571 }
572 }
573
574 # ======[ Setup ]=======================================================
575
576 # --------[ Register commands ]-----------------------------------------
577
578 Irssi::command_bind('query', 'cmd_query');
579 Irssi::command_bind('unquery', 'cmd_unquery');
580 Irssi::command_set_options('query', 'immortal mortal info save +timeout');
581 abbrev $query_opts, qw(window immortal mortal info save timeout);
582
583 #Irssi::command_bind('debug', sub { print Dumper \%state });
584 #Irssi::command_bind('query_save', 'sig_session_save');
585 #Irssi::command_bind('query_restore', 'sig_session_restore');
586
587 # --------[ Register formats ]------------------------------------------
588
589 Irssi::theme_register(
590 [
591 'query_created',
592 '{line_start}{hilight Query:} started with {nick $0} [$1] in window $2',
593
594 'query_closed',
595 '{line_start}{hilight Query:} closed with {nick $0} [$1]',
596
597 'query_info_header', '',
598
599 'query_info_footer', '',
600
601 'query_crap',
602 '{line_start}{hilight Query:} $0',
603
604 'query_warn',
605 '{line_start}{hilight Query:} {error Warning:} $0',
606
607 'query_info',
608 '%#$[8]0: $1',
609
610 ]);
611
612 # --------[ Register settings ]-----------------------------------------
613
614 Irssi::settings_add_bool('query', 'query_autojump_own', 1);
615 Irssi::settings_add_bool('query', 'query_autojump', 0);
616 Irssi::settings_add_bool('query', 'query_noisy', 1);
617 Irssi::settings_add_bool('query', 'query_unqueries',
618 Irssi::version < 20020919.1507 ||
619 Irssi::version >= 20021006.1620 );
620
621 Irssi::settings_add_time('query', 'query_autoclose', 0);
622 Irssi::settings_add_time('query', 'query_autoclose_grace', '5min');
623
624 # --------[ Register signals ]------------------------------------------
625
626 Irssi::signal_add_last('message own_private', 'sig_message_own_private');
627 Irssi::signal_add_last('message private', 'sig_message_private');
628
629 Irssi::signal_add_last('query created', 'sig_query_created');
630
631 Irssi::signal_add('print text', 'sig_print_message');
632
633 Irssi::signal_add('query address changed', 'sig_query_address_changed');
634 Irssi::signal_add('query destroyed', 'sig_query_destroyed');
635 Irssi::signal_add('query nick changed', 'sig_query_nick_changed');
636
637 Irssi::signal_add('redir query userhost', 'sig_redir_query_userhost');
638
639 Irssi::signal_add('session save', 'sig_session_save');
640 Irssi::signal_add('session restore', 'sig_session_restore');
641
642 # --------[ Register timers ]-------------------------------------------
643
644 Irssi::timeout_add(5000, 'check_queries', undef);
645
646 # ======[ Initialization ]==============================================
647
648 load_defaults;
649
650 for my $query (Irssi::queries) {
651 my($tag) = lc $query->{server_tag};
652 my($nick) = $query->{name};
653
654 $state{$tag}{$nick}{time}
655 ||= $query->{last_unread_msg} || $query->{createtime} || time;
656
657 set_defaults($query->{server}, $nick, $query->{address});
658 }
659
660 if (Irssi::settings_get_time("autoclose_query")) {
661 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'query_warn',
662 "autoclose_query is set, please set to 0");
663 }
664
665 # ======[ END ]=========================================================
666
667 # Local Variables:
668 # header-initial-hide: t
669 # mode: header-minor
670 # end: