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;