#!/usr/bin/perl

use strict;
use lib '../Net-IRC-Server/';
use IO::Select;
use Socket;
use IO::Socket::INET;
use Event;
use Net::Knuddels;
use Net::IRC::Server;

my $client;
my $ircsrv;
my %irc_clients;

my %knuddel_to_irc;
my %irc_to_knuddel;
my %knuddel_channels;
my %irc_chan_to_knuddel;

my $kn_active; 

my %privmsg_receiver;

my $server_cl = { nickname => "_", username => "server", hostname => "localhost" };

sub scan_msg_nicks {
  my ($msg) = @_;

  for (keys %irc_to_knuddel) {
    my $n = $irc_to_knuddel{$_}->{knuddelnick};
    if ($msg =~ s/\b\Q$_\E\b/$n\1/gi) { last }
  }
  return $msg;
}

sub ready_irc_server {
  $ircsrv = Net::IRC::Server->new (srv_prefix => "this.de");

  $ircsrv->set_send_cb (sub {
    my ($cl, $data, @msg) = @_;

    if (not defined $cl->{socket}) {
      return 1;
    }
    
  }, 'PRIVMSG');

  $ircsrv->set_cmd_cb ('!', sub {
    my ($cl, $msg) = @_;
    $privmsg_receiver{$cl->{nickname}} = $cl;
  });

  $ircsrv->set_cmd_cb ('WHOIS', sub {
    my ($cl, $msg) = @_;
    my $kcl = $irc_to_knuddel{lc $msg->{params}->[0]};
    $client->send_whois ($kcl->{knuddelroom}, $kcl->{knuddelnick});

    return 1;
  });
  $ircsrv->set_cmd_cb ('PRIVMSG', sub {
    my ($cl, $msg) = @_;

    my $targ = $msg->{params}->[0];
    my $imsg = scan_msg_nicks $msg->{params}->[1];

    $imsg =~ s/(?<!\\)#/\//;
    $imsg =~ s/^\\#/#/;
    
    if (defined $knuddel_channels{lc $targ}) {

      $client->send_room_msg (irc_to_room ($targ), $imsg);

      return 1;
    } elsif (defined $irc_to_knuddel{lc $targ}) {
      my $cl = $irc_to_knuddel{lc $targ};

      $client->send_priv_msg ($cl->{knuddelnick}, $cl->{knuddelroom}, $imsg);
      return 1;
    }
    return 0;
  });
  $ircsrv->set_send_cb (sub {
    my ($cl, $data) = @_;

    if (defined $cl->{socket}) { # a knuddels-client

      $cl->{socket}->syswrite ($data);
      print "send $cl->{nickname}> $data"
    }
  });

  my $sock = IO::Socket::INET->new(
      Listen    => 5,
#      LocalAddr => localhost,
      LocalPort => 6667,
      Proto     => 'tcp',
      ReuseAddr => 1);

  if (!$sock) { die "Couldn't get listening socket: $!\n" }

  Event->io (
     fd => $sock, 
     poll => 'r', 
     cb => sub { 
        my $newfh = $sock->accept ();
        my $addr = $newfh->sockaddr ();
        $irc_clients{$newfh} = { hostname => inet_ntoa ($addr), socket => $newfh };

        Event->io (
          fd => $newfh,
          poll => 'r',
          cb => sub {
            my ($e) = @_;

            my $data;
            my $c = $newfh->sysread ($data, 2048);
            print "recv $irc_clients{$newfh}->{nickname}> $data";

            if ($c == 0) {
              $e->w->cancel ();
              $newfh->close ();

            } else {
              $ircsrv->feed_irc_data ($irc_clients{$newfh}, $data);
            }
         });
    });
}
sub connect_knuddels {
  return if $kn_active; # don't make another login if we are already in

  $client->login;
  Event->io (
    fd => $client->fh, 
    poll => 'r', 
    cb => sub { 
      my $e = shift;
      if (not $client->ready) {
        $e->w->cancel;
      }
    });
}

sub room_to_irc {
  my $o = $_[0];
  $_[0] =~ s/[ ]/_/g;
  $_[0] =~ s/[^a-zA-Z0-9_-]*//g;
  $irc_chan_to_knuddel{lc "#$_[0]"} = $o;
  lc "#$_[0]"
}

sub irc_to_room {
  $irc_chan_to_knuddel{lc $_[0]};
}

sub knuddel_room_msg {
  my ($room, $user, $msg) = @_;

  $room = room_to_irc $room;
  my $kncl = $knuddel_channels{$room}->{knd}->{lc $user};
  $ircsrv->generic_msg ($kncl, $room, "PRIVMSG", $msg);
}

