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