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
8use strict;
9use Irssi 20020428.1608;
10
11use Text::Abbrev;
12use POSIX;
13
14#use Data::Dumper;
15
16# ======[ Script Header ]===============================================
17
18use vars qw{$VERSION %IRSSI};
19($VERSION) = '$Revision: 1.25 $' =~ / (\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
31use vars qw(%state);
32*state = \%Query::state;	# used for tracking idletime and state
33
34my($own);
35my(%defaults);			# used for storing defaults
36my($query_opts) = {};		# stores option abbrevs
37
38# ======[ Helper functions ]============================================
39
40# --------[ load_defaults ]---------------------------------------------
41
42sub 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
58sub 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
75sub 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
99sub 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
123sub 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
142sub time2str {
143    my($time) = @_;
144    return strftime("%c", localtime $time);
145}
146
147# --------[ userhost_cmp ]----------------------------------------------
148
149sub 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
186sub sig_message_own_private {
187    my($server,$msg,$nick,$orig_target) = @_;
188    $own = $nick;
189}
190
191# --------[ sig_message_private ]---------------------------------------
192
193sub sig_message_private {
194    my($server,$msg,$nick,$addr) = @_;
195    undef $own;
196}
197
198# --------[ sig_print_message ]-----------------------------------------
199
200sub 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
219sub 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
228sub 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
272sub 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
281sub 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
290sub 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
303sub 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
318sub 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
332sub 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
381sub 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
544sub 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
578Irssi::command_bind('query', 'cmd_query');
579Irssi::command_bind('unquery', 'cmd_unquery');
580Irssi::command_set_options('query', 'immortal mortal info save +timeout');
581abbrev $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
589Irssi::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
614Irssi::settings_add_bool('query', 'query_autojump_own', 1);
615Irssi::settings_add_bool('query', 'query_autojump', 0);
616Irssi::settings_add_bool('query', 'query_noisy', 1);
617Irssi::settings_add_bool('query', 'query_unqueries',
618			 Irssi::version <  20020919.1507 ||
619			 Irssi::version >= 20021006.1620 );
620
621Irssi::settings_add_time('query', 'query_autoclose', 0);
622Irssi::settings_add_time('query', 'query_autoclose_grace', '5min');
623
624# --------[ Register signals ]------------------------------------------
625
626Irssi::signal_add_last('message own_private', 'sig_message_own_private');
627Irssi::signal_add_last('message private', 'sig_message_private');
628
629Irssi::signal_add_last('query created', 'sig_query_created');
630
631Irssi::signal_add('print text', 'sig_print_message');
632
633Irssi::signal_add('query address changed', 'sig_query_address_changed');
634Irssi::signal_add('query destroyed', 'sig_query_destroyed');
635Irssi::signal_add('query nick changed', 'sig_query_nick_changed');
636
637Irssi::signal_add('redir query userhost', 'sig_redir_query_userhost');
638
639Irssi::signal_add('session save', 'sig_session_save');
640Irssi::signal_add('session restore', 'sig_session_restore');
641
642# --------[ Register timers ]-------------------------------------------
643
644Irssi::timeout_add(5000, 'check_queries', undef);
645
646# ======[ Initialization ]==============================================
647
648load_defaults;
649
650for 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
660if (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:
671