sub knuddel_priv_msg {
  my ($room, $src, $dst, $msg) = @_;

  my $srccl = $knuddel_to_irc{lc $src};
  # not of much meaning ;) # my $dstcl = $knuddel_channels{room_to_irc $room}->{knd}->{lc $dst};

  $ircsrv->generic_msg ($srccl, $_, "PRIVMSG", $msg) for keys %privmsg_receiver;
}

sub part_knuddels_nick {
  my ($knuddels_nick, $room) = @_;
  
  $room = room_to_irc $room;
  
  my $kncl = $knuddel_channels{$room}->{knd}->{lc $knuddels_nick};
  delete $knuddel_channels{$room}->{irc}->{lc $kncl->{nickname}};

  $ircsrv->part_channel ($kncl, $room)
}

sub action_knuddels {
  my ($room, $action) = @_;
  $ircsrv->generic_msg ($server_cl,
                        room_to_irc ($room), "PRIVMSG", $action) for keys %privmsg_receiver;
}

sub join_knuddels_nick {
  my ($knuddel_nick, $age, $gender, $room) = @_;
  my $orig_knick = $knuddel_nick;
  $knuddel_nick =~ s/[ ]/_/g;
  $knuddel_nick =~ s/[<]/{/g;
  $knuddel_nick =~ s/[>]/}/g;
  $knuddel_nick =~ s/[=]/^/g;
  $knuddel_nick =~ s/[&]/\\/g;
  $knuddel_nick =~ s/[+]/_/g;
  $knuddel_nick =~ s/[\344]/ae/g;
  $knuddel_nick =~ s/[\324]/Ae/g;
  $knuddel_nick =~ s/[\366]/oe/g;
  $knuddel_nick =~ s/[\346]/Oe/g;
  $knuddel_nick =~ s/[\374]/ue/g;
  $knuddel_nick =~ s/[\334]/Ue/g;
  $knuddel_nick =~ s/[\337]/ss/g;
  $knuddel_nick =~ s/[^a-zA-Z0-9_-]*//g;

  if (defined $irc_to_knuddel{lc $knuddel_nick}) {
    my $d = 2;

    while (defined $irc_to_knuddel{lc ($knuddel_nick.$d)}) {
      $d++;
    }
    $knuddel_nick = $knuddel_nick.$d;
  }

  $irc_to_knuddel{lc $knuddel_nick} = {
    nickname => $knuddel_nick,
    username => $knuddel_nick,
    hostname => "knuddels.de",
    realname => "$knuddel_nick ($age) [$gender]",
    knuddelnick => $orig_knick,
    knuddelroom => $room,
    registered => 1
  };

  my $kncl = $knuddel_to_irc{lc $orig_knick} = $irc_to_knuddel{lc $knuddel_nick};

  $room = room_to_irc $room;

  $knuddel_channels{$room}->{knd}->{lc $orig_knick} = $kncl;
  $knuddel_channels{$room}->{irc}->{lc $knuddel_nick} = $kncl;

  $ircsrv->join_channel ($kncl, $room)
}

####################################################################################
########################## MAIN START ##############################################
####################################################################################

$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";


$client->register (UNHANDLED => sub {
   use Dumpvalue;
   print "---\n";
   Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]);
});

$client->register (login => sub {
   $client->set_nick ("Wolke7 2", "Net-Knuddels", "lolfe");
   $kn_active = 1;
});

$client->register (msg_room => sub {
   my ($room, $user, $msg) = @_;
   print "($room) $user: $msg\n";
   knuddel_room_msg ($room, $user, $msg);
});

$client->register (msg_priv => sub {
   my ($room, $src, $dst, $msg) = @_;
   print "($room) ########### $src an $dst: $msg\n";
   knuddel_priv_msg ($room, $src, $dst, $msg);
});

$client->register (dialog => sub {
  for my $l (@{$_[0]}) {
    $l =~ s/\260[^\260]*\260//g;
    $ircsrv->generic_msg ($server_cl, $_, "PRIVMSG", $l) for keys %privmsg_receiver;
  }
});

$client->register (join_room => sub {
  print "$_[1]->{name} joined $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
  join_knuddels_nick ($_[1]->{name}, $_[1]->{age}, $_[1]->{gender}, $_[0]);
});

$client->register (action_room => sub {
  action_knuddels ($_[0], $_[1]);
});
$client->register (part_room => sub {
  print "$_[1]->{name} left $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
  part_knuddels_nick ($_[1]->{name}, $_[0]);
});

$client->register (user_list => sub {
   my ($room, $list) = @_;
   print "***** USER JOIN FUER $room *****\n";

  join_knuddels_nick ($_->{name}, $_->{age}, $_->{gender}, $room)
     for values %$list;

   print scalar (keys %$list)." users\n";
   print "********************************\n";
});

$client->register (room_info => sub {
  my ($room, $ri) = @_;
  print "ROOM INFO: $room : $ri->{picture}\n";
});

ready_irc_server;
connect_knuddels;
Event::loop;