1use strict;
2use vars qw($VERSION %IRSSI);
3
4$VERSION = "1.5";
5%IRSSI =
6(
7    authors     => 'Marcin \'Qrczak\' Kowalczyk',
8    contact     => 'qrczak@knm.org.pl',
9    name        => 'LinkChan',
10    description => 'Link several channels on serveral networks',
11    license     => 'GNU GPL',
12    url         => 'http://qrnik.knm.org.pl/~qrczak/irssi/linkchan.pl',
13);
14
15our %links;
16our $lock_own = 0;
17
18our $config = Irssi::get_irssi_dir . "/linkchan.cfg";
19
20Irssi::command_bind "link", sub
21{
22    my ($args, $server, $target) = @_;
23    Irssi::command_runsub "link", $args, $server, $target;
24};
25
26Irssi::command_bind "link add", sub
27{
28    my ($args, $server, $target) = @_;
29    unless ($args =~ m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|)
30    {
31        print CLIENTERROR "Usage: /link add <chatnet1>/<channel1> <chatnet2>/<channel2>";
32        return;
33    }
34    my ($chatnet1, $channel1, $chatnet2, $channel2) =
35      (lc $1, lc $2, lc $3, lc $4);
36    foreach my $link ([$chatnet1, $channel1], [$chatnet2, $channel2])
37    {
38        my ($chat1, $chan1) = @{$link};
39        if ($links{$chat1}{$chan1})
40        {
41            my ($chat2, $chan2) = @{$links{$chat1}{$chan1}};
42            print CLIENTERROR "Channel $chat1/$chan1 is already linked to $chat2/$chan2";
43            return;
44        }
45    }
46    $links{$chatnet1}{$channel1} = [$chatnet2, $channel2];
47    $links{$chatnet2}{$channel2} = [$chatnet1, $channel1];
48    print CLIENTNOTICE "Added link: $chatnet1/$channel1 <-> $chatnet2/$channel2";
49};
50
51Irssi::command_bind "link remove", sub
52{
53    my ($args, $server, $target) = @_;
54    unless ($args =~ m|^ *([^ /]+)/([^ ]+) *$|)
55    {
56        print CLIENTERROR "Usage: /link remove <chatnet>/<channel>";
57        return;
58    }
59    my ($chatnet1, $channel1) = (lc $1, lc $2);
60    unless ($links{$chatnet1}{$channel1})
61    {
62        print CLIENTERROR "Channel $chatnet1/$channel1 was not linked";
63        return;
64    }
65    my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
66    delete $links{$chatnet1}{$channel1};
67    delete $links{$chatnet2}{$channel2};
68    print CLIENTNOTICE "Removed link: $chatnet1/$channel1 <-> $chatnet2/$channel2";
69};
70
71Irssi::command_bind "link list", sub
72{
73    my ($args, $server, $target) = @_;
74    unless ($args =~ /^ *$/)
75    {
76        print CLIENTNOTICE "Usage: /link list";
77        return;
78    }
79    print CLIENTNOTICE "The following pairs of channels are linked:";
80    my %shown = ();
81    foreach my $chatnet1 (sort keys %links)
82    {
83        foreach my $channel1 (sort keys %{$links{$chatnet1}})
84        {
85            next if $shown{$chatnet1}{$channel1};
86            my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
87            print CLIENTNOTICE "$chatnet1/$channel1 <-> $chatnet2/$channel2";
88            $shown{$chatnet2}{$channel2} = 1;
89        }
90    }
91};
92
93sub save_config()
94{
95    open CONFIG, ">", $config;
96    foreach my $chatnet1 (keys %links)
97    {
98        foreach my $channel1 (keys %{$links{$chatnet1}})
99        {
100            my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
101            print CONFIG "$chatnet1/$channel1 $chatnet2/$channel2\n";
102        }
103    }
104    close CONFIG;
105}
106
107Irssi::signal_add "setup saved", sub
108{
109    my ($main_config, $auto) = @_;
110    save_config unless $auto;
111};
112
113sub load_config()
114{
115    %links = ();
116    open CONFIG, "<", $config or return;
117    while (<CONFIG>)
118    {
119        chomp;
120        next if /^ *$/ || /^#/;
121        unless (m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|)
122        {
123            print CLIENTERROR "Syntax error in $config: $_";
124            return;
125        }
126        my ($chatnet1, $channel1, $chatnet2, $channel2) =
127          (lc $1, lc $2, lc $3, lc $4);
128        $links{$chatnet1}{$channel1} = [$chatnet2, $channel2];
129    }
130}
131
132Irssi::signal_add "setup reread", \&load_config;
133
134sub message($$)
135{
136    my ($chan, $msg) = @_;
137    $lock_own = 1;
138    $chan->{server}->command("msg $chan->{name} $msg");
139    $lock_own = 0;
140}
141
142sub special_message($$)
143{
144    my ($chan, $msg) = @_;
145    message $chan, "-!- $msg";
146}
147
148sub special_message_for($$$)
149{
150    my ($chan, $nick, $msg) = @_;
151    message $chan,
152      (defined $nick ? "$nick: " : "") .
153      "-!- $msg";
154}
155
156sub channel_context($$)
157{
158    my ($server1, $channel1) = @_;
159    my $chatnet1 = lc $server1->{chatnet};
160    my $chan1 = $server1->channel_find($channel1) or return undef;
161    my $other = $links{$chatnet1}{lc $channel1} or return undef;
162    my ($chatnet2, $channel2) = @{$other};
163    my $server2 = Irssi::server_find_chatnet($chatnet2) or return;
164    my $chan2 = $server2->channel_find($channel2) or return;
165    return {
166        chatnet1 => $chatnet1,
167        server1  => $server1,
168        channel1 => $channel1,
169        chan1    => $chan1,
170        chatnet2 => $chatnet2,
171        server2  => $server2,
172        channel2 => $channel2,
173        chan2    => $chan2,
174    };
175}
176
177sub channel_contexts_with_nick($$)
178{
179    my ($server1, $nick1) = @_;
180    my $chatnet1 = lc $server1->{chatnet};
181    return () unless $links{$chatnet1};
182    my @contexts = ();
183    foreach my $channel1 (keys %{$links{$chatnet1}})
184    {
185        my $chan1 = $server1->channel_find($channel1) or next;
186        next unless $chan1->nick_find($nick1);
187        my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
188        my $server2 = Irssi::server_find_chatnet($chatnet2) or next;
189        my $chan2 = $server2->channel_find($channel2) or next;
190        push @contexts, {
191            chatnet1 => $chatnet1,
192            server1  => $server1,
193            channel1 => $channel1,
194            chan1    => $chan1,
195            chatnet2 => $chatnet2,
196            server2  => $server2,
197            channel2 => $channel2,
198            chan2    => $chan2,
199        };
200    }
201    return @contexts;
202}
203
204sub must_be_op($$)
205{
206    my ($context, $nick) = @_;
207    unless (defined $nick ?
208            $context->{chan1}->nick_find($nick)->{op} :
209            $context->{chan1}->{chanop})
210    {
211        special_message_for $context->{chan1}, $nick,
212          "You're not channel operator in $context->{channel1}";
213        return 0;
214    }
215    unless ($context->{chan2}->{chanop})
216    {
217        special_message_for $context->{chan1}, $nick,
218          "Sorry, I'm not channel operator in $context->{channel2}";
219        return 0;
220    }
221    return 1;
222}
223
224sub change_mode($$$)
225{
226    my ($context, $nick, $mode) = @_;
227    return unless must_be_op($context, $nick);
228    special_message $context->{chan2},
229      "mode/$context->{channel2} [$mode] by $nick"
230      if defined $nick;
231    $context->{server2}->command("mode $context->{channel2} $mode");
232}
233
234sub change_perms($$$$$$)
235{
236    my ($command, $dir, $mode, $context, $nick, $args) = @_;
237    my @nicks = split ' ', $args;
238    unless (@nicks)
239    {
240        special_message_for $context->{chan1}, $nick,
241          "Usage: \\$command <nicks>";
242        return;
243    }
244    change_mode $context, $nick, $dir . $mode x @nicks . " @nicks";
245}
246
247sub names($$$)
248{
249    my ($context, $nick, $args) = @_;
250    my @nicks = $context->{chan2}->nicks();
251    my @ops = grep {$_->{op}} @nicks;
252    my @voices = grep {!$_->{op} && $_->{voice}} @nicks;
253    my @normal = grep {!$_->{op} && !$_->{voice}} @nicks;
254    my @list = (
255      map ({['@', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @ops),
256      map ({['+', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @voices),
257      map ({[' ', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @normal));
258    my $max_width = 62 - length $context->{server1}->{nick};
259    my $rows = 1;
260    my @column_widths;
261    while ($rows < @list)
262    {
263        @column_widths = ();
264        my $width = 0;
265        my $i = 0;
266        while ($i < @list)
267        {
268            my $column_width = 0;
269            foreach my $j ($i .. $i+$rows-1)
270            {
271                last if $j >= @list;
272                my $len = length $list[$j][1];
273                $column_width = $len if $column_width < $len;
274            }
275            push @column_widths, $column_width;
276            $width += $column_width + 4;
277            $i += $rows;
278        }
279        last if $width - 1 <= $max_width;
280        ++$rows;
281    }
282    my @output;
283    foreach my $i (0..$#list)
284    {
285        $output[$i % $rows] .=
286          sprintf "[%s%*s] ",
287          $list[$i][0], -$column_widths[int ($i / $rows)], $list[$i][1];
288    }
289    foreach my $row (@output)
290    {
291        chop $row;
292        message $context->{chan1}, $row;
293    }
294}
295
296my %commands =
297(
298    mode => sub
299    {
300        my ($context, $nick, $args) = @_;
301        unless ($args =~ /^ +\* +(.*)$/ ||
302                $args =~ /^ +\Q$context->{channel2}\E +(.*)$/)
303        {
304            special_message_for $context->{chan1}, $nick,
305              "Usage: \\mode * <mode> [<mode parameters>]";
306            return;
307        }
308        change_mode $context, $nick, $1;
309    },
310    op => sub {&change_perms('op', '+', 'o', @_)},
311    deop => sub {&change_perms('deop', '-', 'o', @_)},
312    voice => sub {&change_perms('voice', '+', 'v', @_)},
313    devoice => sub {&change_perms('devoice', '-', 'v', @_)},
314    kick => sub
315    {
316        my ($context, $nick, $args) = @_;
317        unless ($args =~ /^ +([^ ]+)(| .*)$/)
318        {
319            special_message_for $context->{chan1}, $nick,
320              "Usage: \\kick <nicks> [<reason>]";
321            return;
322        }
323        my ($nicks, $reason) = ($1, $2);
324        $reason = $reason =~ /^ ?$/ ? " $nick" : " <$nick>$reason"
325          if defined $nick;
326        return unless must_be_op($context, $nick);
327        $context->{server2}->command("kick $context->{channel2} $nicks$reason");
328    },
329    names => \&names,
330);
331
332sub run_command($$$$)
333{
334    my ($context, $nick, $command, $args) = @_;
335    my $func = $commands{lc $command};
336    unless ($func)
337    {
338        special_message_for $context->{chan1}, $nick,
339          "Unknown command: $command";
340        return;
341    }
342    $func->($context, $nick, $args);
343}
344
345Irssi::signal_add "message public", sub
346{
347    my ($server1, $msg, $nick, $address, $channel1) = @_;
348    my $context = channel_context($server1, $channel1) or return;
349    if ($msg =~ /^\\([^ ]+)(| .*)$/)
350    {
351        Irssi::signal_continue @_;
352        run_command $context, $nick, $1, $2;
353    }
354    elsif ($msg =~ /^<.[^ ]+> /)
355    {
356        print CLIENTERROR
357          "Warning! Channels $context->{chatnet1}/$context->{channel1} " .
358          "and $context->{chatnet2}/$context->{channel2} are linked twice.";
359        Irssi::command "beep";
360    }
361    else
362    {
363        my $nk = $context->{chan1}->nick_find($nick);
364        my $perm = $nk->{op} ? '@' : $nk->{voice} ? '+' : ' ';
365        message $context->{chan2}, "<$perm$nick> $msg";
366    }
367};
368
369Irssi::signal_add "message own_public", sub
370{
371    my ($server1, $msg, $channel1) = @_;
372    return if $lock_own;
373    my $context = channel_context($server1, $channel1) or return;
374    if ($msg !~ s/^\\ // && $msg =~ /^\\([^ ]+)(| .*)$/)
375    {
376        Irssi::signal_continue @_;
377        run_command $context, undef, $1, $2;
378    }
379    else
380    {
381        message $context->{chan2}, $msg;
382    }
383};
384
385Irssi::signal_add "message irc action", sub
386{
387    my ($server1, $msg, $nick, $address, $channel1) = @_;
388    my $context = channel_context($server1, $channel1) or return;
389    message $context->{chan2}, " * $nick $msg";
390};
391
392Irssi::signal_add "message irc own_action", sub
393{
394    my ($server1, $msg, $channel1) = @_;
395    return if $lock_own;
396    my $context = channel_context($server1, $channel1) or return;
397    $lock_own = 1;
398    $context->{server2}->command("action $context->{channel2} $msg");
399    $lock_own = 0;
400};
401
402Irssi::signal_add "message join", sub
403{
404    my ($server1, $channel1, $nick, $address) = @_;
405    my $context = channel_context($server1, $channel1) or return;
406    special_message $context->{chan2},
407      "$nick [$address] has joined $channel1";
408};
409
410Irssi::signal_add "message part", sub
411{
412    my ($server1, $channel1, $nick, $address, $reason) = @_;
413    my $context = channel_context($server1, $channel1) or return;
414    special_message $context->{chan2},
415      "$nick [$address] has left $context->{channel1} [$reason]";
416};
417
418Irssi::signal_add "message quit", sub
419{
420    my ($server1, $nick, $address, $reason) = @_;
421    foreach my $context (channel_contexts_with_nick($server1, $nick))
422    {
423        special_message $context->{chan2},
424          "$nick [$address] has quit [$reason]";
425    }
426};
427
428Irssi::signal_add "message topic", sub
429{
430    my ($server1, $channel1, $topic, $nick, $address) = @_;
431    return if $nick eq $server1->{nick};
432    my $context = channel_context($server1, $channel1) or return;
433    if ($topic eq "")
434    {
435        special_message $context->{chan2},
436          "Topic unset by $nick on $context->{channel1}";
437        $context->{server2}->command("topic -delete $context->{channel2}");
438    }
439    else
440    {
441        special_message $context->{chan2},
442          "$nick changed the topic of $context->{channel1} to: $topic";
443        $context->{server2}->command("topic $context->{channel2} $topic");
444    }
445};
446
447Irssi::signal_add "message nick", sub
448{
449    my ($server1, $newnick, $oldnick, $address) = @_;
450    foreach my $context (channel_contexts_with_nick($server1, $newnick))
451    {
452        special_message $context->{chan2},
453          "$oldnick is now known as $newnick";
454    }
455};
456
457Irssi::signal_add "message own_nick", sub
458{
459    my ($server1, $newnick, $oldnick, $address) = @_;
460    foreach my $context (channel_contexts_with_nick($server1, $newnick))
461    {
462        next if $context->{chatnet1} eq $context->{chatnet2};
463        special_message $context->{chan2},
464          "$oldnick is now known as $newnick";
465    }
466};
467
468Irssi::signal_add "message kick", sub
469{
470    my ($server1, $channel1, $nick, $kicker, $address, $reason) = @_;
471    my $context = channel_context($server1, $channel1) or return;
472    special_message $context->{chan2},
473      "$nick was kicked from $context->{channel1} " .
474      "by $kicker [$reason]";
475};
476
477Irssi::signal_add "event mode", sub
478{
479    my ($server1, $data, $nick) = @_;
480    $data =~ /^([^ ]*) (.*)$/ or return;
481    my ($channel1, $mode) = ($1, $2);
482    my $context = channel_context($server1, $channel1) or return;
483    special_message $context->{chan2},
484      "mode/$context->{channel1} [$mode] by $nick";
485};
486
487load_config;
488
489