diff options
29 files changed, 6005 insertions, 38 deletions
diff --git a/auto-server/joinswitch.pl b/auto-server/joinswitch.pl new file mode 100644 index 0000000..fdd8592 --- /dev/null +++ b/auto-server/joinswitch.pl @@ -0,0 +1,99 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'joinswitch', + description => 'joins a channel, or switches to it if it already exists', + license => 'MIT', + updated => '$DATE' + ); + +sub init { + + Irssi::command_bind 'joinswitch', \&cmd_joinswitch; +} + +sub cmd_joinswitch { + my ($args, $server, $witem) = @_; + $server = Irssi::active_server() unless $server; + return unless defined $server; + + my @channels = sort { $b <=> $a } $server->channels(); + if (@channels) { + do_switch($channels[0], $server); + } else { + do_join($channels[0], $server); + } +} + +sub do_join { + my ($chan, $server) = @_; + $server->command("join $chan") +} + +sub do_switch { + my ($chan, $server) = @_; +} + +init(); + diff --git a/bnotify/bnotify.pl b/bnotify/bnotify.pl new file mode 100644 index 0000000..eaff6f8 --- /dev/null +++ b/bnotify/bnotify.pl @@ -0,0 +1,136 @@ +# todo: grap topic changes + +use strict; +use vars qw($VERSION %IRSSI); + +use Irssi; +$VERSION = '0.0.1'; +%IRSSI = ( + authors => 'richo', + contact => 'richo@psych0tik.net', + name => 'bnotify', + description => 'Write notifications based on who\'s talking to you, also handle some window management and tmux alerts', + url => 'http://natalya.psych0tik.net/~richo/bnotify', + license => 'GNU General Public License', + changed => '$Date: 2011-06-21 21:51:30 +1000 (Tue, 21 Jun 2011) $' +); +# Originally based on fnotify.pl 0.0.3 by Thorsten Leemhuis +# fedora@leemhuis.info +# 'http://www.leemhuis.info/files/fnotify/', +# +#-------------------------------------------------------------------- +# In parts based on knotify.pl 0.1.1 by Hugo Haas +# http://larve.net/people/hugo/2005/01/knotify.pl +# which is based on osd.pl 0.3.3 by Jeroen Coekaerts, Koenraad Heijlen +# http://www.irssi.org/scripts/scripts/osd.pl +# +# Other parts based on notify.pl from Luke Macken +# http://fedora.feedjack.org/user/918/ +# +#-------------------------------------------------------------------- + +# TODO +# Add settings for which networks to beep on + +my @alert_nets = (); +sub bnotify_init { + Irssi::settings_add_str('bnotify', 'bnotify_alert_nets', ''); + @alert_nets = split(/ /, Irssi::settings_get_str('bnotify_alert_nets')); +} + +#-------------------------------------------------------------------- +# Private message parsing +#-------------------------------------------------------------------- +# TODO +# Test to see if the privmsg went to a status window, and is from bitlbee in +# which case send it to it's own window + +sub priv_msg { + my ($server,$msg,$nick,$address,$target) = @_; + # Does this expose issues if someone includes regexp chars in their server + # tag? + if (grep(/^$server->{tag}$/, @alert_nets)) { + Irssi::command('beep'); + } + filewrite($server->{tag}.":".$nick." private"); + #Irssi::settings_set_str('autocreate_query_level', 'DCCMSGS MSGS'); +} + +#-------------------------------------------------------------------- +# Private msg windowing +#-------------------------------------------------------------------- + +sub priv_msg_winhook { + my ($server,$msg,$nick,$address,$target) = @_; + if (grep($server->{tag}, @alert_nets)) { + Irssi::settings_set_str('autocreate_query_level', 'DCCMSGS MSGS'); + } +} + +#-------------------------------------------------------------------- +# Printing hilight's +#-------------------------------------------------------------------- + +sub hilight { + my ($dest, $text, $stripped) = @_; + if ($dest->{level} & MSGLEVEL_HILIGHT) { + filewrite($dest->{server}->{tag}.":".$dest->{target}. " " .$stripped ); + } +} + +#-------------------------------------------------------------------- +# Handle Arguments +#-------------------------------------------------------------------- + +sub cmd_add { + my $net = shift; + if (not grep($net, @alert_nets)) { + push @alert_nets, $net; + Irssi::active_win->print("Added $net to alert networks."); + } else { + Irssi::active_win->print("$net already configured to alert."); + } +} + +sub cmd_del { + my $net = shift; + my @valid; + my $idx = 0; + while ($idx <= $#alert_nets) { + if (lc($alert_nets[$idx]) eq lc($net)) { + push @valid, $alert_nets[$idx]; + } + $idx++; + } + if ($#alert_nets != $#valid) { + Irssi::active_win->print("Removed $net from alert networks."); + } else { + Irssi::active_win->print("$net didn't exist in alert networks."); + } + @alert_nets = @valid; +} + +#-------------------------------------------------------------------- +# The actual printing +#-------------------------------------------------------------------- + +sub filewrite { + my ($text) = @_; + open(FILE, '>' .Irssi::get_irssi_dir() . '/fnotify'); + print FILE $text . "\n"; + close (FILE); +} + +#-------------------------------------------------------------------- +# Irssi::signal_add_last / Irssi::command_bind +#-------------------------------------------------------------------- + +Irssi::signal_add_first("message private", "priv_msg_winhook"); +Irssi::signal_add_last("message private", "priv_msg"); +Irssi::signal_add_last("print text", "hilight"); + +Irssi::command_bind('bnotify add', \&cmd_add); +Irssi::command_bind('bnotify del', \&cmd_del); +bnotify_init(); + +#- end diff --git a/feature-tests/any_time.pl b/feature-tests/any_time.pl new file mode 100644 index 0000000..fd00b02 --- /dev/null +++ b/feature-tests/any_time.pl @@ -0,0 +1,37 @@ + +use strict; +use warnings; + +use Irssi; +use Irssi::TextUI; # for sbar_items_redraw +use POSIX qw/strftime/; + +my $time_format; + +sub any_time_sb { + my ($sb_item, $get_size_only) = @_; + + my @time_now = localtime(); + my $formatted_time = strftime($time_format, @time_now); + + $sb_item->default_handler($get_size_only, "{sb $formatted_time}", '', 0); +} + +sub sig_setup_changed { + $time_format = Irssi::settings_get_str('any_time_format'); +} + +sub init { + Irssi::settings_add_str('any_time', 'any_time_format', '%H:%M'); + Irssi::signal_add('setup changed', \&sig_setup_changed); + + sig_setup_changed(); + + Irssi::signal_add('expando timer', + sub { Irssi::statusbar_items_redraw('any_time') }); + + + Irssi::statusbar_item_register ('any_time', 0, 'any_time_sb'); +} + +init(); diff --git a/feature-tests/dcc-kill.pl b/feature-tests/dcc-kill.pl new file mode 100644 index 0000000..c141dd6 --- /dev/null +++ b/feature-tests/dcc-kill.pl @@ -0,0 +1,106 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); + + +Irssi::signal_add 'dcc request', \&sig_dcc_request; + +sub sig_dcc_request { + my ($req) = @_; + + return unless $req; + + # SEND file request. + return unless $req->{type} eq 'GET'; + + my $server = $req->{server}; + my $their_nick = $req->{nick}; + my $filename = $req->{arg}; + + # TODO: Move this inside the if() below if you sometimes have + # valid sends, or it'll reject them all. + $server->command("DCC CLOSE GET $their_nick"); + + if ( ($their_nick =~ m/nick_pattern/) or + ($filename =~ m/filename_pattern/) ) { + + Irssi::print("Going to kill spambot: $their_nick"); + do_kill($their_nick); + } +} + +sub do_kill { + my ($server, $victim) = @_; + + # TODO: set kill args properly here. + $server->command("KILL $victim"); +} + +sub { my $req = shift; return unless $req && $req->{type} eq 'GET'; print "Got GET request from " . $req->{nick}; return unless $req->{nick} =~ m/badnick/; my ($server, $target) = + ($req->{server}, $req->{nick}; $server->command("dcc close GET $target"); print "Killing $target goes here"; }; diff --git a/feature-tests/error.pl b/feature-tests/error.pl new file mode 100644 index 0000000..5507910 --- /dev/null +++ b/feature-tests/error.pl @@ -0,0 +1,16 @@ +use Irssi; +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); + +Irssi::timeout_add_once(1000, 'die_horribly', undef); + +sub die_horribly { + die "Oh noes, I broke!"; +} diff --git a/feature-tests/history-restore.pl b/feature-tests/history-restore.pl new file mode 100644 index 0000000..453508a --- /dev/null +++ b/feature-tests/history-restore.pl @@ -0,0 +1,186 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'history-restore', + description => '', + license => 'MIT', + updated => '$DATE' + ); + +my @fake_history; +# = ( "test", "test2", "test3" ); + +push @fake_history, "Test Entry $_" for (1..100); + +my $buf; +my @hist_queue = (); + +sub init { + Irssi::theme_register + ([ + verbatim => '[$*]', + script_loaded => 'Loaded script {hilight $0} v$1', + ]); + + # definitely not an int for last param. + #Irssi::signal_register({'key down' => [qw/string string int/] }); + Irssi::command_bind('dohist', \&cmd_dohist); + Irssi::command_bind('showhist', \&cmd_showhist); + + + Irssi::printformat(Irssi::MSGLEVEL_CLIENTCRAP, 'script_loaded', + $IRSSI{name}, $VERSION); + + +} + +sub win { + return $_[0] || Irssi::active_win(); +} + + +sub do_next { + if (length $buf) { + my $char = substr($buf, 0, 1, ''); + _key($char); + do_next(); + + #Irssi::timeout_add_once(10, + # sub { + # }, ''); + } else { + $buf = shift @hist_queue; + _down(); + if ($buf) { + do_next(); + } else { + print "Queue empty"; + Irssi::timeout_add_once(100, + sub { + print "Done"; + Irssi::command("/showhist"); + }, ''); + + } + } +} + +sub cmd_dohist { + my ($args, $server, $witem) = @_; + + print "Inserting fake history..."; + @hist_queue = @fake_history; + do_next(); + + +} + +sub _key { + Irssi::signal_emit('gui key pressed', ord($_[0])); +} +sub _down { + _key($_) for ("\e", "[", "B"); +} + +sub cmd_showhist { + my ($args, $server, $witem) = @_; + #print "Args: " . Dumper(\@_); + dump_history(win($witem)); +} + +sub dump_history { + my ($win) = @_; + my @history = $win->get_history_lines(); + my $i = 0; + + print "---------HISTORY-----------"; + + for (@history) { + $i++; + printf("%02d: %s", $i, $_); + } + print "---------------------------"; +} + +init(); + + + # my $m = 0; + # for my $entry (@fake_history) { + # my $n = 0; + # $m++; + # for my $char (split '', $entry) { + # $n++; + # Irssi::timeout_add_once(100 * $n * $m, + # sub { print "$char of $entry scheduled at " + # . (100 * $n * $m); + # _key($char) + # }, ''); + # } + # Irssi::timeout_add_once(100 * $n * $m, + # sub { print "Down scheduled at " + # . (100 * $n * $m); + # _down(); + # }, ''); + # } diff --git a/feature-tests/incomplete.pl b/feature-tests/incomplete.pl new file mode 100644 index 0000000..022aebe --- /dev/null +++ b/feature-tests/incomplete.pl @@ -0,0 +1,108 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); + +my $completions = { + 'horse' => ['horsie', 0], + 'pig' => ['piggy', 1], + 'fruit bat' => ['multi word string?', 1], + 'what' => ['stop that', 0], + + } + +sub init { + Irssi::settings_add_str('incomplete', 'incomplete_database', + Irssi::get_irssi_dir() . '/incomplete.db'); + + + Irssi::signal_add_first 'complete word', \&sig_complete_word; +} + +sub sig_complete_word { + my ($completions, $win, $word, $prefix, $want_space) = @_; + + my $str = $prefix . $word; + foreach my $candidate (keys %$completions) { + if ($str =~ m/\Q$candidate\E\s*$/) { + + } + } + $$want_space = 0; + +} + + +sub load_db { + +} + +sub save_db { + +} +init(); diff --git a/feature-tests/ixtest.pl b/feature-tests/ixtest.pl new file mode 100644 index 0000000..a49d742 --- /dev/null +++ b/feature-tests/ixtest.pl @@ -0,0 +1,69 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); diff --git a/feature-tests/key_sig.pl b/feature-tests/key_sig.pl index ef69d45..3da50ac 100644 --- a/feature-tests/key_sig.pl +++ b/feature-tests/key_sig.pl @@ -25,12 +25,22 @@ Irssi::signal_add('key created', \&sig_key_created); Irssi::signal_register({'key command' => [qw/string/]}); Irssi::signal_add_first('key command' => \&sig_key_cmd); +Irssi::signal_register({'key key' => [qw/string/]}); +Irssi::signal_add_first('key key' => \&sig_key_key); + Irssi::signal_register({'key nothing' => [qw/string/]}); -Irssi::signal_add_first('key nothing' => \&sig_key_cmd); +Irssi::signal_add_first('key nothing' => \&sig_key_nothing); Irssi::signal_register({'keyboard created' => [qw/Irssi::UI::Keyboard/]}); Irssi::signal_add_first('keyboard created' => \&sig_keyboard); +Irssi::signal_register({'key bacon' => [qw/string int int/]}); +Irssi::signal_add_first('key bacon' => \&sig_key_bacon); + +sub sig_key_bacon { + print "baconkey: " . Dumper(\@_); +} + sub sig_keyboard { my ($data) = @_; print "keyboard: " . Dumper($data); @@ -42,10 +52,22 @@ sub sig_key_cmd { } +sub sig_key_nothing { + my ($data) = @_; + print "key nothing: " . Dumper($data); + +} + +sub sig_key_key { + my ($data) = @_; + print "key key: " . Dumper($data); + +} + sub sig_key_created { my @args = @_; print "Key Created, Args: " . Dumper(\@args); } -Irssi::command("bind meta-q /echo moo"); +Irssi::command("bind meta-q key bacon"); diff --git a/feature-tests/linehax.pl b/feature-tests/linehax.pl new file mode 100644 index 0000000..33c2363 --- /dev/null +++ b/feature-tests/linehax.pl @@ -0,0 +1,158 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'linehax', + description => 'Doing various things with the ' + . 'contents of window buffers', + license => 'MIT', + updated => '$DATE' + ); + +sub find_line { + my ($win, $pattern) = @_; + + my @lines = _get_all_lines($win); + + return unless @lines; + + foreach my $line (@lines) { + next unless $line; +# $win->print("Line is: " . ref($line)); + + my ($lobj, $ltext, $lnum) = @$line; + #$win->print("Trying line: >>$ltext<<"); + if ($ltext =~ m/\Q$pattern\E/) { + #$win->print("Matched [$lnum] $lobj ($ltext)"); + return $lobj; + } + } + $win->print("No match"); + return; +} + +sub _get_all_lines { + my ($win) = @_; + my $view = $win->view; + + my $view_buffer = $view->{buffer}; + my $lines_count = $view_buffer->{lines_count}; + + my @lines; + my $line = $view_buffer->{first_line}; + + for (0..$lines_count - 1) { + push @lines, [ $line, $line->get_text(0), $_ ]; + $line = $line->next(); + } + return @lines; +} + +sub cmd_subs { + my ($str, $server, $witem) = @_; + + my $level = Irssi::MSGLEVEL_CLIENTCRAP; + + my $win; + if (defined $witem) { + $win = $witem->window(); + } + + # fallback. + $win = Irssi::active_win() unless defined $win; + + + my ($match, $replace); + + if ($str =~ m|^\s*s/(.+?)/(.*?)/\s*$|) { + #$win->print("Matched: $1, $2"); + $match = $1; + $replace = $2; + } else { + $win->print("Invalid arguments to subs: '$str'"); + return; + } + + + my @lines = _get_all_lines($win); + #$win->print(Dumper([ map { $_->get_text(0) } @lines])); + #$win->print(Dumper(\@lines)); + + my $matching_line = find_line($win, $match); + if ($matching_line) { + my $line_text = $matching_line->get_text(0); + + my $new_text = $line_text; + $new_text =~ s/\Q$match\E/$replace/g; + + if ($new_text ne $line_text) { + $win->print_after($matching_line, $level, $new_text); + $win->view()->remove_line($matching_line); + $win->view()->redraw(); + } + } else { + $win->print("No matches found for '$match'"); + } +} + +Irssi::command_bind 'subs', \&cmd_subs; diff --git a/feature-tests/lowlight.pl b/feature-tests/lowlight.pl new file mode 100644 index 0000000..1bad477 --- /dev/null +++ b/feature-tests/lowlight.pl @@ -0,0 +1,80 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); + + +Irssi::signal_add_first 'print text', \&sig_print_text; +#Irssi::signal_add '', + + +sub sig_print_text { + my ($dest, $text, $stripped_text) = @_; + + Irssi::signal_continue($dest, $text, $stripped_text); +} diff --git a/feature-tests/rejoin-unban.pl b/feature-tests/rejoin-unban.pl new file mode 100644 index 0000000..ea43220 --- /dev/null +++ b/feature-tests/rejoin-unban.pl @@ -0,0 +1,83 @@ + +use strict; +use warnings; + +use Data::Dumper; + +# not sure of hte original source author, but probably based on +# autorejoin.pl: http://scripts.irssi.org/html/autorejoin.pl.html + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble, dunno original source', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'GPLv2', + updated => '$DATE' + ); + + +use Irssi; +use Irssi::Irc; + + +sub event_rejoin_kick { + my ($server, $data) = @_; + my ($channel, $nick) = split(/ +/, $data); + + return if ($server->{nick} ne $nick); + + my $chanrec = $server->channel_find($channel); + my $password = $chanrec->{key} if ($chanrec); + + Irssi::print "Rejoining $channel..."; + + $server->send_raw("JOIN $channel $password"); +} + +sub event_rejoin_unban { + my ($server, $data, $nick, $address) = @_; + my ($target, $text) = $data =~ /^(\S*)\s:(.*)/; + + if ($text =~ m/(\w+) has been unbanned from (#?\w+)/) { + my ($nick, $channel) = ($1, $2); + my $chanrec = $server->channel_find($channel); + my $password = $chanrec->{key} if ($chanrec); + + Irssi::print "Rejoining $channel..."; + $server->command("JOIN $channel $password"); + } +} + +sub event_unban { + my ($server, $data) = @_; + my ($nick, $channel) = split(/ +/, $data); + + Irssi::print "Attempting unban on $channel..."; + $server->send_raw("PRIVMSG ChanServ unban $channel"); +} + +sub sig_msg_kick { + my ($server, $channel, $victim, $kicker, $addr, $reason) = @_; + +} + +sub sig_msg_notice { + my ($server, $msg, $nick, $addr, $target) = @_; + +} + +sub sig_event_joinfail_banned { + +} + +sub init { + + Irssi::signal_add('message kick', 'sig_msg_kick'); + Irssi::signal_add('message notice', 'sig_msg_notice'); + Irssi::signal_add('event 474', 'sig_event_joinfail_banned'); + +} + +init(); diff --git a/feature-tests/scriptwatcher.pl b/feature-tests/scriptwatcher.pl new file mode 100644 index 0000000..9d92cb8 --- /dev/null +++ b/feature-tests/scriptwatcher.pl @@ -0,0 +1,82 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +What the hell is this script for? + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); +Irssi::signal_register({ 'script error' => ['Irssi::Script', 'string'] }); +Irssi::signal_add_first 'script error', \&sig_script_error; + +sub sig_script_error { + my ($script, $msg) = @_; + + $script //= 'nothing'; + $msg //= 'empty'; + print "Script is: " . Dumper($script); + print "Message is: $msg"; + + +} diff --git a/feature-tests/template.pl b/feature-tests/template.pl index a49d742..a5f59fa 100644 --- a/feature-tests/template.pl +++ b/feature-tests/template.pl @@ -67,3 +67,35 @@ our %IRSSI = ( license => 'MIT', updated => '$DATE' ); + +my $NAME = $IRSSI{name}; +my $DEBUG = 0; + +sub DEBUG () { $DEBUG } + +sub _debug_print { + my ($msg) = @_; + Irssi::active_window()->print($msg); +} + +sub sig_setup_changed { + $DEBUG = Irssi::settings_get_bool($NAME . '_debug'); + _debug_print($NAME . ': debug enabled') if $DEBUG; +} + +sub init { + Irssi::theme_register + ([ + verbatim => '[$*]', + script_loaded => 'Loaded script {hilight $0} v$1', + ]); + Irssi::settings_add_bool($NAME, $NAME . '_debug', 0); + Irssi::signal_add('setup changed', \&sig_setup_changed); + + sig_setup_changed(); + + Irssi::printformat(Irssi::MSGLEVEL_CLIENTCRAP, + 'script_loaded', $NAME, $VERSION); +} + +init(); diff --git a/fixery/README.md b/fixery/README.md new file mode 100644 index 0000000..c0e48df --- /dev/null +++ b/fixery/README.md @@ -0,0 +1,23 @@ +# The Fixery + +This is a dumping ground for toxic scripts that have been washed in totally +pure and healthy dispersant solution, thus removing all oil, greasiness, and +probably heartbeat. + +Actually, it's just me rewriting or refactoring existing scripts from +http://scripts.irssi.org because I spot some bug with them, or decide +they need extra features. + +When there are some here, this will be a shiney exciting list: + +* `awayproxy` - Auto-sets /away when all your clients disconnect from a proxying + irssi instance. It can also collect up messages during your absence, and + either /notice them to you when you rejoin, or batch them up and send + periodically in an email. + + * **TODO** Add proper settings support + * **TODO** + +* `trackbar` - Shows a trackbar with where you last read up to in a buffer + + * **TODO** Verify this works with other settings for irssi time output diff --git a/fixery/adv_windowlist.pl b/fixery/adv_windowlist.pl new file mode 100644 index 0000000..4ca18fe --- /dev/null +++ b/fixery/adv_windowlist.pl @@ -0,0 +1,2564 @@ +# {{{ debug + +#BEGIN { +# open STDERR, '>', '/home/ailin/wlstatwarnings'; +#}; + +# FIXME COULD SOMEONE PLEASE TELL ME HOW TO SHUT UP +# +# ... +# Variable "*" will not stay shared at (eval *) line *. +# Variable "*" will not stay shared at (eval *) line *. +# ... +# Can't locate package Irssi::Nick for @Irssi::Irc::Nick::ISA at (eval *) line *. +# ... +# +# THANKS + +# }}} + +# if you don't know how to operate folds, type zn + +# {{{ header + +use strict; +use warnings; + +use Irssi (); # which is the minimum required version of Irssi ? +use Irssi::TextUI; + +our $VERSION = '0.7'; +our %IRSSI = ( + original_authors => q(BC-bd, Veli, Timo Sirainen, ). + q(Wouter Coekaerts, Jean-Yves Lefort), # (decadix) + original_contact => q(bd@bc-bd.org, veli@piipiip.net, tss@iki.fi, ). + q(wouter@coekaerts.be, jylefort@brutele.be), + authors => q(Nei), + contact => q(Nei@QuakeNet), + url => "http://ai.onetrix.net/", + name => q(awl), + description => q(Adds a permanent advanced window list on the right or ). + q(in a statusbar.), + description2 => q(Based on chanact.pl which was apparently based on ). + q(lightbar.c and nicklist.pl with various other ideas ). + q(from random scripts.), + license => q(GNU GPLv2 or later), +); + +# }}} + +# {{{ *** D O C U M E N T A T I O N *** + +# adapted by Nei + +############### +# {{{ original comment +# ########### +# # Adds new powerful and customizable [Act: ...] item (chanelnames,modes,alias). +# # Lets you give alias characters to windows so that you can select those with +# # meta-<char>. +# # +# # for irssi 0.8.2 by bd@bc-bd.org +# # +# # inspired by chanlist.pl by 'cumol@hammerhart.de' +# # +# ######### +# # {{{ Contributors +# ######### +# # +# # veli@piipiip.net /window_alias code +# # qrczak@knm.org.pl chanact_abbreviate_names +# # qerub@home.se Extra chanact_show_mode and chanact_chop_status +# # }}} +# }}} +# +# {{{ FURTHER THANKS TO +# ############ +# # buu, fxn, Somni, Khisanth, integral, tybalt89 for much support in any aspect perl +# # and the channel in general ( #perl @ freenode ) and especially the ir_* functions +# # +# # Valentin 'senneth' Batz ( vb@g-23.org ) for the pointer to grep.pl, continuous support +# # and help in digging up ir_strip_codes +# # +# # OnetrixNET technology networks for the debian environment +# # +# # Monkey-Pirate.com / Spaceman Spiff for the webspace +# # +# }}} + +###### +# {{{ M A I N P R O B L E M +##### +# +# It is impossible to place the awl on a statusbar together with other items, +# because I do not know how to calculate the size that it is going to get +# granted, and therefore I cannot do the linebreaks properly. +# This is what is missing to make a nice script out of awl. +# If you have any ideas, please contact me ASAP :). +# }}} +###### + +###### +# {{{ UTF-8 PROBLEM +##### +# +# Please help me find a solution to this: +# this be your statusbar, it is using up the maximum term size +# [[1=1]#abc [2=2]#defghi] +# +# now consider this example:i +# "ascii" characters are marked with ., utf-8 characters with * +# [[1=1]#... [2=2]#...***] +# +# you should think that this is how it would be displayed? WRONG! +# [[1=1]#... [2=2]#...*** ] +# +# this is what Irssi does.. I believe my length calculating code to be correct, +# however, I'd love to be proven wrong (or receive any other fix, too, of +# course!) +# }}} +###### + +######### +# {{{ USAGE +### +# +# copy the script to ~/.irssi/scripts/ +# +# In irssi: +# +# /script load awl +# +# +# Hint: to get rid of the old [Act:] display +# /statusbar window remove act +# +# to get it back: +# /statusbar window add -after lag -priority 10 act +# }}} +########## +# {{{ OPTIONS +######## +# +# {{{ /set awl_display_nokey <string> +# /set awl_display_key <string> +# /set awl_display_nokey_active <string> +# /set awl_display_key_active <string> +# * string : Format String for one window. The following $'s are expanded: +# $C : Name +# $N : Number of the Window +# $Q : meta-Keymap +# $H : Start highlighting +# $S : Stop highlighting +# /+++++++++++++++++++++++++++++++++, +# | **** I M P O R T A N T : **** | +# | | +# | don't forget to use $S if you | +# | used $H before! | +# | | +# '+++++++++++++++++++++++++++++++++/ +# XXX NOTE ON *_active: there is a BUG somewhere in the length +# XXX calculation. currently it's best to NOT remove $H/$S from those +# XXX settings if you use it in the non-active settings. +# }}} +# {{{ /set awl_separator <string> +# * string : Charater to use between the channel entries +# you'll need to escape " " space and "$" like this: +# "/set awl_separator \ " +# "/set awl_separator \$" +# and {}% like this: +# "/set awl_separator %{" +# "/set awl_separator %}" +# "/set awl_separator %%" +# (reason being, that the separator is used inside a {format }) +# }}} +# {{{ /set awl_prefer_name <ON|OFF> +# * this setting decides whether awl will use the active_name (OFF) or the +# window name as the name/caption in awl_display_*. +# That way you can rename windows using /window name myownname. +# }}} +# {{{ /set awl_hide_data <num> +# * num : hide the window if its data_level is below num +# set it to 0 to basically disable this feature, +# 1 if you don't want windows without activity to be shown +# 2 to show only those windows with channel text or hilight +# 3 to show only windows with hilight +# }}} +# {{{ /set awl_maxlines <num> +# * num : number of lines to use for the window list (0 to disable, negative +# lock) +# }}} +# {{{ /set awl_columns <num> +# * num : number of columns to use in screen mode (0 for unlimited) +# }}} +# {{{ /set awl_block <num> +# * num : width of a column in screen mode (negative values = block display) +# /+++++++++++++++++++++++++++++++++, +# | ****** W A R N I N G ! ****** | +# | | +# | If your block display looks | +# | DISTORTED, you need to add the | +# | following line to your .theme | +# | file under | +# | abstracts = { : | +# | | +# | sb_act_none = "%n$*"; | +# | | +# '+++++++++++++++++++++++++++++++++/ +#.02:08:26. < shi> Irssi::current_theme()->get_format <.. can this be used? +# }}} +# {{{ /set awl_sbar_maxlength <ON|OFF> +# * if you enable the maxlength setting, the block width will be used as a +# maximum length for the non-block statusbar mode too. +# }}} +# {{{ /set awl_height_adjust <num> +# * num : how many lines to leave empty in screen mode +# }}} +# {{{ /set awl_sort <-data_level|-last_line|refnum> +# * you can change the window sort order with this variable +# -data_level : sort windows with hilight first +# -last_line : sort windows in order of activity +# refnum : sort windows by window number +# }}} +# {{{ /set awl_placement <top|bottom> +# /set awl_position <num> +# * these settings correspond to /statusbar because awl will create +# statusbars for you +# (see /help statusbar to learn more) +# }}} +# {{{ /set awl_all_disable <ON|OFF> +# * if you set awl_all_disable to ON, awl will also remove the +# last statusbar it created if it is empty. +# As you might guess, this only makes sense with awl_hide_data > 0 ;) +# }}} +# {{{ /set awl_automode <sbar|screen|emulate_lightbar> +# * this setting defines whether the window list is shown in statusbars or +# whether the screen hack is used (from nicklist.pl) +# }}} +# }}} +########## +# {{{ COMMANDS +######## +# {{{ /awl paste <ON|OFF|TOGGLE> +# * enables or disables the screen hack windowlist. This is useful when you +# want to mark & copy text that you want to paste somewhere (hence the +# name). (ON means AWL disabled!) +# This is nicely bound to a function key for example. +# }}} +# {{{ /awl redraw +# * redraws the screen hack windowlist. There are many occasions where the +# screen hack windowlist can get destroyed so you can use this command to +# fix it. +# }}} +# }}} +### +# {{{ WISHES +#### +# +# if you fiddle with my mess, provide me with your fixes so I can benefit as well +# +# Nei =^.^= ( QuakeNet accountname: ailin ) +# }}} + +# }}} + +# {{{ modules + +#use Class::Classless; +#use Term::Info; + +# }}} + +# {{{ global variables + +my $replaces = '[=]'; # AARGH!!! (chars that are always surrounded by weird + # colour codes by Irssi) + +my $actString = []; # statusbar texts +my $currentLines = 0; +my $resetNeeded; # layout/screen has changed, redo everything +my $needRemake; # "normal" changes +#my $callcount = 0; +sub GLOB_QUEUE_TIMER () { 100 } +my $globTime = undef; # timer to limit remake() calls + +my $EXTRA_HILIGHTS_STR = ''; +my $EXTRA_HILIGHTS = {}; + +my $SCREEN_MODE; +my $DISABLE_SCREEN_TEMP; +my $currentColumns = 0; +my $screenResizing; +my ($screenHeight, $screenWidth); +my $screenansi = bless { + NAME => 'Screen::ANSI', + PARENTS => [], + METHODS => { + dcs => sub { "\033P" }, + st => sub { "\033\\"}, + } +}, 'Class::Classless::X'; +#my $terminfo = new Term::Info 'xterm'; # xterm here, make this modular +# {{{{{{{{{{{{{{{ +my $terminfo = bless { # xterm here, make this modular + NAME => 'Term::Info::xterm', + PARENTS => [], + METHODS => { + # civis=\E[?25l, + civis => sub { "\033[?25l" }, + # sc=\E7, + sc => sub { "\0337" }, + # cup=\E[%i%p1%d;%p2%dH, + cup => sub { shift;shift; "\033[" . ($_[0] + 1) . ';' . ($_[1] + 1) . 'H' }, + # el=\E[K, + el => sub { "\033[K" }, + # rc=\E8, + rc => sub { "\0338" }, + # cnorm=\E[?25h, + cnorm => sub { "\033[?25h" }, + # setab=\E[4%p1%dm, + setab => sub { shift;shift; "\033[4" . $_[0] . 'm' }, + # setaf=\E[3%p1%dm, + setaf => sub { shift;shift; "\033[3" . $_[0] . 'm' }, + # bold=\E[1m, + bold => sub { "\033[1m" }, + # blink=\E[5m, + blink => sub { "\033[5m" }, + # rev=\E[7m, + rev => sub { "\033[7m" }, + # op=\E[39;49m, + op => sub { "\033[39;49m" }, + } +}, 'Class::Classless::X'; +# }}}}}}}}}}}}}}} + + +sub setc () { + $IRSSI{name} +} + +sub set ($) { + setc . '_' . shift +} + +# }}} + + +# {{{ sbar mode + +my %statusbars; # currently active statusbars + +# maybe I should just tie the array ? +sub add_statusbar { + for (@_) { + # add subs + for my $l ($_) { { + no strict 'refs'; # :P + *{set$l} = sub { awl($l, @_) }; + }; } + Irssi::command('statusbar ' . (set$_) . ' reset'); + Irssi::command('statusbar ' . (set$_) . ' enable'); + if (lc Irssi::settings_get_str(set 'placement') eq 'top') { + Irssi::command('statusbar ' . (set$_) . ' placement top'); + } + if ((my $x = int Irssi::settings_get_int(set 'position')) != 0) { + Irssi::command('statusbar ' . (set$_) . ' position ' . $x); + } + Irssi::command('statusbar ' . (set$_) . ' add -priority 100 -alignment left barstart'); + Irssi::command('statusbar ' . (set$_) . ' add ' . (set$_)); + Irssi::command('statusbar ' . (set$_) . ' add -priority 100 -alignment right barend'); + Irssi::command('statusbar ' . (set$_) . ' disable'); + Irssi::statusbar_item_register(set$_, '$0', set$_); + $statusbars{$_} = {}; + } +} + +sub remove_statusbar { + for (@_) { + Irssi::command('statusbar ' . (set$_) . ' reset'); + Irssi::statusbar_item_unregister(set$_); # XXX does this actually work ? + # DO NOT REMOVE the sub before you have unregistered it :)) + for my $l ($_) { { + no strict 'refs'; + undef &{set$l}; + }; } + delete $statusbars{$_}; + } +} + +sub syncLines { + my $temp = $currentLines; + $currentLines = @$actString; + #Irssi::print("current lines: $temp new lines: $currentLines"); + my $currMaxLines = Irssi::settings_get_int(set 'maxlines'); + if ($currMaxLines > 0 and @$actString > $currMaxLines) { + $currentLines = $currMaxLines; + } + elsif ($currMaxLines < 0) { + $currentLines = abs($currMaxLines); + } + return if ($temp == $currentLines); + if ($currentLines > $temp) { + for ($temp .. ($currentLines - 1)) { + add_statusbar($_); + Irssi::command('statusbar ' . (set$_) . ' enable'); + } + } + else { + for ($_ = ($temp - 1); $_ >= $currentLines; $_--) { + Irssi::command('statusbar ' . (set$_) . ' disable'); + remove_statusbar($_); + } + } +} + +# FIXME implement $get_size_only check, and user $item->{min|max-size} ?? +sub awl { + my ($line, $item, $get_size_only) = @_; + + if ($needRemake) { + $needRemake = undef; + remake(); + } + + my $text = $actString->[$line]; # DO NOT set the actual $actString->[$line] to '' here or + $text = '' unless defined $text; # you'll screw up the statusbar counter ($currentLines) + $item->default_handler($get_size_only, $text, '', 1); +} + +# remove old statusbars +my %killBar; +sub get_old_status { + my ($textDest, $cont, $cont_stripped) = @_; + if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq '' + and !defined($textDest->{'server'}) + ) { + my $name = quotemeta(set ''); + if ($cont_stripped =~ m/^$name(\d+)\s/) { $killBar{$1} = {}; } + Irssi::signal_stop(); + } +} +sub killOldStatus { + %killBar = (); + Irssi::signal_add_first('print text' => 'get_old_status'); + Irssi::command('statusbar'); + Irssi::signal_remove('print text' => 'get_old_status'); + remove_statusbar(keys %killBar); +} +#killOldStatus(); + +# end sbar mode }}} + + +# {{{ keymaps + +my %keymap; + +sub get_keymap { + my ($textDest, undef, $stripped_text) = @_; + #if ($textDest->{'level'} == 524288 and $textDest->{'target'} eq '') { + if ($textDest->{level} == Irssi::MSGLEVEL_CLIENTCRAP and + $textDest->{target} eq '') { + if (not defined($textDest->{server})) { + + my $bind = $stripped_text; + if ($bind =~ m/((?:meta-)+)(.)\s+change_window (\d+)/) { + + my ($level, $key, $window) = ($1, $2, $3); + my $numlevel = ($level =~ y/-//) - 1; + + $keymap{$window} = ('-' x $numlevel) . "$key"; + + } elsif ($bind =~ m/((?:meta-)+)(.)\s+window goto (\d+|(?:#\w+))/) { + # TODO: make this work moar better + my ($level, $key, $window) = ($1, $2, $3); + my $numlevel = ($level =~ y/-//) - 1; + + $keymap{$window} = ('-' x $numlevel) . "$key"; + } + + Irssi::signal_stop(); + } + + } +} + +sub update_keymap { + %keymap = (); + Irssi::signal_remove('command bind' => 'watch_keymap'); + Irssi::signal_add_first('print text' => 'get_keymap'); + Irssi::command('bind'); # stolen from grep + Irssi::signal_remove('print text' => 'get_keymap'); + Irssi::signal_add('command bind' => 'watch_keymap'); + Irssi::timeout_add_once(100, 'eventChanged', undef); +} + +# watch keymap changes +sub watch_keymap { + Irssi::timeout_add_once(1000, 'update_keymap', undef); +} + +update_keymap(); + +# end keymaps }}} + +# {{{ format handling + +# a bad way do do expansions but who cares +sub expand { + my ($string, %format) = @_; + my ($exp, $repl); + $string =~ s/\$$exp/$repl/g while (($exp, $repl) = each(%format)); + return $string; +} + +my %strip_table = ( + # fe-common::core::formats.c:format_expand_styles + # delete format_backs format_fores bold_fores other stuff + (map { $_ => '' } (split //, '04261537' . 'kbgcrmyw' . 'KBGCRMYW' . 'U9_8:|FnN>#[')), + # escape + (map { $_ => $_ } (split //, '{}%')), +); +sub ir_strip_codes { # strip %codes + my $o = shift; + $o =~ s/(%(.))/exists $strip_table{$2} ? $strip_table{$2} : $1/gex; + $o +} + +sub ir_parse_special { + my $o; my $i = shift; + #if ($_[0]) { # for the future?!? + # eval { + # $o = $_[0]->parse_special($i); + # }; + # unless ($@) { + # return $o; + # } + #} + my $win = shift || Irssi::active_win(); + my $server = Irssi::active_server(); + if (ref $win and ref $win->{'active'}) { + $o = $win->{'active'}->parse_special($i); + } + elsif (ref $win and ref $win->{'active_server'}) { + $o = $win->{'active_server'}->parse_special($i); + } + elsif (ref $server) { + $o = $server->parse_special($i); + } + else { + $o = Irssi::parse_special($i); + } + $o +} +sub ir_parse_special_protected { + my $o; my $i = shift; + $i =~ s/ + ( \\. ) | # skip over escapes (maybe) + ( \$[^% $\]+ ) # catch special variables + / + if ($1) { $1 } + elsif ($2) { my $i2 = $2; ir_fe(ir_parse_special($i2, @_)) } + else { $& } + /gex; + $i +} + + +sub sb_ctfe { # Irssi::current_theme->format_expand wrapper + Irssi::current_theme->format_expand( + shift, + ( + Irssi::EXPAND_FLAG_IGNORE_REPLACES + | + ($_[0]?0:Irssi::EXPAND_FLAG_IGNORE_EMPTY) + ) + ) +} +sub sb_expand { # expand {format }s (and apply parse_special for $vars) + ir_parse_special( + sb_ctfe(shift) + ) +} +sub sb_strip { + ir_strip_codes( + sb_expand(shift) + ); # does this get us the actual length of that s*ty bar :P ? +} +sub sb_length { + # unicode cludge, d*mn broken Irssi + # screw it, this will fail from broken joining anyway (and cause warnings) + my $term_type = 'term_type'; + if (Irssi::version > 20040819) { # this is probably wrong, but I don't know + # when the setting name got changed + $term_type = 'term_charset'; + } + #if (lc Irssi::settings_get_str($term_type) eq '8bit' + # or Irssi::settings_get_str($term_type) =~ /^iso/i + #) { + # length(sb_strip(shift)) + #} + #else { + my $temp = sb_strip(shift); + # try to get the displayed width + my $length; + eval { + require Text::CharWidth; + $length = Text::CharWidth::mbswidth($temp); + }; + unless ($@) { + return $length; + } + else { + if (lc Irssi::settings_get_str($term_type) eq 'utf-8') { + # try to switch on utf8 + eval { + no warnings; + require Encode; + #$temp = Encode::decode_utf8($temp); # thanks for the hint, but I have my + # # reasons for _utf8_on + Encode::_utf8_on($temp); + }; + } + # there is nothing more I can do + length($temp) + } + #} +} + +# !!! G*DD*MN Irssi is adding an additional layer of backslashitis per { } layer +# !!! AND I still don't know what I need to escape. +# !!! and NOONE else seems to know or care either. +# !!! f*ck open source. I mean it. +# XXX any Irssi::print debug statement leads to SEGFAULT - why ? + +# major parts of the idea by buu (#perl @ freenode) +# thanks to fxn and Somni for debugging +# while ($_[0] =~ /(.)/g) { +# my $c = $1; # XXX sooo... goto kills $1 +# if ($q eq '%') { goto ESC; } + +## <freenode:#perl:tybalt89> s/%(.)|(\{)|(\})|(\\|\$)/$1?$1:$2?($level++,$2):$3?($level>$min_level&&$level--,$3):'\\'x(2**$level-1).$4/ge; # untested... +sub ir_escape { + my $min_level = $_[1] || 0; my $level = $min_level; + my $o = shift; + $o =~ s/ + ( %. ) | # $1 + ( \{ ) | # $2 + ( \} ) | # $3 + ( \\ ) | # $4 + ( \$(?=[^\\]) ) | # $5 + ( \$ ) # $6 + / + if ($1) { $1 } # %. escape + elsif ($2) { $level++; $2 } # { nesting start + elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end + elsif ($4) { '\\'x(2**$level) } # \ needs \\escaping + elsif ($5) { '\\'x(2**$level-1) . '$' . '\\'x(2**$level-1) } # and $ needs even more because of "parse_special" + else { '\\'x(2**$level-1) . '$' } # $ needs \$ escaping + /gex; + $o +} +#sub ir_escape { +# my $min_level = $_[1] || 0; my $level = $min_level; +# my $o = shift; +# $o =~ s/ +# ( %. ) | # $1 +# ( \{ ) | # $2 +# ( \} ) | # $3 +# ( \\ | \$ ) # $4 +# / +# if ($1) { $1 } # %. escape +# elsif ($2) { $level++; $2 } # { nesting start +# elsif ($3) { if ($level > $min_level) { $level--; } $3 } # } nesting end +# else { '\\'x(2**($level-1)-1) . $4 } # \ or $ needs \\escaping +# /gex; +# $o +#} + +sub ir_fe { # try to fix format stuff + my $x = shift; + # XXX why do I have to use two/four % here instead of one/two ?? + # answer: you screwed up in ir_escape + $x =~ s/([%{}])/%$1/g; + #$x =~ s/(\\|\$|[ ])/\\$1/g; # XXX HOW CAN I HANDLE THE SPACES CORRECTLY XXX + $x =~ s/(\\|\$)/\\$1/g; + #$x =~ s/(\$(?=.))|(\$)/$1?"\\\$\\":"\\\$"/ge; # I think this should be here + # # (logic), but it doesn't work + # # that way :P + #$x =~ s/\\/\\\\/g; # that's right, escape escapes + $x +} +sub ir_ve { # escapes special vars but leave colours alone + my $x = shift; + #$x =~ s/([%{}])/%$1/g; + $x =~ s/(\\|\$|[ ])/\\$1/g; + $x +} + +my %ansi_table; +{ + my ($i, $j, $k) = (0, 0, 0); + %ansi_table = ( + # fe-common::core::formats.c:format_expand_styles + # do format_backs + (map { $_ => $terminfo->setab($i++) } (split //, '01234567' )), + # do format_fores + (map { $_ => $terminfo->setaf($j++) } (split //, 'krgybmcw' )), + # do bold_fores + (map { $_ => $terminfo->bold() . + $terminfo->setaf($k++) } (split //, 'KRGYBMCW')), + # reset + #(map { $_ => $terminfo->op() } (split //, 'nN')), + (map { $_ => $terminfo->op() } (split //, 'n')), + (map { $_ => "\033[0m" } (split //, 'N')), # XXX quick and DIRTY + # flash/bright + F => $terminfo->blink(), + # reverse + 8 => $terminfo->rev(), + # bold + (map { $_ => $terminfo->bold() } (split //, '9_')), + # delete other stuff + (map { $_ => '' } (split //, ':|>#[')), + # escape + (map { $_ => $_ } (split //, '{}%')), + ) +} +sub formats_to_ansi_basic { + my $o = shift; + $o =~ s/(%(.))/exists $ansi_table{$2} ? $ansi_table{$2} : $1/gex; + $o +} + +sub lc1459 ($) { my $x = shift; $x =~ y/A-Z][\^/a-z}{|~/; $x } +Irssi::settings_add_str(setc, 'banned_channels', ''); +Irssi::settings_add_bool(setc, 'banned_channels_on', 0); +my %banned_channels = map { lc1459($_) => undef } +split ' ', Irssi::settings_get_str('banned_channels'); +Irssi::settings_add_str(setc, 'fancy_abbrev', 'fancy'); + +sub _error { + my $msg = join '', @_; + Irssi::print(setc . ':', Irssi::MSGLEVEL_CLIENTERROR); +} + +# }}} + +# {{{ extra channel hilights + +sub rereadChanHilights { + my $hilight_str = Irssi::settings_get_str(set 'extra_hilights'); + + # only update if changed. + return if $hilight_str eq $EXTRA_HILIGHTS_STR; + + $EXTRA_HILIGHTS_STR = $hilight_str + + return unless length $hilight_str; + + # kill all existing entries + $EXTRA_HILIGHTS = {}; + + my @entries = split /\s+/, $hilight_str; + + my $pattern = qr|^ (?:([^/]*)/) # $1: optional '$tag/' capturing $tag + ([^:]+): # $2: required '$target:', capturing $target + (%.+) # $3: required '%$colour' + $|xo; + + foreach my $entry (@entries) { + + if ($entry =~ $pattern) { + my ($tag, $target, $colour) = ($1, $2, $3); + my $components = ; + + my $target_match_str = $target; + if (length $tag) { + $target_match_str = $tag . '/' . $target_match_str; + } + + $EXTRA_HILIGHTS->{$target_match_str} + = { tag => $tag, target => $target, colour => $colour }; + + } else { + _error("malformed hilight entry: '$entry'"); + } + } +} + +sub matchExtraHilight { + my ($target, $tag) = @_; + my $match = $target; + if (length $tag) { + $match = $tag . '/' . $tag; + } + if (exists $EXTRA_HILIGHTS->{$match}) { + return $EXTRA_HILIGHTS->{$match}->{colour}; + } else { + return ''; + } +} + +# }}} + +# {{{ +# {{{ main + +sub remake () { + #$callcount++; + #my $xx = $callcount; Irssi::print("starting remake [ $xx ]"); + my ($hilight, $number, $display); + my $separator = '{sb_act_sep ' . Irssi::settings_get_str(set 'separator') . + '}'; + my $custSort = Irssi::settings_get_str(set 'sort'); + my $custSortDir = 1; + if ($custSort =~ /^[-!](.*)/) { + $custSortDir = -1; + $custSort = $1; + } + + my @wins = + sort { + ( + ( (int($a->{$custSort}) <=> int($b->{$custSort})) * $custSortDir ) + || + ($a->{'refnum'} <=> $b->{'refnum'}) + ) + } Irssi::windows; + my $block = Irssi::settings_get_int(set 'block'); + my $columns = $currentColumns; + my $oldActString = $actString if $SCREEN_MODE; + $actString = $SCREEN_MODE ? [' A W L'] : []; + my $line = $SCREEN_MODE ? 1 : 0; + my $width = $SCREEN_MODE + ? + $screenWidth - abs($block)*$columns + 1 + : + ([Irssi::windows]->[0]{'width'} - sb_length('{sb x}')); + my $height = $screenHeight - abs(Irssi::settings_get_int(set + 'height_adjust')); + my ($numPad, $keyPad) = (0, 0); + my %abbrevList; + if ($SCREEN_MODE or Irssi::settings_get_bool(set 'sbar_maxlength') + or ($block < 0) + ) { + %abbrevList = (); + if (Irssi::settings_get_str('fancy_abbrev') !~ /^(no|off|head)/i) { + my @nameList = map { ref $_ ? $_->get_active_name : '' } @wins; + for (my $i = 0; $i < @nameList - 1; ++$i) { + my ($x, $y) = ($nameList[$i], $nameList[$i + 1]); + for ($x, $y) { s/^[+#!=]// } + my $res = Algorithm::LCSS::LCSS($x, $y); + if (defined $res) { + #Irssi::print("common pattern $x $y : $res"); + #Irssi::print("found at $nameList[$i] ".index($nameList[$i], + # $res)); + $abbrevList{$nameList[$i]} = int (index($nameList[$i], $res) + + (length($res) / 2)); + #Irssi::print("found at ".$nameList[$i+1]." ".index($nameList[$i+1], + # $res)); + $abbrevList{$nameList[$i+1]} = int (index($nameList[$i+1], $res) + + (length($res) / 2)); + } + } + } + if ($SCREEN_MODE or ($block < 0)) { + $numPad = length((sort { length($b) <=> length($a) } keys %keymap)[0]); + $keyPad = length((sort { length($b) <=> length($a) } values %keymap)[0]); + } + } + if ($SCREEN_MODE) { + print STDERR $screenansi->dcs(). + $terminfo->civis(). + $terminfo->sc(). + $screenansi->st(); + if (@$oldActString < 1) { + print STDERR $screenansi->dcs(). + $terminfo->cup(0, $width). + $actString->[0]. + $terminfo->el(). + $screenansi->st(); + } + } + foreach my $win (@wins) { + unless ($SCREEN_MODE) { + $actString->[$line] = '' unless defined $actString->[$line] + or Irssi::settings_get_bool(set 'all_disable'); + } + + # all stolen from chanact, what does this code do and why do we need it ? + !ref($win) && next; + + my $name = $win->get_active_name; + $name = '*' if (Irssi::settings_get_bool('banned_channels_on') and exists + $banned_channels{lc1459($name)}); + $name = $win->{'name'} if $name ne '*' and $win->{'name'} ne '' + and Irssi::settings_get_bool(set 'prefer_name'); + my $active = $win->{'active'}; + my $colour = $win->{'hilight_color'}; + if (!defined $colour) { $colour = ''; } + + if ($win->{'data_level'} < Irssi::settings_get_int(set 'hide_data')) { + next; } # for Geert + if ($win->{'data_level'} == 0) { $hilight = '{sb_act_none '; } + elsif ($win->{'data_level'} == 1) { $hilight = '{sb_act_text '; } + elsif ($win->{'data_level'} == 2) { $hilight = '{sb_act_msg '; } + elsif ($colour ne '') { $hilight = "{sb_act_hilight_color $colour "; } + elsif ($win->{'data_level'} == 3) { $hilight = '{sb_act_hilight '; } + else { $hilight = '{sb_act_special '; } + + $number = $win->{'refnum'}; + my @display = ('display_nokey'); + if (defined $keymap{$number} and $keymap{$number} ne '') { + unshift @display, map { (my $cpy = $_) =~ s/_no/_/; $cpy } @display; + } + if (Irssi::active_win->{'refnum'} == $number) { + unshift @display, map { my $cpy = $_; $cpy .= '_active'; $cpy } @display; + } + #Irssi::print("win $number [@display]: " . join '.', split //, join '<<', map { + # Irssi::settings_get_str(set $_) } @display); + $display = (grep { $_ } + map { Irssi::settings_get_str(set $_) } + @display)[0]; + #Irssi::print("win $number : " . join '.', split //, $display); + + if ($SCREEN_MODE or Irssi::settings_get_bool(set 'sbar_maxlength') + or ($block < 0) + ) { + my $baseLength = sb_length(ir_escape(ir_ve(ir_parse_special_protected(sb_ctfe( + '{sb_background}' . expand($display, + C => ir_fe('x'), + N => $number . (' 'x($numPad - length($number))), + Q => ir_fe((' 'x($keyPad - length($keymap{$number}))) . $keymap{$number}), + H => $hilight, + S => '}{sb_background}' + ), 1), $win)))) - 1; + my $diff = abs($block) - (length($name) + $baseLength); + if ($diff < 0) { # too long + if (abs($diff) >= length($name)) { $name = '' } # forget it + elsif (abs($diff) + 1 >= length($name)) { $name = substr($name, + 0, 1); } + else { + my $middle = exists $abbrevList{$name} ? + (($abbrevList{$name} + (2*(length($name) / 2)))/3) : + ((Irssi::settings_get_str('fancy_abbrev') =~ /^head/i) ? + length($name) : + (length($name) / 2)); + my $cut = int($middle - (abs($diff) / 2) + .55); + $cut = 1 if $cut < 1; + $cut = length($name) - abs($diff) - 1 if $cut > (length($name) - + abs($diff) - 1); + $name = substr($name, 0, $cut) . '~' . substr($name, $cut + + abs($diff) + 1); + } + } + elsif ($SCREEN_MODE or ($block < 0)) { + $name .= (' ' x $diff); + } + } + + my $add = ir_ve(ir_parse_special_protected(sb_ctfe('{sb_background}' . expand($display, + C => ir_fe($name), + N => $number . (' 'x($numPad - length($number))), + Q => ir_fe((' 'x($keyPad - length($keymap{$number}))) . $keymap{$number}), + H => $hilight, + S => '}{sb_background}' + ), 1), $win)); + if ($SCREEN_MODE) { + $actString->[$line] = $add; + if ((!defined $oldActString->[$line] + or $oldActString->[$line] ne $actString->[$line]) + and + $line <= ($columns * $height) + ) { + print STDERR $screenansi->dcs(). + $terminfo->cup(($line-1) % $height+1, $width + ( + abs($block) * int(($line-1) / $height))). + formats_to_ansi_basic(sb_expand(ir_escape($actString->[$line]))). + #$terminfo->el(). + $screenansi->st(); + } + $line++; + } + else { + #$temp =~ s/\{\S+?(?:\s(.*?))?\}/$1/g; + #$temp =~ s/\\\\\\\\/\\/g; # XXX I'm actually guessing here, someone point me + # # XXX to docs please + $actString->[$line] = '' unless defined $actString->[$line]; + + # XXX how can I check whether the content still fits in the bar? this would + # XXX allow awlstatus to reside on a statusbar together with other items... + if (sb_length(ir_escape($actString->[$line] . $add)) >= $width) { + # XXX doesn't correctly handle utf-8 multibyte ... help !!? + $actString->[$line] .= ' ' x ($width - sb_length(ir_escape( + $actString->[$line]))); + $line++; + } + $actString->[$line] .= $add . $separator; + # XXX if I use these prints, output layout gets screwed up... why ? + #Irssi::print("line $line: ".$actString->[$line]); + #Irssi::print("temp $line: ".$temp); + } + } + + if ($SCREEN_MODE) { + while ($line <= ($columns * $height)) { + print STDERR $screenansi->dcs(). + $terminfo->cup(($line-1) % $height+1, $width + ( + abs($block) * int(($line-1) / $height))). + $terminfo->el(). + $screenansi->st(); + $line++; + } + print STDERR $screenansi->dcs(). + $terminfo->rc(). + $terminfo->cnorm(). + $screenansi->st(); + } + else { + # XXX the Irssi::print statements lead to the MOST WEIRD results + # e.g.: the loop gets executed TWICE for p > 0 ?!? + for (my $p = 0; $p < @$actString; $p++) { # wrap each line in {sb }, escape it + my $x = $actString->[$p]; # properly, etc. + $x =~ s/\Q$separator\E([ ]*)$/$1/; + #Irssi::print("[$p]".'current:'.join'.',split//,sb_strip(ir_escape($x,0))); + #Irssi::print("assumed length before:".sb_length(ir_escape($x,0))); + $x = "{sb $x}"; + #Irssi::print("[$p]".'new:'.join'.',split//,sb_expand(ir_escape($x,0))); + #Irssi::print("[$p]".'new:'.join'.',split//,ir_escape($x,0)); + #Irssi::print("assumed length after:".sb_length(ir_escape($x,0))); + $x = ir_escape($x); + #Irssi::print("[$p]".'REALnew:'.join'.',split//,sb_strip($x)); + $actString->[$p] = $x; + # XXX any Irssi::print debug statement leads to SEGFAULT (sometimes) - why ? + } + } + #Irssi::print("remake [ $xx ] finished"); +} + +sub awlHasChanged () { + $globTime = undef; + + rereadChanHilights(); + + my $temp = ($SCREEN_MODE ? + "\\\n" . Irssi::settings_get_int(set 'block'). + Irssi::settings_get_int(set 'height_adjust') + : "!\n" . Irssi::settings_get_str(set 'placement'). + Irssi::settings_get_int(set 'position')). + Irssi::settings_get_str(set 'automode'); + if ($temp ne $resetNeeded) { wlreset(); return; } + #Irssi::print("awl has changed, calls to remake so far: $callcount"); + $needRemake = 1; + + #remake(); + if ( + ($SCREEN_MODE and !$DISABLE_SCREEN_TEMP) + or + ($needRemake and Irssi::settings_get_bool(set 'all_disable')) + or + (!Irssi::settings_get_bool(set 'all_disable') and $currentLines < 1) + ) { + $needRemake = undef; + remake(); + } + + unless ($SCREEN_MODE) { + # XXX Irssi crashes if I try to do this without timer, why ? What's the minimum + # XXX delay I need to use in the timer ? + Irssi::timeout_add_once(100, 'syncLines', undef); + + for (keys %statusbars) { + Irssi::statusbar_items_redraw(set$_); + } + } + else { + Irssi::timeout_add_once(100, 'syncColumns', undef); + } +} + +sub eventChanged () { # Implement a change queue/blocker -.-) + if (defined $globTime) { + Irssi::timeout_remove($globTime); + } # delay the update further + $globTime = Irssi::timeout_add_once(GLOB_QUEUE_TIMER, 'awlHasChanged', undef); +} + +# }}} + + +# {{{ screen mode + +sub screenFullRedraw { + my ($window) = @_; + if (!ref $window or $window->{'refnum'} == Irssi::active_win->{'refnum'}) { + $actString = []; + eventChanged(); + } +} + +sub screenSize { # from nicklist.pl + $screenResizing = 1; + # fit screen + system 'screen -x '.$ENV{'STY'}.' -X fit'; + # get size + my ($row, $col) = split ' ', `stty size`; + # set screen width + $screenWidth = $col-1; + $screenHeight = $row-1; + + # on some recent systems, "screen -X fit; screen -X width -w 50" doesn't work, needs a sleep in between the 2 commands + # so we wait a second before setting the width + Irssi::timeout_add_once(100, sub { + my ($new_irssi_width) = @_; + $new_irssi_width -= abs(Irssi::settings_get_int(set + 'block'))*$currentColumns - 1; + system 'screen -x '.$ENV{'STY'}.' -X width -w ' . $new_irssi_width; + # and then we wait another second for the resizing, and then redraw. + Irssi::timeout_add_once(10,sub {$screenResizing = 0; screenFullRedraw()}, []); + }, $screenWidth); +} + +sub screenOff { + my ($unloadMode) = @_; + Irssi::signal_remove('gui print text finished' => 'screenFullRedraw'); + Irssi::signal_remove('gui page scrolled' => 'screenFullRedraw'); + Irssi::signal_remove('window changed' => 'screenFullRedraw'); + Irssi::signal_remove('window changed automatic' => 'screenFullRedraw'); + if ($unloadMode) { + Irssi::signal_remove('terminal resized' => 'resizeTerm'); + } + system 'screen -x '.$ENV{'STY'}.' -X fit'; +} + +sub syncColumns { + return if (@$actString == 0); + my $temp = $currentColumns; + #Irssi::print("current columns $temp"); + my $height = $screenHeight - abs(Irssi::settings_get_int(set + 'height_adjust')); + $currentColumns = int(($#$actString-1) / $height) + 1; + #Irssi::print("objects in actstring:".scalar(@$actString).", screen height:". + # $height); + my $currMaxColumns = Irssi::settings_get_int(set 'columns'); + if ($currMaxColumns > 0 and $currentColumns > $currMaxColumns) { + $currentColumns = $currMaxColumns; + } + elsif ($currMaxColumns < 0) { + $currentColumns = abs($currMaxColumns); + } + return if ($temp == $currentColumns); + screenSize(); +} + +#$needRemake = 1; +sub resizeTerm () { + if ($SCREEN_MODE and !$screenResizing) { + $screenResizing = 1; + Irssi::timeout_add_once(10, 'screenSize', undef); + } + Irssi::timeout_add_once(100, 'eventChanged', undef); +} + +# }}} + + +# {{{ settings add + +Irssi::settings_add_str(setc, set 'display_nokey', '[$N]$H$C$S'); +Irssi::settings_add_str(setc, set 'display_key', '[$Q=$N]$H$C$S'); +Irssi::settings_add_str(setc, set 'display_nokey_active', ''); +Irssi::settings_add_str(setc, set 'display_key_active', ''); +Irssi::settings_add_str(setc, set 'separator', "\\ "); +Irssi::settings_add_bool(setc, set 'prefer_name', 0); +Irssi::settings_add_int(setc, set 'hide_data', 0); +Irssi::settings_add_int(setc, set 'maxlines', 9); +Irssi::settings_add_int(setc, set 'columns', 1); +Irssi::settings_add_int(setc, set 'block', 20); +Irssi::settings_add_bool(setc, set 'sbar_maxlength', 0); +Irssi::settings_add_int(setc, set 'height_adjust', 2); +Irssi::settings_add_str(setc, set 'sort', 'refnum'); +Irssi::settings_add_str(setc, set 'placement', 'bottom'); +Irssi::settings_add_int(setc, set 'position', 0); +Irssi::settings_add_bool(setc, set 'all_disable', 0); +Irssi::settings_add_str(setc, set 'automode', 'sbar'); + +# format is '[$tag/]#channel:%colour1 [$tag/]#channel:%colour2 ...' list. +Irssi::settings_add_str(setc, set 'extra_hilights', ''); + +# }}} + + +# {{{ init + +sub wlreset { + $actString = []; + $currentLines = 0; # 1; # mhmmmm .. we actually enable one line down there so + # let's try this. + #update_keymap(); + killOldStatus(); + # Register statusbar + #add_statusbar(0); + #Irssi::command('statusbar wl0 enable'); + my $was_screen_mode = $SCREEN_MODE; + if ($SCREEN_MODE = (Irssi::settings_get_str(set 'automode') =~ /screen/i) + and + !$was_screen_mode + ) { + if (!defined $ENV{'STY'}) { + Irssi::print('Screen mode can only be used in GNU screen but no '. + 'screen was found.', MSGLEVEL_CLIENTERROR); + $SCREEN_MODE = undef; + } + else { + Irssi::signal_add_last('gui print text finished' => 'screenFullRedraw'); + Irssi::signal_add_last('gui page scrolled' => 'screenFullRedraw'); + Irssi::signal_add('window changed' => 'screenFullRedraw'); + Irssi::signal_add('window changed automatic' => 'screenFullRedraw'); + } + } + elsif ($was_screen_mode and !$SCREEN_MODE) { + screenOff(); + } + $resetNeeded = ($SCREEN_MODE ? + "\\\n" . Irssi::settings_get_int(set 'block'). + Irssi::settings_get_int(set 'height_adjust') + : "!\n" . Irssi::settings_get_str(set 'placement'). + Irssi::settings_get_int(set 'position')). + Irssi::settings_get_str(set 'automode'); + resizeTerm(); +} + +wlreset(); + +# }}} + + +# {{{ unload/deinit + +my $Unload; +sub unload ($$$) { + $Unload = 1; + # pretend we didn't do anything ASAP + Irssi::timeout_add_once(10, sub { $Unload = undef; }, undef); +} +# last try to catch a sigsegv +Irssi::signal_add_first('gui exit' => sub { $Unload = undef; }); +sub UNLOAD { + # this might well crash Irssi... try /eval /script unload someotherscript ; + # /quit (= SEGFAULT !) + if ($Unload) { + $actString = ['']; # syncLines(); # XXX Irssi crashes when trying to disable + killOldStatus(); # XXX all statusbars ? + if ($SCREEN_MODE) { + screenOff('unload mode'); + } + } +} + +# }}} + + +# {{{ signals + +sub addPrintTextHook { # update on print text + return if $_[0]->{'level'} == 262144 and $_[0]->{'target'} eq '' + and !defined($_[0]->{'server'}); + if (Irssi::settings_get_str(set 'sort') =~ /^[-!]?last_line$/) { + Irssi::timeout_add_once(100, 'eventChanged', undef); + } +} + +#sub _x { my ($x, $y) = @_; ($x, sub { Irssi::print('-->signal '.$x); eval "$y();"; }) } +#sub _x { @_ } +Irssi::signal_add_first( + 'command script unload' => 'unload' +); +Irssi::signal_add_last({ + 'setup changed' => 'eventChanged', + 'print text' => 'addPrintTextHook', + 'terminal resized' => 'resizeTerm', + 'setup reread' => 'wlreset', + 'window hilight' => 'eventChanged', +}); +Irssi::signal_add({ + 'window created' => 'eventChanged', + 'window destroyed' => 'eventChanged', + 'window name changed' => 'eventChanged', + 'window refnum changed' => 'eventChanged', + 'window changed' => 'eventChanged', + 'window changed automatic' => 'eventChanged', +}); + +#Irssi::signal_add('nick mode changed', 'chanactHasChanged'); # relicts + +# }}} + +# {{{ commands + + +sub runsub { + my ($cmd) = @_; + sub { + my ($data, $server, $item) = @_; + Irssi::command_runsub($cmd, $data, $server, $item); + }; +} +Irssi::command_bind( setc() => runsub(setc()) ); +Irssi::command_bind( setc() . ' paste' => runsub(setc() . ' paste') ); +Irssi::command_bind( + setc() . ' paste on' => sub { + return unless $SCREEN_MODE; + my $was_disabled = $DISABLE_SCREEN_TEMP; + $DISABLE_SCREEN_TEMP = 1; + Irssi::print('Paste mode is now ON, '.uc(setc()).' is temporarily '. + 'disabled.'); + if (!$was_disabled) { + $screenResizing = 1; + screenOff(); + } + } +); +Irssi::command_bind( + setc() . ' paste off' => sub { + return unless $SCREEN_MODE; + my $was_disabled = $DISABLE_SCREEN_TEMP; + $DISABLE_SCREEN_TEMP = undef; + Irssi::print('Paste mode is now OFF, '.uc(setc()).' is enabled.'); + if ($was_disabled) { + $SCREEN_MODE = undef; + $screenResizing = 0; + wlreset(); + } + } +); +Irssi::command_bind( + setc() . ' paste toggle' => sub { + if ($DISABLE_SCREEN_TEMP) { + Irssi::command(setc() . ' paste off'); + } + else { + Irssi::command(setc() . ' paste on'); + } + } +); +Irssi::command_bind( + setc() . ' redraw' => sub { + return unless $SCREEN_MODE; + screenFullRedraw(); + } +); + + +# }}} + +# {{{ Algorithm::LCSS module +{ + package Algorithm::Diff; + # Skip to first "=head" line for documentation. + use strict; + + use integer; # see below in _replaceNextLargerWith() for mod to make + # if you don't use this + + # McIlroy-Hunt diff algorithm + # Adapted from the Smalltalk code of Mario I. Wolczko, <mario@wolczko.com> + # by Ned Konz, perl@bike-nomad.com + # Updates by Tye McQueen, http://perlmonks.org/?node=tye + + # Create a hash that maps each element of $aCollection to the set of + # positions it occupies in $aCollection, restricted to the elements + # within the range of indexes specified by $start and $end. + # The fourth parameter is a subroutine reference that will be called to + # generate a string to use as a key. + # Additional parameters, if any, will be passed to this subroutine. + # + # my $hashRef = _withPositionsOfInInterval( \@array, $start, $end, $keyGen ); + + sub _withPositionsOfInInterval + { + my $aCollection = shift; # array ref + my $start = shift; + my $end = shift; + my $keyGen = shift; + my %d; + my $index; + for ( $index = $start ; $index <= $end ; $index++ ) + { + my $element = $aCollection->[$index]; + my $key = &$keyGen( $element, @_ ); + if ( exists( $d{$key} ) ) + { + unshift ( @{ $d{$key} }, $index ); + } + else + { + $d{$key} = [$index]; + } + } + return wantarray ? %d : \%d; + } + + # Find the place at which aValue would normally be inserted into the + # array. If that place is already occupied by aValue, do nothing, and + # return undef. If the place does not exist (i.e., it is off the end of + # the array), add it to the end, otherwise replace the element at that + # point with aValue. It is assumed that the array's values are numeric. + # This is where the bulk (75%) of the time is spent in this module, so + # try to make it fast! + + sub _replaceNextLargerWith + { + my ( $array, $aValue, $high ) = @_; + $high ||= $#$array; + + # off the end? + if ( $high == -1 || $aValue > $array->[-1] ) + { + push ( @$array, $aValue ); + return $high + 1; + } + + # binary search for insertion point... + my $low = 0; + my $index; + my $found; + while ( $low <= $high ) + { + $index = ( $high + $low ) / 2; + + # $index = int(( $high + $low ) / 2); # without 'use integer' + $found = $array->[$index]; + + if ( $aValue == $found ) + { + return undef; + } + elsif ( $aValue > $found ) + { + $low = $index + 1; + } + else + { + $high = $index - 1; + } + } + + # now insertion point is in $low. + $array->[$low] = $aValue; # overwrite next larger + return $low; + } + + # This method computes the longest common subsequence in $a and $b. + + # Result is array or ref, whose contents is such that + # $a->[ $i ] == $b->[ $result[ $i ] ] + # foreach $i in ( 0 .. $#result ) if $result[ $i ] is defined. + + # An additional argument may be passed; this is a hash or key generating + # function that should return a string that uniquely identifies the given + # element. It should be the case that if the key is the same, the elements + # will compare the same. If this parameter is undef or missing, the key + # will be the element as a string. + + # By default, comparisons will use "eq" and elements will be turned into keys + # using the default stringizing operator '""'. + + # Additional parameters, if any, will be passed to the key generation + # routine. + + sub _longestCommonSubsequence + { + my $a = shift; # array ref or hash ref + my $b = shift; # array ref or hash ref + my $counting = shift; # scalar + my $keyGen = shift; # code ref + my $compare; # code ref + + if ( ref($a) eq 'HASH' ) + { # prepared hash must be in $b + my $tmp = $b; + $b = $a; + $a = $tmp; + } + + # Check for bogus (non-ref) argument values + if ( !ref($a) || !ref($b) ) + { + my @callerInfo = caller(1); + die 'error: must pass array or hash references to ' . $callerInfo[3]; + } + + # set up code refs + # Note that these are optimized. + if ( !defined($keyGen) ) # optimize for strings + { + $keyGen = sub { $_[0] }; + $compare = sub { my ( $a, $b ) = @_; $a eq $b }; + } + else + { + $compare = sub { + my $a = shift; + my $b = shift; + &$keyGen( $a, @_ ) eq &$keyGen( $b, @_ ); + }; + } + + my ( $aStart, $aFinish, $matchVector ) = ( 0, $#$a, [] ); + my ( $prunedCount, $bMatches ) = ( 0, {} ); + + if ( ref($b) eq 'HASH' ) # was $bMatches prepared for us? + { + $bMatches = $b; + } + else + { + my ( $bStart, $bFinish ) = ( 0, $#$b ); + + # First we prune off any common elements at the beginning + while ( $aStart <= $aFinish + and $bStart <= $bFinish + and &$compare( $a->[$aStart], $b->[$bStart], @_ ) ) + { + $matchVector->[ $aStart++ ] = $bStart++; + $prunedCount++; + } + + # now the end + while ( $aStart <= $aFinish + and $bStart <= $bFinish + and &$compare( $a->[$aFinish], $b->[$bFinish], @_ ) ) + { + $matchVector->[ $aFinish-- ] = $bFinish--; + $prunedCount++; + } + + # Now compute the equivalence classes of positions of elements + $bMatches = + _withPositionsOfInInterval( $b, $bStart, $bFinish, $keyGen, @_ ); + } + my $thresh = []; + my $links = []; + + my ( $i, $ai, $j, $k ); + for ( $i = $aStart ; $i <= $aFinish ; $i++ ) + { + $ai = &$keyGen( $a->[$i], @_ ); + if ( exists( $bMatches->{$ai} ) ) + { + $k = 0; + for $j ( @{ $bMatches->{$ai} } ) + { + + # optimization: most of the time this will be true + if ( $k and $thresh->[$k] > $j and $thresh->[ $k - 1 ] < $j ) + { + $thresh->[$k] = $j; + } + else + { + $k = _replaceNextLargerWith( $thresh, $j, $k ); + } + + # oddly, it's faster to always test this (CPU cache?). + if ( defined($k) ) + { + $links->[$k] = + [ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ]; + } + } + } + } + + if (@$thresh) + { + return $prunedCount + @$thresh if $counting; + for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] ) + { + $matchVector->[ $link->[1] ] = $link->[2]; + } + } + elsif ($counting) + { + return $prunedCount; + } + + return wantarray ? @$matchVector : $matchVector; + } + + sub traverse_sequences + { + my $a = shift; # array ref + my $b = shift; # array ref + my $callbacks = shift || {}; + my $keyGen = shift; + my $matchCallback = $callbacks->{'MATCH'} || sub { }; + my $discardACallback = $callbacks->{'DISCARD_A'} || sub { }; + my $finishedACallback = $callbacks->{'A_FINISHED'}; + my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { }; + my $finishedBCallback = $callbacks->{'B_FINISHED'}; + my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ ); + + # Process all the lines in @$matchVector + my $lastA = $#$a; + my $lastB = $#$b; + my $bi = 0; + my $ai; + + for ( $ai = 0 ; $ai <= $#$matchVector ; $ai++ ) + { + my $bLine = $matchVector->[$ai]; + if ( defined($bLine) ) # matched + { + &$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine; + &$matchCallback( $ai, $bi++, @_ ); + } + else + { + &$discardACallback( $ai, $bi, @_ ); + } + } + + # The last entry (if any) processed was a match. + # $ai and $bi point just past the last matching lines in their sequences. + + while ( $ai <= $lastA or $bi <= $lastB ) + { + + # last A? + if ( $ai == $lastA + 1 and $bi <= $lastB ) + { + if ( defined($finishedACallback) ) + { + &$finishedACallback( $lastA, @_ ); + $finishedACallback = undef; + } + else + { + &$discardBCallback( $ai, $bi++, @_ ) while $bi <= $lastB; + } + } + + # last B? + if ( $bi == $lastB + 1 and $ai <= $lastA ) + { + if ( defined($finishedBCallback) ) + { + &$finishedBCallback( $lastB, @_ ); + $finishedBCallback = undef; + } + else + { + &$discardACallback( $ai++, $bi, @_ ) while $ai <= $lastA; + } + } + + &$discardACallback( $ai++, $bi, @_ ) if $ai <= $lastA; + &$discardBCallback( $ai, $bi++, @_ ) if $bi <= $lastB; + } + + return 1; + } + + sub traverse_balanced + { + my $a = shift; # array ref + my $b = shift; # array ref + my $callbacks = shift || {}; + my $keyGen = shift; + my $matchCallback = $callbacks->{'MATCH'} || sub { }; + my $discardACallback = $callbacks->{'DISCARD_A'} || sub { }; + my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { }; + my $changeCallback = $callbacks->{'CHANGE'}; + my $matchVector = _longestCommonSubsequence( $a, $b, 0, $keyGen, @_ ); + + # Process all the lines in match vector + my $lastA = $#$a; + my $lastB = $#$b; + my $bi = 0; + my $ai = 0; + my $ma = -1; + my $mb; + + while (1) + { + + # Find next match indices $ma and $mb + do { + $ma++; + } while( + $ma <= $#$matchVector + && !defined $matchVector->[$ma] + ); + + last if $ma > $#$matchVector; # end of matchVector? + $mb = $matchVector->[$ma]; + + # Proceed with discard a/b or change events until + # next match + while ( $ai < $ma || $bi < $mb ) + { + + if ( $ai < $ma && $bi < $mb ) + { + + # Change + if ( defined $changeCallback ) + { + &$changeCallback( $ai++, $bi++, @_ ); + } + else + { + &$discardACallback( $ai++, $bi, @_ ); + &$discardBCallback( $ai, $bi++, @_ ); + } + } + elsif ( $ai < $ma ) + { + &$discardACallback( $ai++, $bi, @_ ); + } + else + { + + # $bi < $mb + &$discardBCallback( $ai, $bi++, @_ ); + } + } + + # Match + &$matchCallback( $ai++, $bi++, @_ ); + } + + while ( $ai <= $lastA || $bi <= $lastB ) + { + if ( $ai <= $lastA && $bi <= $lastB ) + { + + # Change + if ( defined $changeCallback ) + { + &$changeCallback( $ai++, $bi++, @_ ); + } + else + { + &$discardACallback( $ai++, $bi, @_ ); + &$discardBCallback( $ai, $bi++, @_ ); + } + } + elsif ( $ai <= $lastA ) + { + &$discardACallback( $ai++, $bi, @_ ); + } + else + { + + # $bi <= $lastB + &$discardBCallback( $ai, $bi++, @_ ); + } + } + + return 1; + } + + sub prepare + { + my $a = shift; # array ref + my $keyGen = shift; # code ref + + # set up code ref + $keyGen = sub { $_[0] } unless defined($keyGen); + + return scalar _withPositionsOfInInterval( $a, 0, $#$a, $keyGen, @_ ); + } + + sub LCS + { + my $a = shift; # array ref + my $b = shift; # array ref or hash ref + my $matchVector = _longestCommonSubsequence( $a, $b, 0, @_ ); + my @retval; + my $i; + for ( $i = 0 ; $i <= $#$matchVector ; $i++ ) + { + if ( defined( $matchVector->[$i] ) ) + { + push ( @retval, $a->[$i] ); + } + } + return wantarray ? @retval : \@retval; + } + + sub LCS_length + { + my $a = shift; # array ref + my $b = shift; # array ref or hash ref + return _longestCommonSubsequence( $a, $b, 1, @_ ); + } + + sub LCSidx + { + my $a= shift @_; + my $b= shift @_; + my $match= _longestCommonSubsequence( $a, $b, 0, @_ ); + my @am= grep defined $match->[$_], 0..$#$match; + my @bm= @{$match}[@am]; + return \@am, \@bm; + } + + sub compact_diff + { + my $a= shift @_; + my $b= shift @_; + my( $am, $bm )= LCSidx( $a, $b, @_ ); + my @cdiff; + my( $ai, $bi )= ( 0, 0 ); + push @cdiff, $ai, $bi; + while( 1 ) { + while( @$am && $ai == $am->[0] && $bi == $bm->[0] ) { + shift @$am; + shift @$bm; + ++$ai, ++$bi; + } + push @cdiff, $ai, $bi; + last if ! @$am; + $ai = $am->[0]; + $bi = $bm->[0]; + push @cdiff, $ai, $bi; + } + push @cdiff, 0+@$a, 0+@$b + if $ai < @$a || $bi < @$b; + return wantarray ? @cdiff : \@cdiff; + } + + sub diff + { + my $a = shift; # array ref + my $b = shift; # array ref + my $retval = []; + my $hunk = []; + my $discard = sub { + push @$hunk, [ '-', $_[0], $a->[ $_[0] ] ]; + }; + my $add = sub { + push @$hunk, [ '+', $_[1], $b->[ $_[1] ] ]; + }; + my $match = sub { + push @$retval, $hunk + if 0 < @$hunk; + $hunk = [] + }; + traverse_sequences( $a, $b, + { MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ ); + &$match(); + return wantarray ? @$retval : $retval; + } + + sub sdiff + { + my $a = shift; # array ref + my $b = shift; # array ref + my $retval = []; + my $discard = sub { push ( @$retval, [ '-', $a->[ $_[0] ], "" ] ) }; + my $add = sub { push ( @$retval, [ '+', "", $b->[ $_[1] ] ] ) }; + my $change = sub { + push ( @$retval, [ 'c', $a->[ $_[0] ], $b->[ $_[1] ] ] ); + }; + my $match = sub { + push ( @$retval, [ 'u', $a->[ $_[0] ], $b->[ $_[1] ] ] ); + }; + traverse_balanced( + $a, + $b, + { + MATCH => $match, + DISCARD_A => $discard, + DISCARD_B => $add, + CHANGE => $change, + }, + @_ + ); + return wantarray ? @$retval : $retval; + } + + ######################################## + my $Root= __PACKAGE__; + package Algorithm::Diff::_impl; + use strict; + + sub _Idx() { 0 } # $me->[_Idx]: Ref to array of hunk indices + # 1 # $me->[1]: Ref to first sequence + # 2 # $me->[2]: Ref to second sequence + sub _End() { 3 } # $me->[_End]: Diff between forward and reverse pos + sub _Same() { 4 } # $me->[_Same]: 1 if pos 1 contains unchanged items + sub _Base() { 5 } # $me->[_Base]: Added to range's min and max + sub _Pos() { 6 } # $me->[_Pos]: Which hunk is currently selected + sub _Off() { 7 } # $me->[_Off]: Offset into _Idx for current position + sub _Min() { -2 } # Added to _Off to get min instead of max+1 + + sub Die + { + require Carp; + Carp::confess( @_ ); + } + + sub _ChkPos + { + my( $me )= @_; + return if $me->[_Pos]; + my $meth= ( caller(1) )[3]; + Die( "Called $meth on 'reset' object" ); + } + + sub _ChkSeq + { + my( $me, $seq )= @_; + return $seq + $me->[_Off] + if 1 == $seq || 2 == $seq; + my $meth= ( caller(1) )[3]; + Die( "$meth: Invalid sequence number ($seq); must be 1 or 2" ); + } + + sub getObjPkg + { + my( $us )= @_; + return ref $us if ref $us; + return $us . "::_obj"; + } + + sub new + { + my( $us, $seq1, $seq2, $opts ) = @_; + my @args; + for( $opts->{keyGen} ) { + push @args, $_ if $_; + } + for( $opts->{keyGenArgs} ) { + push @args, @$_ if $_; + } + my $cdif= Algorithm::Diff::compact_diff( $seq1, $seq2, @args ); + my $same= 1; + if( 0 == $cdif->[2] && 0 == $cdif->[3] ) { + $same= 0; + splice @$cdif, 0, 2; + } + my @obj= ( $cdif, $seq1, $seq2 ); + $obj[_End] = (1+@$cdif)/2; + $obj[_Same] = $same; + $obj[_Base] = 0; + my $me = bless \@obj, $us->getObjPkg(); + $me->Reset( 0 ); + return $me; + } + + sub Reset + { + my( $me, $pos )= @_; + $pos= int( $pos || 0 ); + $pos += $me->[_End] + if $pos < 0; + $pos= 0 + if $pos < 0 || $me->[_End] <= $pos; + $me->[_Pos]= $pos || !1; + $me->[_Off]= 2*$pos - 1; + return $me; + } + + sub Base + { + my( $me, $base )= @_; + my $oldBase= $me->[_Base]; + $me->[_Base]= 0+$base if defined $base; + return $oldBase; + } + + sub Copy + { + my( $me, $pos, $base )= @_; + my @obj= @$me; + my $you= bless \@obj, ref($me); + $you->Reset( $pos ) if defined $pos; + $you->Base( $base ); + return $you; + } + + sub Next { + my( $me, $steps )= @_; + $steps= 1 if ! defined $steps; + if( $steps ) { + my $pos= $me->[_Pos]; + my $new= $pos + $steps; + $new= 0 if $pos && $new < 0; + $me->Reset( $new ) + } + return $me->[_Pos]; + } + + sub Prev { + my( $me, $steps )= @_; + $steps= 1 if ! defined $steps; + my $pos= $me->Next(-$steps); + $pos -= $me->[_End] if $pos; + return $pos; + } + + sub Diff { + my( $me )= @_; + $me->_ChkPos(); + return 0 if $me->[_Same] == ( 1 & $me->[_Pos] ); + my $ret= 0; + my $off= $me->[_Off]; + for my $seq ( 1, 2 ) { + $ret |= $seq + if $me->[_Idx][ $off + $seq + _Min ] + < $me->[_Idx][ $off + $seq ]; + } + return $ret; + } + + sub Min { + my( $me, $seq, $base )= @_; + $me->_ChkPos(); + my $off= $me->_ChkSeq($seq); + $base= $me->[_Base] if !defined $base; + return $base + $me->[_Idx][ $off + _Min ]; + } + + sub Max { + my( $me, $seq, $base )= @_; + $me->_ChkPos(); + my $off= $me->_ChkSeq($seq); + $base= $me->[_Base] if !defined $base; + return $base + $me->[_Idx][ $off ] -1; + } + + sub Range { + my( $me, $seq, $base )= @_; + $me->_ChkPos(); + my $off = $me->_ChkSeq($seq); + if( !wantarray ) { + return $me->[_Idx][ $off ] + - $me->[_Idx][ $off + _Min ]; + } + $base= $me->[_Base] if !defined $base; + return ( $base + $me->[_Idx][ $off + _Min ] ) + .. ( $base + $me->[_Idx][ $off ] - 1 ); + } + + sub Items { + my( $me, $seq )= @_; + $me->_ChkPos(); + my $off = $me->_ChkSeq($seq); + if( !wantarray ) { + return $me->[_Idx][ $off ] + - $me->[_Idx][ $off + _Min ]; + } + return + @{$me->[$seq]}[ + $me->[_Idx][ $off + _Min ] + .. ( $me->[_Idx][ $off ] - 1 ) + ]; + } + + sub Same { + my( $me )= @_; + $me->_ChkPos(); + return wantarray ? () : 0 + if $me->[_Same] != ( 1 & $me->[_Pos] ); + return $me->Items(1); + } + + my %getName; + %getName= ( + same => \&Same, + diff => \&Diff, + base => \&Base, + min => \&Min, + max => \&Max, + range=> \&Range, + items=> \&Items, # same thing + ); + + sub Get + { + my $me= shift @_; + $me->_ChkPos(); + my @value; + for my $arg ( @_ ) { + for my $word ( split ' ', $arg ) { + my $meth; + if( $word !~ /^(-?\d+)?([a-zA-Z]+)([12])?$/ + || not $meth= $getName{ lc $2 } + ) { + Die( $Root, ", Get: Invalid request ($word)" ); + } + my( $base, $name, $seq )= ( $1, $2, $3 ); + push @value, scalar( + 4 == length($name) + ? $meth->( $me ) + : $meth->( $me, $seq, $base ) + ); + } + } + if( wantarray ) { + return @value; + } elsif( 1 == @value ) { + return $value[0]; + } + Die( 0+@value, " values requested from ", + $Root, "'s Get in scalar context" ); + } + + + my $Obj= getObjPkg($Root); + no strict 'refs'; + + for my $meth ( qw( new getObjPkg ) ) { + *{$Root."::".$meth} = \&{$meth}; + *{$Obj ."::".$meth} = \&{$meth}; + } + for my $meth ( qw( + Next Prev Reset Copy Base Diff + Same Items Range Min Max Get + _ChkPos _ChkSeq + ) ) { + *{$Obj."::".$meth} = \&{$meth}; + } + +}; +{ + package Algorithm::LCSS; + + use strict; + { + no strict 'refs'; + *traverse_sequences = \&Algorithm::Diff::traverse_sequences; + } + + sub _tokenize { [split //, $_[0]] } + + sub CSS { + my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0; + my ( $seq1, $seq2, @match, $from_match ); + my $i = 0; + if ( $is_array ) { + $seq1 = $_[0]; + $seq2 = $_[1]; + traverse_sequences( $seq1, $seq2, { + MATCH => sub { push @{$match[$i]}, $seq1->[$_[0]]; $from_match = 1 }, + DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match }, + DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match }, + }); + } + else { + $seq1 = _tokenize($_[0]); + $seq2 = _tokenize($_[1]); + traverse_sequences( $seq1, $seq2, { + MATCH => sub { $match[$i] .= $seq1->[$_[0]]; $from_match = 1 }, + DISCARD_A => sub { do{$i++; $from_match = 0} if $from_match }, + DISCARD_B => sub { do{$i++; $from_match = 0} if $from_match }, + }); + } + return \@match; + } + + sub CSS_Sorted { + my $match = CSS(@_); + if ( ref $_[0] eq 'ARRAY' ) { + @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match + } + else { + @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match + } + return $match; + } + + sub LCSS { + my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0; + my $css = CSS(@_); + my $index; + my $length = 0; + if ( $is_array ) { + for( my $i = 0; $i < @$css; $i++ ) { + next unless @{$css->[$i]}>$length; + $index = $i; + $length = @{$css->[$i]}; + } + } + else { + for( my $i = 0; $i < @$css; $i++ ) { + next unless length($css->[$i])>$length; + $index = $i; + $length = length($css->[$i]); + } + } + return $css->[$index]; + } + +}; +# }}} +#{{{ Class::Classless module +{ + package Class::Classless; + use strict; + use vars qw(@ISA); + use Carp; + + @ISA = (); + + ########################################################################### + + @Class::Classless::X::ISA = (); + + ########################################################################### + ########################################################################### + + sub Class::Classless::X::AUTOLOAD { + # This's the big dispatcher. + + my $it = shift @_; + my $m = ($Class::Classless::X::AUTOLOAD =~ m/([^:]+)$/s ) + ? $1 : $Class::Classless::X::AUTOLOAD; + + croak "Can't call Class::Classless methods (like $m) without an object" + unless ref $it; # sanity, basically. + + my $prevstate; + $prevstate = ${shift @_} + if scalar(@_) && defined($_[0]) && + ref($_[0]) eq 'Class::Classless::CALLSTATE::SHIMMY' + ; # A shim! we were called via $callstate->NEXT + + my $no_fail = $prevstate ? $prevstate->[3] : undef; + my $i = $prevstate ? ($prevstate->[1] + 1) : 0; + # where to start scanning + my $lineage; + + # Get the linearization of the ISA tree + if($prevstate) { + $lineage = $prevstate->[2]; + } elsif(defined $it->{'ISA_CACHE'} and ref $it->{'ISA_CACHE'} ){ + $lineage = $it->{'ISA_CACHE'}; + } else { + $lineage = [ &Class::Classless::X::ISA_TREE($it) ]; + } + + # Was: + #my @lineage = + # $prevstate ? @{$prevstate->[2]} + # : &Class::Classless::X::ISA_TREE($it); + # # Get the linearization of the ISA tree + # # ISA-memoization happens in the ISA_TREE function. + + for(; $i < @$lineage; ++$i) { + + if( !defined($no_fail) and exists($lineage->[$i]{'NO_FAIL'}) ) { + $no_fail = ($lineage->[$i]{'NO_FAIL'} || 0); + # so the first NO_FAIL sets it + } + + if( ref($lineage->[$i]{'METHODS'} || 0) # sanity + && exists($lineage->[$i]{'METHODS'}{$m}) + ){ + # We found what we were after. Now see what to do with it. + my $v = $lineage->[$i]{'METHODS'}{$m}; + return $v unless defined $v and ref $v; + + if(ref($v) eq 'CODE') { # normal case, I expect! + # Used to have copying of the arglist here. + # But it was apparently useless, so I deleted it + unshift @_, + $it, # $_[0] -- target object + # a NEW callstate + bless([$m, $i, $lineage, $no_fail, $prevstate ? 1 : 0], + 'Class::Classless::CALLSTATE' + ), # $_[1] -- the callstate + ; + goto &{ $v }; # yes, magic goto! bimskalabim! + } + return @$v if ref($v) eq '_deref_array'; + return $$v if ref($v) eq '_deref_scalar'; + return $v; # fallthru + } + } + + if($m eq 'DESTROY') { # mitigate DESTROY-lookup failure at global destruction + # should be impossible + } else { + if($no_fail || 0) { + return; + } + croak "Can't find ", $prevstate ? 'NEXT method' : 'method', + " $m in ", $it->{'NAME'} || $it, + " or any ancestors\n"; + } + } + + ########################################################################### + ########################################################################### + + sub Class::Classless::X::DESTROY { + # noop + } + + ########################################################################### + sub Class::Classless::X::ISA_TREE { + # The linearizer! + # Returns the search path for $_[0], starting with $_[0] + # Possibly memoized. + + # I stopped being able to understand this algorithm about five + # minutes after I wrote it. + use strict; + + my $set_cache = 0; # flag to set the cache on the way out + + if(exists($_[0]{'ISA_CACHE'})) { + return @{$_[0]{'ISA_CACHE'}} + if defined $_[0]{'ISA_CACHE'} + and ref $_[0]{'ISA_CACHE'}; + + # Otherwise, if exists but is not a ref, it's a signal that it should + # be replaced at the earliest, with a listref + $set_cache = 1; + } + + my $has_mi = 0; # set to 0 on the first node we see with 2 parents! + # First, just figure out what's in the tree. + my %last_child = ($_[0] => 1); # as if already seen + + # if $last_child{$x} == $y, that means: + # 1) incidentally, we've passed the node $x before. + # 2) $x is the last child of $y, + # so that means that $y can be pushed to the stack only after + # we've pushed $x to the stack. + + my @tree_nodes; + { + my $current; + my @in_stack = ($_[0]); + while(@in_stack) { + next unless + defined($current = shift @in_stack) + && ref($current) # sanity + && ref($current->{'PARENTS'} || 0) # sanity + ; + + push @tree_nodes, $current; + + $has_mi = 1 if @{$current->{'PARENTS'}} > 1; + unshift + @in_stack, + map { + if(exists $last_child{$_}) { # seen before! + $last_child{$_} = $current; + (); # seen -- don't re-explore + } else { # first time seen + $last_child{$_} = $current; + $_; # first time seen -- explore now + } + } + @{$current->{'PARENTS'}} + ; + } + + # If there was no MI, then that first scan was sufficient. + unless($has_mi) { + $_[0]{'ISA_CACHE'} = \@tree_nodes if $set_cache; + return @tree_nodes; + } + + # Otherwise, toss this list and rescan, consulting %last_child + } + + # $last_child{$parent} holds the last (or only) child of $parent + # in this tree. When walking the tree this time, only that + # child is authorized to put its parent on the @in_stack. + # And that's the only way a node can get added to @in_stack, + # except for $_[0] (the start node) being there at the beginning. + + # Now, walk again, but this time exploring parents the LAST + # time seen in the tree, not the first. + + my @out; + { + my $current; + my @in_stack = ($_[0]); + while(@in_stack) { + next unless defined($current = shift @in_stack) && ref($current); + push @out, $current; # finally. + unshift + @in_stack, + grep( + ( + defined($_) # sanity + && ref($_) # sanity + && $last_child{$_} eq $current, + ), + # I'm lastborn (or onlyborn) of this parent + # so it's OK to explore now + @{$current->{'PARENTS'}} + ) + if ref($current->{'PARENTS'} || 0) # sanity + ; + } + + unless(scalar(@out) == scalar(keys(%last_child))) { + # the counts should be equal + my %good_ones; + @good_ones{@out} = (); + croak + "ISA tree for " . + ($_[0]{'NAME'} || $_[0]) . + " is apparently cyclic, probably involving the nodes " . + nodelist( grep { ref($_) && !exists $good_ones{$_} } + values(%last_child) ) + . "\n"; + } + } + #print "Contents of out: ", nodelist(@out), "\n"; + + $_[0]{'ISA_CACHE'} = \@out if $set_cache; + return @out; + } + + ########################################################################### + + sub Class::Classless::X::can { # NOT like UNIVERSAL::can ... + # return 1 if $it is capable of the method given -- otherwise 0 + my($it, $m) = @_[0,1]; + return undef unless ref $it; + + croak "undef is not a valid method name" unless defined($m); + croak "null-string is not a valid method name" unless length($m); + + foreach my $o (&Class::Classless::X::ISA_TREE($it)) { + return 1 + if ref($o->{'METHODS'} || 0) # sanity + && exists $o->{'METHODS'}{$m}; + } + + return 0; + } + + + ########################################################################### + + sub Class::Classless::X::isa { # Like UNIVERSAL::isa + # Returns true for $X->isa($Y) iff $Y is $X or is an ancestor of $X. + + return unless ref($_[0]) && ref($_[1]); + return scalar(grep {$_ eq $_[1]} &Class::Classless::X::ISA_TREE($_[0])); + } + + ########################################################################### + + sub nodelist { join ', ', map { "" . ($_->{'NAME'} || $_) . ""} @_ } + + ########################################################################### + ########################################################################### + ########################################################################### + # Methods for the CALLSTATE class. + # Basically, CALLSTATE objects represent the state of the dispatcher, + # frozen at the moment when the method call was dispatched to the + # appropriate sub. + # In the grand scheme of things, this needn't be a class -- I could + # have just made the callstate data-object be a hash with documented + # keys, or a closure that responded to only certain parameters, + # etc. But I like it this way. And I like being able to say simply + # $cs->NEXT + # Yes, these are a bit cryptically written, but it's behoovy for + # them to be very very efficient. + + @Class::Classless::ISA = (); + sub Class::Classless::CALLSTATE::found_name { $_[0][0] } + # the method name called and found + sub Class::Classless::CALLSTATE::found_depth { $_[0][1] } + # my depth in the lineage + sub Class::Classless::CALLSTATE::lineage { @{$_[0][2]} } + # my lineage + sub Class::Classless::CALLSTATE::target { $_[0][2][ 0 ] } + # the object that's the target -- same as $_[0] for the method called + sub Class::Classless::CALLSTATE::home { $_[0][2][ $_[0][1] ] } + # the object I was found in + sub Class::Classless::CALLSTATE::sub_found { + $_[0][2][ $_[0][1] ]{'METHODS'}{ $_[0][0] } + } # the routine called + + sub Class::Classless::CALLSTATE::no_fail { $_[0][3] } + sub Class::Classless::CALLSTATE::set_no_fail_true { $_[0][3] = 1 } + sub Class::Classless::CALLSTATE::set_fail_false { $_[0][3] = 0 } + sub Class::Classless::CALLSTATE::set_fail_undef { $_[0][3] = undef } + + sub Class::Classless::CALLSTATE::via_next { $_[0][4] } + + sub Class::Classless::CALLSTATE::NEXT { + #croak "NEXT needs at least one argument: \$cs->NEXT('method'...)" + # unless @_ > 1; + # no longer true. + my $cs = shift @_; + my $m = shift @_; # which may be (or come out) undef... + $m = $cs->[0] unless defined $m; # the method name called and found + + ($cs->[2][0])->$m( + bless( \$cs, 'Class::Classless::CALLSTATE::SHIMMY' ), + @_ + ); + } + + ########################################################################### +}; +#}}} + +############### +### +# +# {{{ *** C h a n g e l o g *** +# +# 0.6ca +# - add screen support (from nicklist.pl) +# - rename to adv_windowlist.pl (advanced window list) since it isn't just a +# window list status bar (wlstat) anymore +# - names can now have a max length and window names can be used +# - fixed a bug with block display in screen mode and statusbar mode +# - added space handling to ir_fe and removed it again +# - now handling formats on my own +# - added warning about missing sb_act_none abstract leading to +# - display*active settings +# - added warning about the bug in awl_display_(no)key_active settings +# +# 0.5d +# - add setting to also hide the last statusbar if empty (awl_all_disable) +# - reverted to old utf8 code to also calculate broken utf8 length correctly +# - simplified dealing with statusbars in wlreset +# - added a little tweak for the renamed term_type somewhere after Irssi 0.8.9 +# - fixed bug in handling channel #$$ +# - typo on line 200 spotted by f0rked +# - reset background colour at the beginning of an entry +# +# 0.4d +# - fixed order of disabling statusbars +# - several attempts at special chars, without any real success +# and much more weird new bugs caused by this +# - setting to specify sort order +# - reduced timeout values +# - added awl_hide_data for Geert Hauwaerts ( geert@irssi.org ) :) +# - make it so the dynamic sub is actually deleted +# - fix a bug with removing of the last separator +# - take into consideration parse_special +# +# 0.3b +# - automatically kill old statusbars +# - reset on /reload +# - position/placement settings +# +# 0.2 +# - automated retrieval of key bindings (thanks grep.pl authors) +# - improved removing of statusbars +# - got rid of status chop +# +# 0.1 +# - rewritten to suit my needs +# - based on chanact 0.5.5 +# }}} +# vim: se fdm=marker tw=80 : diff --git a/fixery/awayproxy.pl b/fixery/awayproxy.pl new file mode 100644 index 0000000..d0b33dd --- /dev/null +++ b/fixery/awayproxy.pl @@ -0,0 +1,329 @@ +################################################################################ +## WARNING!! BAD ENGLISH BELOW :P +## +## This script is designed for those who have been using muh irc bouncer. +## Basicly this script just monitors the proxy module and if new client +## connects it sets you automatically back from away state and when client +## disconnects it sets you automatically away if you arent allready away. +## +## Other hand if you dont use irssi-proxy you still have a good reason to +## use this if you want to forward messages that come to you while +## you are away to email box. +## This is useful for forwarding messages to an SMS-gateway ;) +## +## btw.. if you find any bugs or have any ideas for development of this +## script dont hesitate to send msg to BCOW@IrcNET +## or send email to anttip@n0-life.com +## +#### Version history: +# 0.1 +# * basic functionality +# 0.2b +# * a patch from Wulf that gives a user ability to change the autoaway reason. +# * Added away_level parameter that gives you ability to control how many +# clients there can be connected to the irssi_proxy module before you are +# set away. +# * You arent set away when disconnecting from the irssi_proxy if you already +# are away. This means that your current away reason isn't changed. +# * Sends cumulated away messages back to the client when it connects to the +# irssi_proxy module. +# 0.2c +# * Fixes bug where cummulated messages weren't sent. +# * Code cleanup. +# * Text wrapping to standart 80x24 text console. +# * Added debug mode. +# * Added script modes. +# * Got rid of crappy irssi setings system. +# * New logging expansion capability, either time or line based. +# 0.2d +# * Micro fix to get back only when needed +#### To come / planned / wanted: +# * Make expansion system log several channels at once. +# * Make this script server based. +################################################################################ + +use strict; +use warnings; + +# irssi imports +use Irssi; +use Irssi::Irc; +#use vars qw($VERSION %IRSSI %config); + +our $VERSION = "0.3"; +our %IRSSI = ( + authors => "shabble,BCOW", + contact => "anttip\@n0-life.com", + name => "awayproxy", + description => "Sets nick away when client discconects from the " + . "irssi-proxy. If away gathers messages targeted to nick and forwards " + . "them to an email address.", + license => "GPLv2", + url => "http://www.n0-life.com", + ); + +sub MODE_BOTH () { 0 } +sub MODE_EMAIL () { 1 } +sub MODE_IRC () { 2 } +sub MODE_OFF () { 3 } + +sub mode_should_email { + return grep { $_ == $config{script_mode} } (MODE_EMAIL, MODE_BOTH); +} +sub mode_should_irc { + return grep { $_ == $config{script_mode} } (MODE_IRC, MODE_BOTH); +} + +my %config = + ( + + # After how much seconds we can check if there are any messages to send? + check_interval => 45, + + # this setting controls that when this amout of clients are connected to the + # proxy module script sets you away. If you set this to 0 you are set away when + # no clients are connected to the proxy module. If you set this to lets say 5 + # then you will be set away allways when the amount of clients connected to the + # proxy module is 5 or under. + away_level => 0, + + # Controls expansion mode. This mode records pub msgs that come after one with + # your nick in it. you can use line counting or time counting. + # 0 - off + # line - line counting + # time - time counting + expansion_mode => 'time', + + # How many lines include after start line? + expansion_lines => 12, + + # After how many seconds stop gathering msgs? + expansion_timeout => 90, + + # script operation mode: + # 0 - to send messages both to email and when you get back to proxy + # 1 - only email + # 2 - only irc + # 3 - off + script_mode => MODE_EMAIL, + + # email address where to send the email + email_to => 'email@email.org', + + # sendmail location + sendmail => '/usr/sbin/sendmail', + + # who is the sender of the email + email_from => 'email@email.org', + + # Subject of email + email_subject => '[irssi-proxy]', + + # and the awayreason setting (Thanx Wulf) + awayreason => 'Auto-away because client has disconnected from proxy.', + + # Debugging mode + debug => 0, + + # -- Don't change anything below this line if you don't know Perl. -- + # number of clients connected + clientcount => 0, + # number of lines recorded + expansion_lines_count => 0, + + expansion_started => 0, + # the small list and archive list + awaymsglist => [], + awaymsglist_irc => [], + + ); # end of config init + +if (mode_should_email()) { + + # timeouts for check loop + _debug('Timer on, timeout: ' . $config{check_interval}); + Irssi::timeout_add($config{check_interval} * 1000, 'msgsend_check', ''); +} + +sub _debug { + if ($config{debug}) { + my $text = shift; + my $caller = caller; + Irssi::print('From ' . $caller . ":\n" . $text); + } +} + +sub msgsend_check { + # If there are any messages to send + my $count = @{$config{awaymsglist}}; + _debug("Checking for messages: $count"); + # Check if we didn't grep msgs right now + if ($count > 0 && !$config{expansion_started}) { + # Concentate messages into one text. + my $text = join "\n", @{$config{awaymsglist}}; + # Then empty list. + $config{awaymsglist} = []; + # Finally send email + _debug("Concentated msgs: $text"); + send_mail($text); + } +} + +sub send_mail { + my $text = shift; + _debug("Sending mail"); + + open my $mail_fh, '|', $config{sendmail} . " -t" + or warn "Failed to open pipe to sendmail"; + + return unless $mail_fh; + + print $mail_fh "To: $config{email_to}\n"; + print $mail_fh "From: $config{email_from}\n"; + print $mail_fh "Subject: $config{email_subject}\n"; + print $mail_fh "\n$text\n"; + close $mail_fh; +} + +sub client_connect { + my (@servers) = Irssi::servers; + + $config{clientcount}++; + + _debug("Client connected, current script mode: $config{script_mode}"); + + # setback + foreach my $server (@servers) { + # if you're away on that server send yourself back + if ($server->{usermode_away} == 1) { + $server->send_raw('AWAY :'); + # and then send the current contents of archive list as notify's to + # your self ;) + # .. weird huh? :) + # This sends all the away messages to ALL the servers where you are + # connected... this is somewhat weird i know + # but if someone wants to make a patch to this i would really + # appreciate it. + if (mode_should_irc()) { + _debug('Sending notices'); + $server->send_raw('NOTICE ' . $server->{nick} . " :$_") + for @{$config{awaymsglist_irc}}; + } + } + } + # and "clear" the irc awaymessage list + $config{awaymsglist_irc} = [] if mode_should_irc(); +} + +sub client_disconnect { + my (@servers) = Irssi::servers; + _debug('Client Disconnectted'); + + $config{clientcount}-- unless $config{clientcount} == 0; + + # setaway + if ($config{clientcount} <= $config{away_level}) { + # ok.. we have the away_level of clients connected or less. + foreach my $server (@servers) { + if ($server->{usermode_away} == "0") { + # we are not away on this server allready.. set the autoaway + # reason + $server->send_raw( + 'AWAY :' . $config{awayreason} + ); + } + } + } +} + +sub msg_pub { + my ($server, $data, $nick, $mask, $target) = @_; + + if ($config{expansion_started}) { + if ($config{expansion_mode} eq 'line') { + if ($config{expansion_lines_count} <= $config{expansion_lines} -1) { + if ($config{expansion_chan} eq $target) { + _debug("In effect from line expansion, pushing on. Cnt: " + . $config{expansion_lines_count}); + push_into_archive($nick, $mask, $target, $data); + $config{expansion_lines_count}++; + } + } else { + _debug("Line counter reached max, stopping expansion"); + $config{expansion_lines_count} = 0; + $config{expansion_started} = 0; + $config{expansion_chan} = ''; + } + } elsif ($config{expansion_mode} eq 'time') { + if ($config{expansion_chan} eq $target) { + _debug("Time expansion in effect, pushing on."); + push_into_archive($nick, $mask, $target, $data); + } + } + } elsif ($server->{usermode_away} == 1 && $data =~ /$server->{nick}/i) { + _debug("Got pub msg with my name"); + push_into_archive($nick, $mask, $target, $data); + if ($config{expansion_mode}) { + _debug("Starting expansion in mode: " . $config{expansion_mode}); + $config{expansion_started} = 1; + $config{expansion_chan} = $target; + + if ($config{expansion_mode} eq 'time') { + $config{expansion_time_out} + = Irssi::timeout_add( + $config{expansion_timeout} * 1000, + 'expansion_stop', + '' + ); + } + + } + } +} + +sub push_into_archive { + my ($nick, $mask, $target, $data) = @_; + + # simple list that is emptied on the email run + push @{$config{awaymsglist}}, "<$nick!$mask\@$target> $data" + if mode_should_email(); + # archive list that is emptied only on the client connect run + push @{$config{awaymsglist_irc}}, "<$nick!$mask\@$target> $data" + if mode_should_irc(); +} + +sub expansion_stop { + _debug("Stopping expansion from timer"); + $config{expansion_started} = 0; + $config{expansion_chan} = ''; +} + +sub msg_pri { + my ($server, $data, $nick, $address) = @_; + if ($server->{usermode_away} == 1) { + _debug("Got priv msg"); + # simple list that is emptied on the email run + push @{$config{awaymsglist}}, "<$nick!$address> $data" + if mode_should_email(); + # archive list that is emptied only on the client connect run + push @{$config{awaymsglist_irc}}, "<$nick!$address> $data" + if mode_should_irc(); + } +} + +sub init { + + Irssi::settings_add_string('awayproxy', 'awayproxy_send_mode', MODE_EMAIL); + + Irssi::signal_add_last('proxy client connected', \&sig_client_connect); + Irssi::signal_add_last('proxy client disconnected', \&sig_client_disconnect); + Irssi::signal_add_last('message public', \&sig_msg_public); + Irssi::signal_add_last('message private', \&sig_msg_private); + Irssi::signal_add('setup changed', \&sig_setup_changed); + + sig_setup_changed(); +} + +sub sig_setup_changed { + # load values from settings. +} diff --git a/fixery/grep.pl b/fixery/grep.pl new file mode 100644 index 0000000..78834be --- /dev/null +++ b/fixery/grep.pl @@ -0,0 +1,148 @@ +# /GREP [-i] [-w] [-v] [-F] <perl-regexp> <command to run> +# +# -i: match case insensitive +# -w: only print matches that form whole words +# -v: Invert the sense of matching, to print non-matching lines. +# -F: match as a fixed string, not a regexp +# +# if you want /FGREP, do: /alias FGREP GREP -F + +use Irssi; +use strict; +use Text::ParseWords; + +my $HELP_SUMMARY = "GREP [-i] [-w] [-v] [-F] <perl-regex> /irssi-command"; + +our $VERSION = "2.1"; +our %IRSSI = ( + authors => "Timo 'cras' Sirainen, Wouter Coekaerts, Tom Feist", + contact => 'tss@iki.fi, wouter@coekaerts.be', + name => "grep", + description => $HELP_SUMMARY, + license => "Public Domain", + url => "http://wouter.coekaerts.be/irssi/", + changed => "2012-02-02" +); + +my $HELP_TEXT + = [ $HELP_SUMMARY, + "", + "The following options are supported:", + " \x{02}-i\x{02}: match case insensitively", + " \x{02}-w\x{02}: only print matches that form whole words", + " \x{02}-v\x{02}: Invert the sense of matching, to print non-matching lines.", + " \x{02}-F\x{02}: match as a fixed string, not a regexp", + "", + "Examples:", + "", + " \x{02}*\x{02} /GREP -i bacon /echo I LOVE BACON", + "", + "if you want /FGREP, do: /alias FGREP GREP -F" + ]; + +my $match_pattern; +my $match_count = 0; + +my $options = { }; + +sub sig_grep_text { + my ($dest, $text, $stripped_text) = @_; + + if ($stripped_text =~ $match_pattern) { + + if (not $options->{'-v'}) { + $match_count++; + # $text = "\x{03}5" . $text . "\x{0f}"; + # $stripped_text = "\x{03}5" . $stripped_text . "\x{0f}"; + $text = $text . "bacon"; + $stripped_text = $stripped_text . "moo"; + irssi::signal_continue($dest, $text, $stripped_text); + } + } + + Irssi::signal_stop; +} + +sub cmd_grep { + my ($data, $server, $item) = @_; + + if ($data =~ m/^\s*$/) { + + Irssi::print("\x{02}GREP Error\x{02} Invalid arguments. " + . "Usage: $HELP_SUMMARY", MSGLEVEL_CLIENTERROR); + return; + } + + $options = { map { $_ => 0 } qw/-i -v -w -F/ }; + + # split the arguments, keep quotes + my @args = quotewords(' ', 1, $data); + + # search for options + while ($args[0] =~ /^-\w/) { + + my $opt_arg = shift @args; + + if (exists $options->{$opt_arg}) { + $options->{$opt_arg} = 1; + } else { + Irssi::print("Unknown option: $opt_arg", MSGLEVEL_CLIENTERROR); + return; + } + } + + # match = first argument, but remove quotes + my ($match_str) = quotewords(' ', 0, shift @args); + print "Match string >>$match_str<<"; + + # cmd = the rest (with quotes) + my $cmd = join(' ', @args); + + print "CMD >>$cmd<<"; + + if ($options->{'-F'}) { + $match_str = quotemeta($match_str); + } + + if ($options->{'-w'}) { + $match_str = '\b' . $match_str . '\b'; + } + + if ($options->{'-i'}) { + $match_str = '(?i)' . $match_str; + } + + $match_pattern = eval { + qr/$match_str/; + }; + + if ($@) { + chomp $@; + Irssi::print("\x{02}Invalid pattern\x{02}: $@", MSGLEVEL_CLIENTERROR); + return; + } + + $match_count = 0; + + Irssi::signal_add_first('print text', 'sig_grep_text'); + Irssi::signal_emit('send command', $cmd, $server, $item); + Irssi::signal_remove('print text', 'sig_grep_text'); + + if ($match_count > 0) { + Irssi::print(sprintf("Matched %d entr%s", $match_count, + $match_count == 1?"y":"ies"), + MSGLEVEL_CLIENTCRAP); + } else { + Irssi::print("No matches", MSGLEVEL_CLIENTCRAP); + } +} + +sub cmd_help_intercept_grep { + if ($_[0] =~ m/grep/i) { + Irssi::print($_, MSGLEVEL_CLIENTCRAP) for (@$HELP_TEXT); + Irssi::signal_stop; + } +} + +Irssi::command_bind('grep', 'cmd_grep'); +Irssi::command_bind('help', 'cmd_help_intercept_grep'); diff --git a/fixery/nicklist.pl b/fixery/nicklist.pl new file mode 100644 index 0000000..38a2aae --- /dev/null +++ b/fixery/nicklist.pl @@ -0,0 +1,749 @@ +# for documentation: see http://wouter.coekaerts.be/site/irssi/nicklist + +use Irssi; +use strict; +use IO::Handle; # for (auto)flush +use Fcntl; # for sysopen + +use Data::Dumper; + +our $VERSION = '0.5.0'; +our %IRSSI = ( + authors => 'Wouter Coekaerts, shabble', + contact => 'coekie@irssi.org, shabble+irssi@metavore.org', + name => 'nicklist', + description => 'draws a nicklist to another terminal, ' + . 'or at the right of your irssi in the same terminal', + license => 'GPLv2', + url => 'http://wouter.coekaerts.be/irssi, ' + . 'https://github.com/shabble/irssi-scripts' + . '/blob/master/fixery/nicklist.pl', + changed => '10/10/2011' + ); + +sub cmd_help { + print ( <<EOF +Commands: +NICKLIST HELP +NICKLIST SCROLL <number of lines> +NICKLIST SCREEN +NICKLIST FIFO +NICKLIST OFF +NICKLIST UPDATE + +For help see: http://wouter.coekaerts.be/site/irssi/nicklist + +in short: + +1. FIFO MODE +- in irssi: /NICKLIST FIFO (only the first time, to create the fifo) +- in a shell, in a window where you want the nicklist: cat ~/.irssi/nicklistfifo +- back in irssi: + /SET nicklist_heigth <height of nicklist> + /SET nicklist_width <width of nicklist> + /NICKLIST FIFO + +2. SCREEN MODE +- start irssi inside screen ("screen irssi") +- /NICKLIST SCREEN +EOF + ); +} +sub MODE_OFF () { 0 } +sub MODE_SCREEN () { 1 } +sub MODE_FIFO () { 2 } + +my $prev_lines = 0; # number of lines in previous written nicklist +my $scroll_pos = 0; # scrolling position +my $cursor_line; # line the cursor is currently on +my ($OFF, $SCREEN, $FIFO) = (0,1,2); # modes +my $mode = MODE_OFF; # current mode +my $need_redraw = 0; # nicklist needs redrawing +my $screen_resizing = 0; # terminal is being resized +my $active_channel; # (REC) + + +# TODO: have this use isupport('PREFIX') where supported to check mappings. +my $server_prefix_mapping + = { + '~' => { priority => 1, sigil => '~', mode => 'q', name => 'owner' }, + '&' => { priority => 2, sigil => '&', mode => 'a', name => 'admin' }, + '@' => { priority => 3, sigil => '@', mode => 'o', name => 'op' }, + '%' => { priority => 4, sigil => '%', mode => 'h', name => 'halfop' }, + '+' => { priority => 5, sigil => '+', mode => 'v', name => 'voice' }, + '' => { priority => 6, sigil => '', mode => '', name => 'normal' }, + }; + + +# order the sigils by priority (lowest = first) from the table above. +my @sigil_priorities = map { $_->{sigil} } + sort { $a->{priority} <=> $b->{priority} } + values %$server_prefix_mapping; + + +my $sigil_cache = {}; + +my $DEBUG = 0; + +sub _debug { + my ($msg) = @_; + Irssi::print($msg) if $DEBUG; +} + + +sub _select_prefix_umode { + my ($nick) = @_; + my $prefixes = { map { $_ => 1 } split '', $nick->{prefixes} }; + + # first check for each of the prefix sigils in given order of precedence. + for my $sigil_priority (@sigil_priorities) { + if (exists $prefixes->{$sigil_priority}) { + return $server_prefix_mapping->{$sigil_priority}; + } + } + # check other properties + if ($nick->{op}) { + return $server_prefix_mapping->{'@'}; + } elsif ($nick->{halfop}) { + return $server_prefix_mapping->{'%'}; + } elsif ($nick->{voice}) { + return $server_prefix_mapping->{'+'}; + } else { + return $server_prefix_mapping->{''}; + } + +} + +# array of hashes, containing the internal nicklist of the active channel +my @nicklist = (); +# nick => realnick +# mode => +# status => +my ($STATUS_NORMAL, $STATUS_JOINING, $STATUS_PARTING, + $STATUS_QUITING, $STATUS_KICKED, $STATUS_SPLIT) = (0,1,2,3,4,5); +# text => text to be printed +# cmp => text used to compare (sort) nicks + + +# 'cached' settings +my ($screen_prefix, $irssi_width, $height, $nicklist_width); + +sub read_settings { + + $DEBUG = Irssi::settings_get_bool('nicklist_debug'); + + $screen_prefix = Irssi::settings_get_str('nicklist_screen_prefix'); + $screen_prefix =~ s/\\e/\033/g; + + + foreach my $umode_prefix (values %$server_prefix_mapping) { + my $umode_name = $umode_prefix->{name}; + my $setting_name = 'nicklist_prefix_mode_' . $umode_name; + my $value = Irssi::settings_get_str($setting_name); + + $value = '' unless defined $value; + $value =~ s/\\e/\x1b/g; + + $sigil_cache->{$umode_name} = $value; + } + + if ($mode != MODE_SCREEN) { + $height = Irssi::settings_get_int('nicklist_height'); + } + my $new_nicklist_width = Irssi::settings_get_int('nicklist_width'); + if ($new_nicklist_width != $nicklist_width && $mode == MODE_SCREEN) { + sig_terminal_resized(); + } + $nicklist_width = $new_nicklist_width; +} + +sub update { + read_settings(); + make_nicklist(); +} + +################## +##### OUTPUT ##### +################## + +### off ### + +sub cmd_off { + if ($mode == MODE_SCREEN) { + screen_stop(); + } elsif ($mode == MODE_FIFO) { + fifo_stop(); + } +} + +### fifo ### + +sub cmd_fifo_start { + read_settings(); + my $path = Irssi::settings_get_str('nicklist_fifo_path'); + unless (-p $path) { # not a pipe + if (-e _) { # but a something else + die "$0: $path exists and is not a pipe, please remove it\n"; + } else { + require POSIX; + POSIX::mkfifo($path, 0666) or die "can\'t mkfifo $path: $!"; + Irssi::print("Fifo created. Start reading it (\"cat $path\") and try again."); + return; + } + } + if (!sysopen(FIFO, $path, O_WRONLY | O_NONBLOCK)) { # or die "can't write $path: $!"; + Irssi::print("Couldn\'t write to the fifo ($!). Please start reading the fifo (\"cat $path\") and try again."); + return; + } + FIFO->autoflush(1); + print FIFO "\033[2J\033[1;1H"; # erase screen & jump to 0,0 + $cursor_line = 0; + if ($mode == MODE_SCREEN) { + screen_stop(); + } + $mode = MODE_FIFO; + make_nicklist(); +} + +sub fifo_stop { + close FIFO; + $mode = MODE_OFF; + Irssi::print("Fifo closed."); +} + +### screen ### + +sub cmd_screen_start { + if (!defined($ENV{STY})) { + Irssi::print 'screen not detected, screen mode only works inside screen'; + return; + } + read_settings(); + if ($mode == MODE_SCREEN) { + return; + } + if ($mode == MODE_FIFO) { + fifo_stop(); + } + $mode = MODE_SCREEN; + Irssi::signal_add_last('gui print text finished', 'sig_gui_print_text_finished'); + Irssi::signal_add_last('gui page scrolled', 'sig_page_scrolled'); + Irssi::signal_add('terminal resized', 'sig_terminal_resized'); + screen_size(); + make_nicklist(); +} + +sub screen_stop { + $mode = MODE_OFF; + Irssi::signal_remove('gui print text finished', 'sig_gui_print_text_finished'); + Irssi::signal_remove('gui page scrolled', 'sig_page_scrolled'); + Irssi::signal_remove('terminal resized', 'sig_terminal_resized'); + system 'screen -x '.$ENV{STY}.' -X fit'; +} + +sub screen_size { + if ($mode != MODE_SCREEN) { + return; + } + $screen_resizing = 1; + # fit screen + system 'screen -x '.$ENV{STY}.' -X fit'; + # get size (from perldoc -q size) + my ($winsize, $row, $col, $xpixel, $ypixel); + eval 'use Term::ReadKey; ($col, $row, $xpixel, $ypixel) = GetTerminalSize'; + # require Term::ReadKey 'GetTerminalSize'; + # ($col, $row, $xpixel, $ypixel) = Term::ReadKey::GetTerminalSize; + #}; + if ($@) { # no Term::ReadKey, try the ugly way + eval { + require 'sys/ioctl.ph'; + # without this reloading doesn't work. workaround for some unknown bug + do 'asm/ioctls.ph'; + }; + + # ugly way not working, let's try something uglier, the dg-hack(tm) + # (constant for linux only?) + if ($@) { + no strict 'refs'; *TIOCGWINSZ = sub { return 0x5413 }; + } + + unless (defined &TIOCGWINSZ) { + die "Term::ReadKey not found, and ioctl 'workaround' failed. " + . "Install the Term::ReadKey perl module to use screen mode.\n"; + } + open my $tty, "+</dev/tty" or die "No tty: $!"; + unless (ioctl($tty, &TIOCGWINSZ, $winsize='')) { + die "Term::ReadKey not found, and ioctl 'workaround' failed ($!)." + . " Install the Term::ReadKey perl module to use screen mode.\n"; + } + close $tty; + ($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize); + } + + # set screen width + $irssi_width = $col - $nicklist_width - 1; + $height = $row - 1; + + # on some recent systems, "screen -X fit; screen -X width -w 50" doesn't + # work, needs a sleep in between the 2 commands so we wait a second before + # setting the width + Irssi::timeout_add_once + (1000, sub { + my ($new_irssi_width) = @_; + system 'screen -x '.$ENV{STY}.' -X width -w ' . $new_irssi_width; + # and then we wait another second for the resizing, and then redraw. + Irssi::timeout_add_once(1000, sub {$screen_resizing = 0; redraw()}, []); + }, $irssi_width); +} + +sub sig_terminal_resized { + if ($screen_resizing) { + return; + } + $screen_resizing = 1; + Irssi::timeout_add_once(1000, \&screen_size, []); +} + + +### both ### + +sub nicklist_write_start { + if ($mode == MODE_SCREEN) { + print STDERR "\033P\033[s\033\\"; # save cursor + } +} + +sub nicklist_write_end { + if ($mode == MODE_SCREEN) { + print STDERR "\033P\033[u\033\\"; # restore cursor + } +} + +sub nicklist_write_line { + my ($line, $data) = @_; + + if ($mode == MODE_SCREEN) { + print STDERR "\033P\033[" . ($line+1) . ';'. ($irssi_width+1) .'H'. $screen_prefix . $data . "\033\\"; + } elsif ($mode == MODE_FIFO) { + $data = "\033[m$data"; # reset color + if ($line == $cursor_line+1) { + $data = "\n$data"; # next line + } elsif ($line == $cursor_line) { + $data = "\033[1G".$data; # back to beginning of line + } else { + $data = "\033[".($line+1).";0H".$data; # jump + } + $cursor_line=$line; + print(FIFO $data) or fifo_stop(); + } +} + +# recalc the text of the nicklist item +sub calc_text { + my ($nick) = @_; + + # handle truncation of long nicks. + my $tmp = $nicklist_width - 3; + + my $text = $nick->{nick}; + $text =~ s/^(.{$tmp})..+$/$1\033[34m~\033[m/; + + my $mode = $nick->{mode}; + + $nick->{text} = $sigil_cache->{$mode->{name}} . $text . + (' ' x ($nicklist_width - length($nick->{nick}) - 1)); + + $nick->{cmp} = $mode->{priority} . lc($nick->{nick}); +} + +# redraw the given nick (nr) if it is visible +sub redraw_nick_nr { + my ($nr) = @_; + my $line = $nr - $scroll_pos; + if ($line >= 0 && $line < $height) { + nicklist_write_line($line, $nicklist[$nr]->{text}); + } +} + +# nick was inserted, redraw area if necessary +sub draw_insert_nick_nr { + my ($nr) = @_; + my $line = $nr - $scroll_pos; + if ($line < 0) { # nick is inserted above visible area + $scroll_pos++; # 'scroll' down :) + } elsif ($line < $height) { # line is visible + if ($mode == MODE_SCREEN) { + need_redraw(); + } elsif ($mode == MODE_FIFO) { + # reset color & insert line & write nick + my $data = "\033[m\033[L". $nicklist[$nr]->{text}; + if ($line == $cursor_line) { + $data = "\033[1G".$data; # back to beginning of line + } else { + $data = "\033[".($line+1).";1H".$data; # jump + } + $cursor_line=$line; + print(FIFO $data) or fifo_stop(); + if ($prev_lines < $height) { + $prev_lines++; # the nicklist has one line more + } + } + } +} + +sub draw_remove_nick_nr { + my ($nr) = @_; + my $line = $nr - $scroll_pos; + if ($line < 0) { # nick removed above visible area + $scroll_pos--; # 'scroll' up :) + } elsif ($line < $height) { # line is visible + if ($mode == MODE_SCREEN) { + need_redraw(); + } elsif ($mode == MODE_FIFO) { + #my $data = "\033[m\033[L[i$line]". $nicklist[$nr]->{text}; # reset color & insert line & write nick + my $data = "\033[M"; # delete line + if ($line != $cursor_line) { + $data = "\033[".($line+1)."d".$data; # jump + } + $cursor_line=$line; + print(FIFO $data) or fifo_stop(); + if (@nicklist-$scroll_pos >= $height) { + redraw_nick_nr($scroll_pos+$height-1); + } + } + } +} + +# redraw the whole nicklist +sub redraw { + $need_redraw = 0; + #make_nicklist(); + nicklist_write_start(); + my $line = 0; + ### draw nicklist ### + for (my $i=$scroll_pos;$line < $height && $i < @nicklist; $i++) { + nicklist_write_line($line++, $nicklist[$i]->{text}); + } + + ### clean up other lines ### + my $real_lines = $line; + while ($line < $prev_lines) { + nicklist_write_line($line++,' ' x $nicklist_width); + } + $prev_lines = $real_lines; + nicklist_write_end(); +} + +# redraw (with little delay to avoid redrawing to much) +sub need_redraw { + if (!$need_redraw) { + $need_redraw = 1; + Irssi::timeout_add_once(10, \&redraw, []); + } +} + +sub sig_page_scrolled { + $prev_lines = $height; # we'll need to redraw everything if he scrolled up + need_redraw; +} + +# redraw (with delay) if the window is visible (only in screen mode) +sub sig_gui_print_text_finished { + if ($need_redraw) { # there's already a redraw 'queued' + return; + } + my $window = @_[0]; + if ($window->{refnum} == Irssi::active_win->{refnum} || Irssi::settings_get_str('nicklist_screen_split_windows') eq '*') { + need_redraw; + return; + } + foreach my $win (split(/[ ,]/, Irssi::settings_get_str('nicklist_screen_split_windows'))) { + if ($window->{refnum} == $win || $window->{name} eq $win) { + need_redraw; + return; + } + } +} + +#################### +##### NICKLIST ##### +#################### + +# returns the position of the given nick(as string) in the (internal) nicklist +sub find_nick { + my ($nick) = @_; + for (my $i=0;$i < @nicklist; $i++) { + if ($nicklist[$i]->{nick} eq $nick) { + return $i; + } + } + return -1; +} + +# find position where nick should be inserted into the list +sub find_insert_pos { + my ($cmp)= @_; + for (my $i=0;$i < @nicklist; $i++) { + if ($nicklist[$i]->{cmp} gt $cmp) { + return $i; + } + } + return scalar(@nicklist); #last +} + +# make the (internal) nicklist (@nicklist) +sub make_nicklist { + @nicklist = (); + $scroll_pos = 0; + + ### get & check channel ### + my $channel = Irssi::active_win->{active}; + + if (!$channel || (ref($channel) ne 'Irssi::Irc::Channel' && ref($channel) ne + 'Irssi::Silc::Channel') || $channel->{type} ne 'CHANNEL' || + ($channel->{chat_type} ne 'SILC' && !$channel->{names_got}) ) { + + $active_channel = undef; + # no nicklist + } else { + $active_channel = $channel; + + ### make nicklist ### + my @nicks = $channel->nicks(); + + my @mode_decorated_nicks = + map { [ _select_prefix_umode($_), $_ ] } @nicks; + + my @sorted_nicks = map { $_->[1] } + sort sort_prefixed_nicks @mode_decorated_nicks; + + # TODO: find a way to reuse these prefix lookups. + #_debug(Dumper(\@sorted_nicks)); + + foreach my $nick (@sorted_nicks) { + + my $this_nick = { + nick => $nick->{nick}, + mode => _select_prefix_umode($nick), + }; + + calc_text($this_nick); + push @nicklist, $this_nick; + } + } + need_redraw(); +} + +sub sort_prefixed_nicks { + ($a->[0]->{priority} . lc $a->[1]->{nick}) + cmp + ($b->[0]->{priority} . lc $b->[1]->{nick}); +} + +# insert nick(as hash) into nicklist +# pre: cmp has to be calculated +sub insert_nick { + my ($nick) = @_; + my $nr = find_insert_pos($nick->{cmp}); + splice @nicklist, $nr, 0, $nick; + draw_insert_nick_nr($nr); +} + +# remove nick(as nr) from nicklist +sub remove_nick { + my ($nr) = @_; + splice @nicklist, $nr, 1; + draw_remove_nick_nr($nr); +} + +################### +##### ACTIONS ##### +################### + +# scroll the nicklist, arg = number of lines to scroll, positive = down, negative = up +sub cmd_scroll { + if (!$active_channel) { # not a channel active + return; + } + my @nicks=Irssi::active_win->{active}->nicks; + my $nick_count = scalar(@nicks)+0; + my $channel = Irssi::active_win->{active}; + if (!$channel || $channel->{type} ne 'CHANNEL' || !$channel->{names_got} || $nick_count <= Irssi::settings_get_int('nicklist_height')) { + return; + } + $scroll_pos += @_[0]; + + if ($scroll_pos > $nick_count - $height) { + $scroll_pos = $nick_count - $height; + } + if ($scroll_pos <= 0) { + $scroll_pos = 0; + } + need_redraw(); +} + +sub is_active_channel { + my ($server,$channel) = @_; # (channel as string) + return ($server && $server->{tag} eq $active_channel->{server}->{tag} && $server->channel_find($channel) && $active_channel && $server->channel_find($channel)->{name} eq $active_channel->{name}); +} + +sub sig_channel_wholist { # this is actualy a little late, when the names are received would be better + my ($channel) = @_; + if (Irssi::active_win->{active} && Irssi::active_win->{active}->{name} eq $channel->{name}) { # the channel joined is active + make_nicklist + } +} + +sub sig_join { + my ($server,$channel,$nick,$address) = @_; + if (!is_active_channel($server,$channel)) { + return; + } + my $newnick = { + nick => $nick, + mode => $server_prefix_mapping->{''} + }; + calc_text($newnick); + insert_nick($newnick); +} + +sub sig_kick { + my ($server, $channel, $nick, $kicker, $address, $reason) = @_; + if (!is_active_channel($server,$channel)) { + return; + } + my $nr = find_nick($nick); + if ($nr == -1) { + Irssi::print("nicklist warning: $nick was kicked from $channel, but not found in nicklist"); + } else { + remove_nick($nr); + } +} + +sub sig_part { + my ($server,$channel,$nick,$address, $reason) = @_; + if (!is_active_channel($server,$channel)) { + return; + } + my $nr = find_nick($nick); + if ($nr == -1) { + Irssi::print("nicklist warning: $nick has parted $channel, but was not found in nicklist"); + } else { + remove_nick($nr); + } + +} + +sub sig_quit { + my ($server,$nick,$address, $reason) = @_; + if ($server->{tag} ne $active_channel->{server}->{tag}) { + return; + } + my $nr = find_nick($nick); + if ($nr != -1) { + remove_nick($nr); + } +} + +sub sig_nick { + my ($server, $newnick, $oldnick, $address) = @_; + if ($server->{tag} ne $active_channel->{server}->{tag}) { + return; + } + my $nr = find_nick($oldnick); + if ($nr != -1) { # if nick was found (nickchange is in current channel) + my $nick = $nicklist[$nr]; + remove_nick($nr); + + $nick->{nick} = $newnick; + + calc_text($nick); + insert_nick($nick); + } +} + +sub sig_mode { + my ($channel, $nick, $setby, $mode, $type) = @_; # (nick and channel as rec) + if ($channel->{server}->{tag} ne $active_channel->{server}->{tag} || $channel->{name} ne $active_channel->{name}) { + return; + } + my $nr = find_nick($nick->{nick}); + if ($nr == -1) { + Irssi::print("nicklist warning: $nick->{nick} had mode set on " . + "$channel->{name}, but was not found in nicklist"); + } else { + my $nicklist_item = $nicklist[$nr]; + remove_nick($nr); + + $nicklist_item->{mode} = _select_prefix_umode($nick); + +# $nicklist_item->{mode} = ($nick->{op}?$MODE_OP:$nick->{halfop}?$MODE_HALFOP:$nick->{voice}?$MODE_VOICE:$MODE_NORMAL); + + calc_text($nicklist_item); + insert_nick($nicklist_item); + } +} + +##### command binds ##### +Irssi::command_bind 'nicklist' => sub { + my ( $data, $server, $item ) = @_; + $data =~ s/\s+$//g; + Irssi::command_runsub ('nicklist', $data, $server, $item ) ; +}; +Irssi::signal_add_first 'default command nicklist' => sub { + # gets triggered if called with unknown subcommand + cmd_help(); +}; +Irssi::command_bind('nicklist update',\&update); +Irssi::command_bind('nicklist help',\&cmd_help); +Irssi::command_bind('nicklist scroll',\&cmd_scroll); +Irssi::command_bind('nicklist fifo',\&cmd_fifo_start); +Irssi::command_bind('nicklist screen',\&cmd_screen_start); +Irssi::command_bind('nicklist screensize',\&screen_size); +Irssi::command_bind('nicklist off',\&cmd_off); + +##### signals ##### +Irssi::signal_add_last('window item changed', \&make_nicklist); +Irssi::signal_add_last('window changed', \&make_nicklist); +Irssi::signal_add_last('channel wholist', \&sig_channel_wholist); +Irssi::signal_add_first('message join', \&sig_join); # first, to be before ignores +Irssi::signal_add_first('message part', \&sig_part); +Irssi::signal_add_first('message kick', \&sig_kick); +Irssi::signal_add_first('message quit', \&sig_quit); +Irssi::signal_add_first('message nick', \&sig_nick); +Irssi::signal_add_first('message own_nick', \&sig_nick); +Irssi::signal_add_first('nick mode changed', \&sig_mode); + +Irssi::signal_add('setup changed', \&read_settings); + +##### settings ##### +Irssi::settings_add_str('nicklist', 'nicklist_screen_prefix', '\e[m '); +Irssi::settings_add_str('nicklist', 'nicklist_screen_mode_suffix', '\e[39m'); + +Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_owner', '\e[31m~\e[39m'); +Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_admin', '\e[33m&\e[39m'); +Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_op', '\e[32m@\e[39m'); +Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_halfop', '\e[34m%\e[39m'); +Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_voice', '\e[3m+\e[39m'); +Irssi::settings_add_str('nicklist', 'nicklist_prefix_mode_normal', ' '); + + +Irssi::settings_add_int('nicklist', 'nicklist_width',11); +Irssi::settings_add_int('nicklist', 'nicklist_height',24); + +Irssi::settings_add_str('nicklist', 'nicklist_fifo_path', + Irssi::get_irssi_dir . '/nicklistfifo'); + +Irssi::settings_add_str('nicklist', 'nicklist_screen_split_windows', ''); +Irssi::settings_add_str('nicklist', 'nicklist_automode', ''); + +Irssi::settings_add_bool('nicklist', 'nicklist_debug', 0); + +read_settings(); + +if (uc(Irssi::settings_get_str('nicklist_automode')) eq 'SCREEN') { + cmd_screen_start(); +} elsif (uc(Irssi::settings_get_str('nicklist_automode')) eq 'FIFO') { + cmd_fifo_start(); +} + diff --git a/fixery/now_playing_mpd.pl b/fixery/now_playing_mpd.pl new file mode 100644 index 0000000..c80a7c3 --- /dev/null +++ b/fixery/now_playing_mpd.pl @@ -0,0 +1,205 @@ +# MPD Now-Playing Script for irssi +# Copyright (C) 2005 Erik Scharwaechter +# <diozaka@gmx.de> +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License version 2 +# as published by the Free Software Foundation. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# The full version of the license can be found at +# http://www.gnu.org/copyleft/gpl.html. +# +# +####################################################################### +# I'd like to thank Bumby <bumby@evilninja.org> for his impc script, # +# which helped me a lot with making this script. # +####################################################################### +# Type "/np help" for a help page! # +####################################################################### +# TODO: # +# - add more format directives # +####################################################################### +# CHANGELOG: # +# 0.4: First official release # +####################################################################### + +use strict; +#use IO::Socket; +use Irssi; +use IrssiX::Async qw(fork_off); +use Audio::MPD; +#use Storable; +use JSON::Any; +use Data::Dumper; + +our $VERSION = "0.5"; +our %IRSSI = ( + name => 'mpd', + authors => 'Erik Scharwaechter', + contact => 'diozaka@gmx.de', + license => 'GPLv2', + description => 'print the song you are listening to', + ); + +sub _to_json { + my $data = shift; + # add terminal newline to ensure flushing without having to mess + # with autoflush on all pipes. + return JSON::Any->new->objToJson($data) . "\n"; +} + +sub _from_json { + my $json = shift; + return JSON::Any->new->jsonToObj($json); +} + +sub _freeze_witem { + my ($witem) = @_; + my $win_item_ref; + + if (defined $witem) { + $win_item_ref = { server_tag => $witem->window->{servertag}, + win_refnum => $witem->window->{refnum}, + item_name => $witem->{name} }; + + } else { + # make this more better (find status window) + $win_item_ref = { server_tag => undef, + win_refnum => 1, + item_name => '' }; + + } + + return $win_item_ref; +} + +sub _thaw_witem { + my ($frozen_witem) = @_; + + my $witem; + my ($server_tag, $win_refnum, $witem_name) + = map { $frozen_witem->{$_} } qw/server_tag win_refnum item_name/; + + my $server = Irssi::server_find_tag($server_tag); + my $win = Irssi::window_find_refnum($win_refnum); + + if ($win) { + $witem = $win->item_find($server, $witem_name); + } else { + Irssi::print("Failed to find window item from params: tag: $server_tag, " + . "refnum: $win_refnum, item_name: $witem_name"); + } + return $witem; +} + +sub cmd_now_playing { + my ($data, $server, $witem) = @_; + + if($data =~ /^help/i){ + cmd_now_playing_help(); + return; + } + + my $host = Irssi::settings_get_str('mpd_port') || 'localhost'; + my $port = Irssi::settings_get_str('mpd_host') || 6060; + my $pass = Irssi::settings_get_str('mpd_pass') || ''; + my $timeout = Irssi::settings_get_str('mpd_timeout') || 5; + + + my $mpd_options = { win => _freeze_witem($witem), + host => $host, + port => $port, + password => $pass }; + + my $json_data = _to_json($mpd_options); + fork_off($json_data, \&now_playing_request, \&now_playing_callback); +} + +sub now_playing_request { + my (@input) = <STDIN>; + my $json_data = join('', @input); + + my $data = _from_json($json_data); + #my $win = delete $data->{win}; + +# my $mpd = Audio::MPD->new(%options); + +# my $am_playing = $mpd->current->as_string; +# my %x; +# if (defined $am_playing) { + # %x = ( result => $am_playing, win => $win ); + + # } else { + # %x = ( result => '__ERROR__', win => $win ); + # } + # my %x = (result => "foo", win => undef); + # my $r = Storable::freeze(\%x); + #print $r; + + my $response = { status => 1, + message => "Foo", + win => $data->{win}, + }; + + my $json_data = _to_json($response); + print $json_data; +} + +sub now_playing_callback { + my ($json_data) = @_; + #chomp $result; + #my $data = Storable::thaw($frozen_data); + my $data = _from_json($json_data); + print "received data: " . Dumper($data); + my $witem = _thaw_witem($data->{win}); + print "Witem: " . Dumper($witem); + if ($witem) { + $witem->print("Moo!"); + } + # unless ($deserialised->{result} eq "__ERROR__") { + # my $output_message = "/me is playing: " . $deserialised->{result}; + # my $witem = $deserialised->{win}; + + # if ($witem && ($witem->{type} eq "CHANNEL" || + # $witem->{type} eq "QUERY")) { + # #$witem->command($output_message); + # $witem->print("Printing: $output_message"); + # } + # } else { + # print "Now Playing MPD: Unable to do thingie (Got ERROR from child)"; + # } + +} + +sub cmd_now_playing_help { + print ' + MPD Now-Playing Script +======================== + +by Erik Scharwaechter (diozaka@gmx.de) + +Variables: + mpd_host (137.224.241.20) + mpd_port (6600) + mpd_timeout (5) + +Usage: + /np Print the song you are listening to + /np help Print this text +'; +} + + +Irssi::settings_add_str('mpd', 'mpd_host', '137.224.241.20'); +Irssi::settings_add_str('mpd', 'mpd_port', '6600'); +Irssi::settings_add_str('mpd', 'mpd_timeout', '5'); +Irssi::settings_add_str('mpd', 'mpd_pass', ''); + +Irssi::command_bind('np' => \&cmd_now_playing); +Irssi::command_bind('np help' => \&cmd_now_playing_help); + diff --git a/fixery/trackbar.pl b/fixery/trackbar.pl new file mode 100644 index 0000000..22d82aa --- /dev/null +++ b/fixery/trackbar.pl @@ -0,0 +1,200 @@ +# trackbar.pl +# +# This little script will do just one thing: it will draw a line each time you +# switch away from a window. This way, you always know just upto where you've +# been reading that window :) It also removes the previous drawn line, so you +# don't see double lines. +# +# Usage: +# +# The script works right out of the box, but if you want you can change +# the working by /set'ing the following variables: +# +# trackbar_string The characters to repeat to draw the bar +# trackbar_style The style for the bar, %r is red for example +# See formats.txt that came with irssi +# +# /mark is a command that will redraw the line at the bottom. However! This +# requires irssi version after 20021228. otherwise you'll get the error +# redraw: unknown command, and your screen is all goofed up :) +# +# /upgrade & buf.pl notice: This version tries to remove the trackbars before +# the upgrade is done, so buf.pl does not restore them, as they are not removeable +# afterwards by trackbar. Unfortiounatly, to make this work, trackbar and buf.pl +# need to be loaded in a specific order. Please experiment to see which order works +# for you (strangely, it differs from configuration to configuration, something I will +# try to fix in a next version) +# +# Authors: +# - Main maintainer & author: Peter 'kinlo' Leurs +# - Many thanks to Timo 'cras' Sirainen for placing me on my way +# - on-upgrade-remove-line patch by Uwe Dudenhoeffer +# +# Version history: +# 1.4: - Changed our's by my's so the irssi script header is valid +# - Removed utf-8 support. In theory, the script should work w/o any +# problems for utf-8, just set trackbar_string to a valid utf-8 character +# and everything *should* work. However, this script is being plagued by +# irssi internal bugs. The function Irssi::settings_get_str does NOT handle +# unicode strings properly, hence you will notice problems when setting the bar +# to a unicode char. For changing your bar to utf-8 symbols, read the line sub. +# 1.3: - Upgrade now removes the trackbars. +# - Some code cleanups, other defaults +# - /mark sets the line to the bottom +# 1.2: - Support for utf-8 +# - How the bar looks can now be configured with trackbar_string +# and trackbar_style +# 1.1: - Fixed bug when closing window +# 1.0: - Initial release +# +# +# Call for help! +# +# There is a trackbar version 2.0 that properly handles resizes and immediate config change +# activation. However, there is/are some bug(s) in irssi's main buffer/window code that causes +# irssi to 'forget' lines, which is ofcourse completly unaccepteable. I haven't found the time +# nor do I know the irssi's internals enough to find and fix this bug, if you want to help, please +# contact me, I'll give you a copy of the 2.0 version that will immediatly show you the problems. +# +# Known bugs: +# - if you /clear a window, it will be uncleared when returning to the window +# - UTF-8 characters in the trackbar_string doesnt work. This is an irssi bug. +# - if you resize your irssi (in xterm or so) the bar is not resized +# - changing the trackbar style is only visible after returning to a window +# however, changing style/resize takes in effect after you left the window. +# +# Whishlist/todo: +# - instead of drawing a line, just invert timestamp or something, +# to save a line (but I don't think this is possible with current irssi) +# - some pageup keybinding possibility, to scroll up upto the trackbar +# - <@coekie> kinlo: if i switch to another window, in another split window, i +# want the trackbar to go down in the previouswindow in that splitwindow :) +# - < bob_2> anyway to clear the line once the window is read? +# - < elho> kinlo: wishlist item: a string that gets prepended to the repeating pattern +# - < elho> an option to still have the timestamp in front of the bar +# - < elho> oh and an option to not draw it in the status window :P +# +# BTW: when you have feature requests, mailing a patch that works is the fastest way +# to get it added :p + +use strict; +use POSIX qw(strftime); +use 5.6.1; +use Irssi; +use Irssi::TextUI; + +my $VERSION = "1.4"; + +my %IRSSI = ( + authors => "Peter 'kinlo' Leurs", + contact => "peter\@pfoe.be", + name => "trackbar", + description => "Shows a bar where you've last read a window", + license => "GPLv2", + url => "http://www.pfoe.be/~peter/trackbar/", + changed => "Thu Feb 20 16:18:08 2003", +); + +my %config; + +Irssi::settings_add_str('trackbar', 'trackbar_string' => '-'); +$config{'trackbar_string'} = Irssi::settings_get_str('trackbar_string'); + +Irssi::settings_add_str('trackbar', 'trackbar_style' => '%K'); +$config{'trackbar_style'} = Irssi::settings_get_str('trackbar_style'); + +Irssi::signal_add( + 'setup changed' => sub { + $config{'trackbar_string'} = Irssi::settings_get_str('trackbar_string'); + $config{'trackbar_style'} = Irssi::settings_get_str('trackbar_style'); + if ($config{'trackbar_style'} =~ /(?<!%)[^%]|%%|%$/) { + Irssi::print( + "trackbar: %RWarning!%n 'trackbar_style' seems to contain " + . "printable characters. Only use format codes (read " + . "formats.txt).", MSGLEVEL_CLIENTERROR); + } + } +); + +Irssi::signal_add( + 'window changed' => sub { + my (undef, $oldwindow) = @_; + + if ($oldwindow) { + my $line = $oldwindow->view()->get_bookmark('trackbar'); + $oldwindow->view()->remove_line($line) if defined $line; + $oldwindow->print(line($oldwindow->{'width'}), MSGLEVEL_NEVER); + $oldwindow->view()->set_bookmark_bottom('trackbar'); + } + } +); + +sub line { + my $width = shift; + my $string = $config{'trackbar_string'}; + $string = '-' unless defined $string; + + # There is a bug in irssi's utf-8 handling on config file settings, as you + # can reproduce/see yourself by the following code sniplet: + # + # my $quake = pack 'U*', 8364; # EUR symbol + # Irssi::settings_add_str 'temp', 'temp_foo' => $quake; + # Irssi::print length $quake; + # # prints 1 + # Irssi::print length Irssi::settings_get_str 'temp_foo'; + # # prints 3 + # + # + # Trackbar used to have a workaround, but on recent versions of perl/irssi + # it does no longer work. Therefore, if you want your trackbar to contain + # unicode characters, uncomment the line below for a nice full line, or set + # the string to whatever char you want. + + # $string = pack('U*', 0x2500); + + + my $length = length $string; + + if ($length == 0) { + $string = '-'; + $length = 1; + } + + my $times = $width / $length; + $times = int(1 + $times) if $times != int($times); + $string =~ s/%/%%/g; + return $config{'trackbar_style'} . substr($string x $times, 0, $width); +} + +# Remove trackbars on upgrade - but this doesn't really work if the scripts are not loaded in the correct order... watch out! + +Irssi::signal_add_first( 'session save' => sub { + for my $window (Irssi::windows) { + next unless defined $window; + my $line = $window->view()->get_bookmark('trackbar'); + $window->view()->remove_line($line) if defined $line; + } + } +); + +sub cmd_mark { + my $window = Irssi::active_win(); +# return unless defined $window; + my $line = $window->view()->get_bookmark('trackbar'); + $window->view()->remove_line($line) if defined $line; + $window->print(line($window->{'width'}), MSGLEVEL_NEVER); + $window->view()->set_bookmark_bottom('trackbar'); + Irssi::command("redraw"); +} + +sub cmd_goto { + my $window = Irssi::active_win(); + my $line = $window->view()->get_bookmark('trackbar'); + # FIXME? does this work properly if they use a different date format? + my $time = strftime("%H:%M", localtime($line->{info}->{time})); + Irssi::command("GOTO $time"); +} + + +Irssi::command_bind('mark', 'cmd_mark'); +Irssi::command_bind('gototb', 'cmd_goto'); diff --git a/flood-detect/flood_detect.pl b/flood-detect/flood_detect.pl new file mode 100644 index 0000000..d2eeb95 --- /dev/null +++ b/flood-detect/flood_detect.pl @@ -0,0 +1,151 @@ +=pod + +=head1 NAME + +template.pl + +=head1 DESCRIPTION + +A minimalist template useful for basing actual scripts on. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +Use this template to make an actual script. + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'flood-detect', + description => '', + license => 'MIT', + updated => '$DATE' + ); + + +my $NAME = $IRSSI{name}; +my $DEBUG = 0; + +my $activity; + +sub DEBUG () { $DEBUG } + +sub setup_changed { + $DEBUG = Irssi::settings_get_bool($NAME . '_debug'); +} + +sub DEBUG () { $DEBUG } + +sub _debug_print { + my ($msg) = @_; + Irssi::active_window()->print($msg); +} + +sub sig_setup_changed { + $DEBUG = Irssi::settings_get_bool($NAME . '_debug'); + _debug_print($NAME . ': debug enabled') if $DEBUG; +} + +sub init { + Irssi::theme_register + ([ + verbatim => '[$*]', + script_loaded => 'Loaded script {hilight $0} v$1', + ]); + Irssi::settings_add_bool($NAME, $NAME . '_debug', 0); + Irssi::signal_add('setup changed', \&sig_setup_changed); + + Irssi::settings_add_int($NAME, 'flood_detect_lines', 10); + Irssi::settings_add_int($NAME, 'flood_detect_period', 10); + Irssi::settings_add_str($NAME, 'flood_detected_action', '/echo $N is flooding!'); + + sig_setup_changed(); + + Irssi::printformat(Irssi::MSGLEVEL_CLIENTCRAP, + 'script_loaded', $NAME, $VERSION); +} + +init(); + +sub update_activity { + my ($nick, $channel, $server) = @_; +} + +sub prune_activity_list { +} + +sub apply_flood_action { + + my ($channel, $nick, $nick_addr) = @_; + + my $action_setting = Irssi::settings_get_str('flood_detected_action'); + + my @actions = split /\s*;\s*/, $action_setting; + + foreach my $action (@actions) { + + my $processed_action = $action; + + if ($action =~ m/suppress/i) { + return 0; + } elsif ($action =~ m/kick/i) { + $processed_action = "/KICK $target $nick"; + } else { + $processed_action =~ s/\$nick/$nick/; + $processed_action =~ s/\$channel/$channel/; + $processed_action =~ s/\$host/$nick_addr/; + + } + + $processed_action = "/echo $action" if DEBUG; + $server->command($processed_action); + } +} + +init(); diff --git a/growl-notify/growl_notify.pl b/growl-notify/growl_notify.pl new file mode 100644 index 0000000..604c027 --- /dev/null +++ b/growl-notify/growl_notify.pl @@ -0,0 +1,106 @@ +=pod + +=head1 NAME + +growl_notify.pl + +=head1 DESCRIPTION + +A script that combines Irssi activity notifications with the Growl notification +system. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +=over 4 + +=item * + +Stuff. + +=back + +=cut + +# Plan +# Notes +# * Main target is remote screen+irssi, accessed via ssh on local OSX/iTerm2 +# (Because that's what I use :p) +# * Might work on windows (growl has windows port afaik) +# * iterm active feature: "[iterm2-discuss] iTerm2 1.0.0.20111020 canary released" +# "Add support for reporting focus lost/gained. esc[?1004h turns it on; +# then the terminal sends esc[I when focusing, esc[O when de-focusing. +# Send esc[?1004l to disable." + +# Main features are: +# * detect activity from irssi similarly to existing activity (crap, text, hilight) +# * configurable white/blacklists for nicks, masks, activities? +# * use the Growl remote protocol (GNTP) via optional ssh backchannel? +# * easy to configure other parts (ssh tunnel, etc?) + + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => '', + description => '', + license => 'MIT', + updated => '$DATE' + ); + +sub init { + Irssi::theme_register + ([ + verbatim => '[$*]', + script_loaded => 'Loaded script {hilight $0} v$1', + ]); + Irssi::printformat(Irssi::MSGLEVEL_CLIENTCRAP, + 'script_loaded', $IRSSI{name}, $VERSION); +} + + +init(); diff --git a/growl-notify/iterm_growl_activity.pl b/growl-notify/iterm_growl_activity.pl new file mode 100644 index 0000000..3311fa3 --- /dev/null +++ b/growl-notify/iterm_growl_activity.pl @@ -0,0 +1,94 @@ +=pod + +=head1 NAME + +iterm_growl_activity.pl + +=head1 DESCRIPTION + +A script that combines Irssi activity notifications with the Growl notification +system. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +None, since it doesn't actually do anything. + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'iterm_growl_activity', + description => 'generate growl notifications via iterm2 magical ' + . 'escape sequences if the window is not active', + license => 'MIT', + updated => '$DATE' + ); + +sub init { + Irssi::theme_register + ([ + verbatim => '[$*]', + script_loaded => 'Loaded script {hilight $0} v$1', + ]); + Irssi::printformat(Irssi::MSGLEVEL_CLIENTCRAP, + 'script_loaded', $IRSSI{name}, $VERSION); + + +} + +sub iterm_toggle_term_focus { + # ensure we handle the commands. + + Irssi::command('bind meta-O nothing inactive'); + Irssi::command('bind meta-I nothing inactive'); + + my ($enable) = @_; + print STDERR "\e[?1004" . ($enable ? 'h' : 'l'); +} + + +init(); diff --git a/history-search/rl_history_search.pl b/history-search/rl_history_search.pl index 016249d..7402a83 100644 --- a/history-search/rl_history_search.pl +++ b/history-search/rl_history_search.pl @@ -396,7 +396,8 @@ sub next_match { sub update_input { my $match = get_history_match(); - Irssi::gui_input_set($match); + # TODO: Use of uninitialized value in subroutine entry at /Users/shabble/projects/tmp/test/irssi-shab/scripts/rl_history_search.pl line 399. + Irssi::gui_input_set($match); # <--- here. Irssi::gui_input_set_pos(length $match); } diff --git a/longify/longify-urls.pl b/longify/longify-urls.pl index cd36503..83adc36 100644 --- a/longify/longify-urls.pl +++ b/longify/longify-urls.pl @@ -104,7 +104,13 @@ my $pending_msg_params = {}; my $lookup_in_progress; my $flushing_message; my $domains; +my $DEBUG; +sub _debug_print($) { + return unless $DEBUG; + my ($msg) = @_; + Irssi::active_win->print($msg, MSGLEVEL_CLIENTCRAP); +} sub sig_public_message { _handle_messages(@_); @@ -116,7 +122,7 @@ sub sig_private_message { sub _handle_messages { - my $msg = $_[1]; + my ($server, $msg) = @_; if ($flushing_message) { # don't interrupt it a second time. delete $pending_msg_params->{$flushing_message}; @@ -139,11 +145,13 @@ sub _handle_messages { $pending_msg_params->{$url} = [@_]; $lookup_in_progress = 1; + expand_url($url); - Irssi::signal_stop; + Irssi::signal_stop if $server; } + sub expand_url { my ($url) = @_; fork_off $url, \&expand_url_request, \&expand_url_callback; @@ -158,16 +166,28 @@ sub expand_url_request { $user_agent->timeout(2); # TODO: make this a setting. $user_agent->max_size(0); my $request = HTTP::Request->new(GET => $url); - my $result = $user_agent->request($request); - - print "$url\n"; - - if ($result->is_error) { + my $result = $user_agent->simple_request($request); + + if ($result->is_redirect) { + my $location = $result->header('Location'); + if ($location) { + print "$location\n"; + } else { + print "ERROR: no Location header\n"; + } + } elsif ($result->is_error) { print "ERROR: " . $result->as_string . "\n"; - return; + } elsif ($result->is_success) { + print "$url\n"; } +#elsif ($result->is_success) { + # print " +# return; +# } + my @redirects = $result->redirects; + #_debug_print(join (" => ", map { $_->header('Location') } @redirects)); if (@redirects) { print $redirects[-1]->header('Location') . "\n"; } @@ -177,26 +197,40 @@ sub expand_url_callback { my ($result) = @_; chomp $result; + my ($orig_url, $long_url) = split /\n/, $result; $long_url = '' unless $long_url; + + # l/rtrim to clean up whitespace $long_url =~ s/\s*(\S*)\s*/$1/; my $pending_message_data = $pending_msg_params->{$orig_url}; my @new_signal = @$pending_message_data; - #Irssi::print("Result: orignal: $orig_url, new: $long_url"); - - if ($long_url && $long_url !~ /^ERROR/ && $long_url ne $orig_url) { - $new_signal[1] =~ s/\Q$orig_url\E/$long_url [was: $orig_url]/; - #print "Printing with: " . Dumper(@new_signal[1..$#new_signal]); - } elsif ($long_url && $long_url =~ /^ERROR/) { - $new_signal[1] =~ s/\Q$orig_url\E/$long_url while expanding "$orig_url"/; + _debug_print("Result: orignal: $orig_url, new: $long_url"); + + if ($long_url) { + if ($long_url !~ /^ERROR/ && $long_url ne $orig_url) { + $new_signal[1] + =~ s/\Q$orig_url\E/$long_url [was: $orig_url]/; + _debug_print("Printing with: " + . Dumper(@new_signal[1..$#new_signal])); + } elsif ($long_url =~ /^ERROR/) { + $new_signal[1] + =~ s/\Q$orig_url\E/$long_url while expanding "$orig_url"/; + } } - $flushing_message = $orig_url; - Irssi::signal_emit 'message public', @new_signal; + if (defined $new_signal[0]) { + $flushing_message = $orig_url; + Irssi::signal_emit 'message public', @new_signal; + } else { + delete $pending_msg_params->{$orig_url}; + Irssi::print("URL: $orig_url expands to $new_signal[1]"); + } + $lookup_in_progress = 0; } sub match_uri { @@ -244,7 +278,7 @@ sub match_uri { } sub cmd_reload { - my $filename = shift + my $filename = shift || File::Spec->catfile(Irssi::get_irssi_dir, 'longify-urls.list'); $domains = {}; open my $fh, '<', $filename @@ -257,16 +291,31 @@ sub cmd_reload { Irssi::active_win->print('%_Longify:%_ List of domains has been reloaded.'); } +sub cmd_longify { + my ($args, $server, $witem) = @_; + + # _handle_messages expects $_[1] to contain message content. + _handle_messages(undef, $args); +} + sub init { + Irssi::settings_add_bool 'longify', 'longify-debug', 0; + Irssi::signal_add_first 'message public', \&sig_public_message; Irssi::signal_add_first 'message private', \&sig_private_message; Irssi::signal_add 'setup changed', \&sig_setup_changed; Irssi::command_bind 'longify-reload', \&cmd_reload; + Irssi::command_bind 'longify', \&cmd_longify; cmd_reload(); + sig_setup_changed(); } sub sig_setup_changed { + + $DEBUG = Irssi::settings_get_bool 'longify-debug'; + $DEBUG = 0 unless defined $DEBUG; + # TODO: settings updating stuff goes here. } diff --git a/foreach-guard/foreach-guard.pl b/molly-guard/molly_guard.pl index bcebef6..fb45142 100644 --- a/foreach-guard/foreach-guard.pl +++ b/molly-guard/molly_guard.pl @@ -2,11 +2,30 @@ =head1 NAME -foreach-guard.pl - confirm that you really mean to send a (non-)command to all channels. +molly_guard.pl - confirm that you really mean to do things that could have +potentially dangerous (or embarassing) effects. =head1 DESCRIPTION +Named after the plastic cover installed over some Big Red Switches With +Major Consequences. See L<http://catb.org/jargon/html/M/molly-guard.html>. +Attempts to stop you shooting yourself in the foot, face, or other body-part +during normal day-to-day use of Irssi. +By default, it protects you from the following potential mishaps: + +=over 4 + +=item * C</foreach <channel|query|window|server> [not a command]> + +C</foreach THING ARGS> will pass I<ARGS> to every I<THING> specified. Usually, +this is used to, for example, run a command in every window. A common mistake is +not including a command char such as C</> in your I<ARGS>, in which case I<ARGS> +is sent as text to every window or channel it can be. This is almost always bad. + +=item * I<Nothing else, yet> + +=back =head1 INSTALLATION @@ -45,7 +64,25 @@ THE SOFTWARE. =head1 TODO -Use this template to make an actual script. +=over 4 + +=item * Commands to protect: + +=over 4 + +=item * C</foreach [noncommand]> + +=item * C</server> (in cases where C</connect> is probably meant) + +=item * C</upgrade> (way too easy to tab-complete instead of /UPTIME) + +=item * C</exit>, C</quit> (obvious) + +=item * ... + +=back + +=back =cut @@ -58,12 +95,14 @@ use Irssi::TextUI; use Data::Dumper; -our $VERSION = '0.1'; +our $VERSION = '0.2'; our %IRSSI = ( authors => 'shabble', contact => 'shabble+irssi@metavore.org', - name => 'foreach-guard', - description => '', + name => 'molly_guard', + description => 'A script to protect users from accidentally invoking' + . ' commands which may perform undesired actions. See ' + . 'http://catb.org/jargon/html/M/molly-guard.html', license => 'MIT', updated => '$DATE' ); @@ -76,14 +115,14 @@ my $cmd_confirm_list; my $txt_confirm_list; sub init { - Irssi::settings_add_bool('foreach_guard', - 'foreach_guard_debug', + Irssi::settings_add_bool('molly_guard', + 'molly_guard_debug', 0); - Irssi::settings_add_str ('foreach_guard', - 'foreach_guard_confirm_commands', + Irssi::settings_add_str ('molly_guard', + 'molly_guard_confirm_commands', ''); - Irssi::settings_add_str ('foreach_guard', - 'foreach_guard_confirm_text', + Irssi::settings_add_str ('molly_guard', + 'molly_guard_confirm_text', ''); Irssi::theme_register([ @@ -109,7 +148,7 @@ sub init { } sub sig_setup_changed { - $DEBUG = Irssi::settings_get_bool('foreach_guard_debug'); + $DEBUG = Irssi::settings_get_bool('molly_guard_debug'); _debug("settings changed"); $cmdchars = Irssi::settings_get_str('cmdchars'); my $tmp = join('|', map { quotemeta } split('', $cmdchars)); @@ -118,10 +157,10 @@ sub sig_setup_changed { _debug("Match cmdchars set to: %s", $match_cmdchars); $cmd_confirm_check = { map { $_ => 1 } split /\s+/, - Irssi::settings_get_str('foreach_guard_confirm_commands') }; + Irssi::settings_get_str('molly_guard_confirm_commands') }; $txt_confirm_check = { map { $_ => 1 } split /\s+/, - Irssi::settings_get_str('foreach_guard_confirm_text') }; + Irssi::settings_get_str('molly_guard_confirm_text') }; } diff --git a/random/ignore-autovoice.pl b/random/ignore-autovoice.pl new file mode 100644 index 0000000..82336e5 --- /dev/null +++ b/random/ignore-autovoice.pl @@ -0,0 +1,88 @@ + +=pod + +=head1 NAME + +ignore-autovoice.pl + +=head1 DESCRIPTION + +Ignores C<+m> mode changes in all (or a custom subset) of your channels, to avoid +mode-spam without ignoring all modes. + +=head1 INSTALLATION + +Copy into your F<~/.irssi/scripts/> directory and load with +C</SCRIPT LOAD F<filename>>. + +=head1 USAGE + +TODO + +=head1 AUTHORS + +Copyright E<copy> 2011 Tom Feist C<E<lt>shabble+irssi@metavore.orgE<gt>> + +=head1 LICENCE + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + +=head1 BUGS + +=head1 TODO + + +=cut + +use strict; +use warnings; + +use Irssi; +use Irssi::Irc; +use Irssi::TextUI; + +use Data::Dumper; + +# Question: how to mark a signal in one event and apply actions to it later on? +# TODO: make this a generic 'some modes only' thing. +our $VERSION = '0.1'; +our %IRSSI = ( + authors => 'shabble', + contact => 'shabble+irssi@metavore.org', + name => 'ignore-autovoice', + description => 'ignores autovoice +m mode changes', + license => 'MIT', + updated => '$DATE' + ); + + +sub init { + + Irssi::settings_add_string('ignore-autovoice', ' + Irssi::signal_add('setup changed', \&sig_setup_changed); + Irssi::signal_add(''); +} + +sub sig_setup_changed { + +} + +sub sig_mode_changed { + +} diff --git a/vim-mode/vim_mode.pl b/vim-mode/vim_mode.pl index dd83f8a..aa4ebec 100644 --- a/vim-mode/vim_mode.pl +++ b/vim-mode/vim_mode.pl @@ -597,7 +597,7 @@ use Irssi::Irc; # necessary for 0.8.14 -our $VERSION = "1.0.2"; +our $VERSION = "1.1.0"; our %IRSSI = ( authors => "Tom Feist (shabble), Simon Ruderich (rudi_s)", @@ -607,7 +607,7 @@ our %IRSSI = name => "vim_mode", description => "Give Irssi Vim-like commands for editing the inputline", license => "MIT", - changed => "28/9/2010" + changed => "3/2/2012" ); @@ -641,6 +641,7 @@ sub C_NOP () { 7 } sub S_BOOL () { 0 } sub S_INT () { 1 } sub S_STR () { 2 } +sub S_TIME () { 3 } # word and non-word regex, keep in sync with setup_changed()! my $word = qr/[\w_]/o; @@ -894,7 +895,7 @@ my $settings # <Leader> value for prepending to commands. map_leader => { type => S_STR, value => '\\' }, # timeout for keys following esc. In milliseconds. - esc_buf_timeout => { type => S_INT, value => 10 }, + esc_buf_timeout => { type => S_TIME, value => '10ms' }, }; @@ -3611,6 +3612,8 @@ sub _setting_get { $ret = Irssi::settings_get_int($name); } elsif ($type == S_STR) { $ret = Irssi::settings_get_str($name); + } elsif ($type == S_TIME) { + $ret = Irssi::settings_get_time($name); } else { _warn("Unknown setting type '$type', please report."); } @@ -3630,6 +3633,8 @@ sub _setting_set { Irssi::settings_set_int($name, $value); } elsif ($type == S_STR) { Irssi::settings_set_str($name, $value); + } elsif ($type == S_TIME) { + Irssi::settings_set_time($name, $value); } else { _warn("Unknown setting type '$type', please report."); } @@ -3647,6 +3652,8 @@ sub _setting_register { Irssi::settings_add_int('vim_mode', $name, $value); } elsif ($type == S_STR) { Irssi::settings_add_str('vim_mode', $name, $value); + } elsif ($type == S_TIME) { + Irssi::settings_add_time('vim_mode', $name, $value); } else { _warn("Unknown setting type '$type', please report."); } |