diff options
Diffstat (limited to 'scripts/linkchan.pl')
| -rw-r--r-- | scripts/linkchan.pl | 488 |
1 files changed, 488 insertions, 0 deletions
diff --git a/scripts/linkchan.pl b/scripts/linkchan.pl new file mode 100644 index 0000000..34fb619 --- /dev/null +++ b/scripts/linkchan.pl @@ -0,0 +1,488 @@ +use strict; +use vars qw($VERSION %IRSSI); + +$VERSION = "1.5"; +%IRSSI = +( + authors => 'Marcin \'Qrczak\' Kowalczyk', + contact => 'qrczak@knm.org.pl', + name => 'LinkChan', + description => 'Link several channels on serveral networks', + license => 'GNU GPL', + url => 'http://qrnik.knm.org.pl/~qrczak/irssi/linkchan.pl', +); + +our %links; +our $lock_own = 0; + +our $config = Irssi::get_irssi_dir . "/linkchan.cfg"; + +Irssi::command_bind "link", sub +{ + my ($args, $server, $target) = @_; + Irssi::command_runsub "link", $args, $server, $target; +}; + +Irssi::command_bind "link add", sub +{ + my ($args, $server, $target) = @_; + unless ($args =~ m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|) + { + print CLIENTERROR "Usage: /link add <chatnet1>/<channel1> <chatnet2>/<channel2>"; + return; + } + my ($chatnet1, $channel1, $chatnet2, $channel2) = + (lc $1, lc $2, lc $3, lc $4); + foreach my $link ([$chatnet1, $channel1], [$chatnet2, $channel2]) + { + my ($chat1, $chan1) = @{$link}; + if ($links{$chat1}{$chan1}) + { + my ($chat2, $chan2) = @{$links{$chat1}{$chan1}}; + print CLIENTERROR "Channel $chat1/$chan1 is already linked to $chat2/$chan2"; + return; + } + } + $links{$chatnet1}{$channel1} = [$chatnet2, $channel2]; + $links{$chatnet2}{$channel2} = [$chatnet1, $channel1]; + print CLIENTNOTICE "Added link: $chatnet1/$channel1 <-> $chatnet2/$channel2"; +}; + +Irssi::command_bind "link remove", sub +{ + my ($args, $server, $target) = @_; + unless ($args =~ m|^ *([^ /]+)/([^ ]+) *$|) + { + print CLIENTERROR "Usage: /link remove <chatnet>/<channel>"; + return; + } + my ($chatnet1, $channel1) = (lc $1, lc $2); + unless ($links{$chatnet1}{$channel1}) + { + print CLIENTERROR "Channel $chatnet1/$channel1 was not linked"; + return; + } + my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}}; + delete $links{$chatnet1}{$channel1}; + delete $links{$chatnet2}{$channel2}; + print CLIENTNOTICE "Removed link: $chatnet1/$channel1 <-> $chatnet2/$channel2"; +}; + +Irssi::command_bind "link list", sub +{ + my ($args, $server, $target) = @_; + unless ($args =~ /^ *$/) + { + print CLIENTNOTICE "Usage: /link list"; + return; + } + print CLIENTNOTICE "The following pairs of channels are linked:"; + my %shown = (); + foreach my $chatnet1 (sort keys %links) + { + foreach my $channel1 (sort keys %{$links{$chatnet1}}) + { + next if $shown{$chatnet1}{$channel1}; + my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}}; + print CLIENTNOTICE "$chatnet1/$channel1 <-> $chatnet2/$channel2"; + $shown{$chatnet2}{$channel2} = 1; + } + } +}; + +sub save_config() +{ + open CONFIG, ">", $config; + foreach my $chatnet1 (keys %links) + { + foreach my $channel1 (keys %{$links{$chatnet1}}) + { + my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}}; + print CONFIG "$chatnet1/$channel1 $chatnet2/$channel2\n"; + } + } + close CONFIG; +} + +Irssi::signal_add "setup saved", sub +{ + my ($main_config, $auto) = @_; + save_config unless $auto; +}; + +sub load_config() +{ + %links = (); + open CONFIG, "<", $config or return; + while (<CONFIG>) + { + chomp; + next if /^ *$/ || /^#/; + unless (m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|) + { + print CLIENTERROR "Syntax error in $config: $_"; + return; + } + my ($chatnet1, $channel1, $chatnet2, $channel2) = + (lc $1, lc $2, lc $3, lc $4); + $links{$chatnet1}{$channel1} = [$chatnet2, $channel2]; + } +} + +Irssi::signal_add "setup reread", \&load_config; + +sub message($$) +{ + my ($chan, $msg) = @_; + $lock_own = 1; + $chan->{server}->command("msg $chan->{name} $msg"); + $lock_own = 0; +} + +sub special_message($$) +{ + my ($chan, $msg) = @_; + message $chan, "-!- $msg"; +} + +sub special_message_for($$$) +{ + my ($chan, $nick, $msg) = @_; + message $chan, + (defined $nick ? "$nick: " : "") . + "-!- $msg"; +} + +sub channel_context($$) +{ + my ($server1, $channel1) = @_; + my $chatnet1 = lc $server1->{chatnet}; + my $chan1 = $server1->channel_find($channel1) or return undef; + my $other = $links{$chatnet1}{lc $channel1} or return undef; + my ($chatnet2, $channel2) = @{$other}; + my $server2 = Irssi::server_find_chatnet($chatnet2) or return; + my $chan2 = $server2->channel_find($channel2) or return; + return { + chatnet1 => $chatnet1, + server1 => $server1, + channel1 => $channel1, + chan1 => $chan1, + chatnet2 => $chatnet2, + server2 => $server2, + channel2 => $channel2, + chan2 => $chan2, + }; +} + +sub channel_contexts_with_nick($$) +{ + my ($server1, $nick1) = @_; + my $chatnet1 = lc $server1->{chatnet}; + return () unless $links{$chatnet1}; + my @contexts = (); + foreach my $channel1 (keys %{$links{$chatnet1}}) + { + my $chan1 = $server1->channel_find($channel1) or next; + next unless $chan1->nick_find($nick1); + my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}}; + my $server2 = Irssi::server_find_chatnet($chatnet2) or next; + my $chan2 = $server2->channel_find($channel2) or next; + push @contexts, { + chatnet1 => $chatnet1, + server1 => $server1, + channel1 => $channel1, + chan1 => $chan1, + chatnet2 => $chatnet2, + server2 => $server2, + channel2 => $channel2, + chan2 => $chan2, + }; + } + return @contexts; +} + +sub must_be_op($$) +{ + my ($context, $nick) = @_; + unless (defined $nick ? + $context->{chan1}->nick_find($nick)->{op} : + $context->{chan1}->{chanop}) + { + special_message_for $context->{chan1}, $nick, + "You're not channel operator in $context->{channel1}"; + return 0; + } + unless ($context->{chan2}->{chanop}) + { + special_message_for $context->{chan1}, $nick, + "Sorry, I'm not channel operator in $context->{channel2}"; + return 0; + } + return 1; +} + +sub change_mode($$$) +{ + my ($context, $nick, $mode) = @_; + return unless must_be_op($context, $nick); + special_message $context->{chan2}, + "mode/$context->{channel2} [$mode] by $nick" + if defined $nick; + $context->{server2}->command("mode $context->{channel2} $mode"); +} + +sub change_perms($$$$$$) +{ + my ($command, $dir, $mode, $context, $nick, $args) = @_; + my @nicks = split ' ', $args; + unless (@nicks) + { + special_message_for $context->{chan1}, $nick, + "Usage: \\$command <nicks>"; + return; + } + change_mode $context, $nick, $dir . $mode x @nicks . " @nicks"; +} + +sub names($$$) +{ + my ($context, $nick, $args) = @_; + my @nicks = $context->{chan2}->nicks(); + my @ops = grep {$_->{op}} @nicks; + my @voices = grep {!$_->{op} && $_->{voice}} @nicks; + my @normal = grep {!$_->{op} && !$_->{voice}} @nicks; + my @list = ( + map ({['@', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @ops), + map ({['+', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @voices), + map ({[' ', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @normal)); + my $max_width = 62 - length $context->{server1}->{nick}; + my $rows = 1; + my @column_widths; + while ($rows < @list) + { + @column_widths = (); + my $width = 0; + my $i = 0; + while ($i < @list) + { + my $column_width = 0; + foreach my $j ($i .. $i+$rows-1) + { + last if $j >= @list; + my $len = length $list[$j][1]; + $column_width = $len if $column_width < $len; + } + push @column_widths, $column_width; + $width += $column_width + 4; + $i += $rows; + } + last if $width - 1 <= $max_width; + ++$rows; + } + my @output; + foreach my $i (0..$#list) + { + $output[$i % $rows] .= + sprintf "[%s%*s] ", + $list[$i][0], -$column_widths[int ($i / $rows)], $list[$i][1]; + } + foreach my $row (@output) + { + chop $row; + message $context->{chan1}, $row; + } +} + +my %commands = +( + mode => sub + { + my ($context, $nick, $args) = @_; + unless ($args =~ /^ +\* +(.*)$/ || + $args =~ /^ +\Q$context->{channel2}\E +(.*)$/) + { + special_message_for $context->{chan1}, $nick, + "Usage: \\mode * <mode> [<mode parameters>]"; + return; + } + change_mode $context, $nick, $1; + }, + op => sub {&change_perms('op', '+', 'o', @_)}, + deop => sub {&change_perms('deop', '-', 'o', @_)}, + voice => sub {&change_perms('voice', '+', 'v', @_)}, + devoice => sub {&change_perms('devoice', '-', 'v', @_)}, + kick => sub + { + my ($context, $nick, $args) = @_; + unless ($args =~ /^ +([^ ]+)(| .*)$/) + { + special_message_for $context->{chan1}, $nick, + "Usage: \\kick <nicks> [<reason>]"; + return; + } + my ($nicks, $reason) = ($1, $2); + $reason = $reason =~ /^ ?$/ ? " $nick" : " <$nick>$reason" + if defined $nick; + return unless must_be_op($context, $nick); + $context->{server2}->command("kick $context->{channel2} $nicks$reason"); + }, + names => \&names, +); + +sub run_command($$$$) +{ + my ($context, $nick, $command, $args) = @_; + my $func = $commands{lc $command}; + unless ($func) + { + special_message_for $context->{chan1}, $nick, + "Unknown command: $command"; + return; + } + $func->($context, $nick, $args); +} + +Irssi::signal_add "message public", sub +{ + my ($server1, $msg, $nick, $address, $channel1) = @_; + my $context = channel_context($server1, $channel1) or return; + if ($msg =~ /^\\([^ ]+)(| .*)$/) + { + Irssi::signal_continue @_; + run_command $context, $nick, $1, $2; + } + elsif ($msg =~ /^<.[^ ]+> /) + { + print CLIENTERROR + "Warning! Channels $context->{chatnet1}/$context->{channel1} " . + "and $context->{chatnet2}/$context->{channel2} are linked twice."; + Irssi::command "beep"; + } + else + { + my $nk = $context->{chan1}->nick_find($nick); + my $perm = $nk->{op} ? '@' : $nk->{voice} ? '+' : ' '; + message $context->{chan2}, "<$perm$nick> $msg"; + } +}; + +Irssi::signal_add "message own_public", sub +{ + my ($server1, $msg, $channel1) = @_; + return if $lock_own; + my $context = channel_context($server1, $channel1) or return; + if ($msg !~ s/^\\ // && $msg =~ /^\\([^ ]+)(| .*)$/) + { + Irssi::signal_continue @_; + run_command $context, undef, $1, $2; + } + else + { + message $context->{chan2}, $msg; + } +}; + +Irssi::signal_add "message irc action", sub +{ + my ($server1, $msg, $nick, $address, $channel1) = @_; + my $context = channel_context($server1, $channel1) or return; + message $context->{chan2}, " * $nick $msg"; +}; + +Irssi::signal_add "message irc own_action", sub +{ + my ($server1, $msg, $channel1) = @_; + return if $lock_own; + my $context = channel_context($server1, $channel1) or return; + $lock_own = 1; + $context->{server2}->command("action $context->{channel2} $msg"); + $lock_own = 0; +}; + +Irssi::signal_add "message join", sub +{ + my ($server1, $channel1, $nick, $address) = @_; + my $context = channel_context($server1, $channel1) or return; + special_message $context->{chan2}, + "$nick [$address] has joined $channel1"; +}; + +Irssi::signal_add "message part", sub +{ + my ($server1, $channel1, $nick, $address, $reason) = @_; + my $context = channel_context($server1, $channel1) or return; + special_message $context->{chan2}, + "$nick [$address] has left $context->{channel1} [$reason]"; +}; + +Irssi::signal_add "message quit", sub +{ + my ($server1, $nick, $address, $reason) = @_; + foreach my $context (channel_contexts_with_nick($server1, $nick)) + { + special_message $context->{chan2}, + "$nick [$address] has quit [$reason]"; + } +}; + +Irssi::signal_add "message topic", sub +{ + my ($server1, $channel1, $topic, $nick, $address) = @_; + return if $nick eq $server1->{nick}; + my $context = channel_context($server1, $channel1) or return; + if ($topic eq "") + { + special_message $context->{chan2}, + "Topic unset by $nick on $context->{channel1}"; + $context->{server2}->command("topic -delete $context->{channel2}"); + } + else + { + special_message $context->{chan2}, + "$nick changed the topic of $context->{channel1} to: $topic"; + $context->{server2}->command("topic $context->{channel2} $topic"); + } +}; + +Irssi::signal_add "message nick", sub +{ + my ($server1, $newnick, $oldnick, $address) = @_; + foreach my $context (channel_contexts_with_nick($server1, $newnick)) + { + special_message $context->{chan2}, + "$oldnick is now known as $newnick"; + } +}; + +Irssi::signal_add "message own_nick", sub +{ + my ($server1, $newnick, $oldnick, $address) = @_; + foreach my $context (channel_contexts_with_nick($server1, $newnick)) + { + next if $context->{chatnet1} eq $context->{chatnet2}; + special_message $context->{chan2}, + "$oldnick is now known as $newnick"; + } +}; + +Irssi::signal_add "message kick", sub +{ + my ($server1, $channel1, $nick, $kicker, $address, $reason) = @_; + my $context = channel_context($server1, $channel1) or return; + special_message $context->{chan2}, + "$nick was kicked from $context->{channel1} " . + "by $kicker [$reason]"; +}; + +Irssi::signal_add "event mode", sub +{ + my ($server1, $data, $nick) = @_; + $data =~ /^([^ ]*) (.*)$/ or return; + my ($channel1, $mode) = ($1, $2); + my $context = channel_context($server1, $channel1) or return; + special_message $context->{chan2}, + "mode/$context->{channel1} [$mode] by $nick"; +}; + +load_config; + |