#!/usr/bin/perl

package Knuddler;

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;
   $self;
}

sub set_ircclient {
  my ($self, $icl) = @_;
  $self->{icl} = $icl;
}

sub room_to_irc {
  my ($self, $room) = @_;
  my $o = $room;

  $room =~ s/[ ]/_/g;
  $room =~ s/[^a-zA-Z0-9_-]*//g;
  print "r2i '$o' -> '#$room'\n";
  $self->{c2r}->{lc "#$room"} = $o;
  lc "#$room"
}

sub irc_to_room {
  my ($self, $ircchan) = @_;
  if (not defined $self->{c2r}->{lc $ircchan}) {
    $ircchan =~ s/^#//;
    $ircchan =~ s/_/ /g;
    return $ircchan;
  }
  return $self->{c2r}->{lc $ircchan};
}

sub knuddler_to_nick {
  my ($self, $knuddler) = @_;

  return $self->{k2n}->{lc $orig_knick}
    if defined $self->{k2n}->{lc $orig_knick};

  my $orig_knick = $knuddler;
  $knuddler =~ s/[ ]/_/g;
  $knuddler =~ s/[<]/{/g;
  $knuddler =~ s/[>]/}/g;
  $knuddler =~ s/[=]/^/g;
  $knuddler =~ s/[&]/\\/g;
  $knuddler =~ s/[+]/_/g;
  $knuddler =~ s/[\344]/ae/g;
  $knuddler =~ s/[\324]/Ae/g;
  $knuddler =~ s/[\366]/oe/g;
  $knuddler =~ s/[\346]/Oe/g;
  $knuddler =~ s/[\374]/ue/g;
  $knuddler =~ s/[\334]/Ue/g;
  $knuddler =~ s/[\337]/ss/g;
  $knuddler =~ s/[^a-zA-Z0-9_-]*//g;


  if (defined $self->{n2k}->{lc $knuddler}) {
    my $d = 2;

    while (defined $self->{n2k}->{lc ($knuddler.$d)}) {
      $d++;
    }
    $knuddler = $knuddler.$d;
  }

  $self->{n2k}->{lc $knuddler} = $orig_knick;
  $self->{k2n}->{lc $orig_knick} = $knuddler;

  return $knuddler;
}

sub nick_to_knuddler {
  my ($self, $nick) = @_;

  return $self->{n2k}->{lc $nick} 
    if defined $self->{n2k}->{lc $nick};

  $nick =~ s/_/ /g;

  return $nick;
}

sub activate_client {
  my ($self, $knuddelnick, $kpass) = @_;
  $self->{active} = 1;
  $self->{knuddelnick} = $knuddelnick;
  $self->{knuddelpass} = $kpass;
}

sub ircprfx {
  my ($self, $nick) = @_;
  $self->{s}->mk_clpref ({ nickname => $nick, username => "knuddler", hostname => "knuddels.de", registered => 1 })
}

sub replace_msg_nicks {
  my ($self, $msg) = @_;

  for (keys %{$self->{n2k}}) {
    my $n = $self->{n2k}->{$_};

    if ($msg =~ s/\b\Q$_\E\b/$n/gi) { last }
  }
  return $msg;
}

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

  $room = $self->room_to_irc ($room);

  my $kn = $self->knuddler_to_nick ($user);

  $self->{s}->send_msg ($self->{icl}, $self->ircpre ($kn), "PRIVMSG", $msg, $room);
}

sub handle_priv_msg {
  my ($self, $src, $dst, $msg) = @_;
  return if $src =~ m/^James\d*$/ and $msg =~ m/Funktion.*knuschel.*gibt.*leider.*nich.*/i;

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

  $self->{s}->send_msg ($self->{icl}, $self->ircpre ($src), "PRIVMSG", $msg, $self->{icl});
}

sub irc_srvpre {
  my $self = shift;
  $self->{s}->mk_clpref ({ nickname => "}", username => "server", hostname => "localhost" });
}

sub handle_room_action {
  my ($self, $room, $action) = @_;
  $self->{s}->send_msg ($self->{icl}, $self->irc_srvpre (), "PRIVMSG", $action, room_to_irc ($room));
}

sub send_exit_room {
  my ($self, $ircchan) = @_;

  my $room = $self->irc_to_room ($ircchan);

  $self->{s}->send_msg ($self->{icl}, $self->{s}->mk_clpref ($self->{icl}), "PART", "parted", $ircchan);

  delete $self->{rooms}->{lc $room};
  delete $self->{channels}->{lc $ircchan};
  delete $self->{myrooms}->{lc $room};

  $self->{c}->send_exit_room ($self->irc_to_room ($ircchan));
}


sub send_enter_room {
  my ($self, $ircchan) = @_;

  my $room = $self->irc_to_room ($ircchan);

  $self->{c}->enter_room ($room, $self->{knuddelsnick}, $self->{knuddelspass});
}

sub handle_userlist {
  my ($self, $room, $list) = @_;
  
  for (values %$list) {
    $self->join_knuddler ($_->{name}, $_->{age}, $_->{gender}, $room);
  }

  $self->send_nameslist ($self->room_to_irc ($room));
}

sub handle_dialog {
  my ($self, $d) = @_;
  for my $l (@$d) {
    $l =~ s/\260[^\260]*female[^\260]*\260/weiblich/i;
    $l =~ s/\260[^\260]*male[^\260]*\260/maennlich/i;
    $l =~ s/\260[^\260]*\260//g;

    $ircsrv->send_msg ($self->{icl}, $self->irc_srvpre (), "NOTICE", $l, $self->{icl}->{nickname});
  }
}

sub send_nameslist {
  my ($self, $ic) = @_;

  my $i = 1;
  my @part;
  
  for (keys %{$self->{channels}->{lc $ic}}) {
    $i++;
    push @part, $_;

    if ($i % 10 == 0) {
      $self->{s}->send_srv_msg ($self->{icl}, "353", join (' ', @part), $self->{icl}->{nickname}, "=", $ic);
      @part = ();
    }
  }
  if (@part) {
   $self->{s}->send_srv_msg ($self->{icl}, "353", join (' ', @part), $self->{icl}->{nickname}, "=", $ic);
  }
  $self->{s}->send_srv_msg ($self->{icl}, "366", "End of NAMES list", $self->{icl}->{nickname}, $ic);
}

sub join_knuddler {
  my ($self, $knuddler, $age, $gender, $room) = @_;
  my $ic = $self->room_to_irc ($room);
  my $in = $self->knuddler_to_nick ($knuddler);

  my $i = {
    nickname => $in,
    knuddelnick => $knuddler,
    age => $age,
    gender => $gender
  };

  $self->{channels}->{lc $ic}->{lc $in}->{info} = 
    $self->{rooms}->{lc $room}->{lc $knuddler}->{info} = $i;

  $self->{s}->send_msg ($self->{icl}, $self->ircpre ($in), "JOIN", $ic);
}

sub part_knuddler {
  my ($knuddler, $room) = @_;
  my $ic = $self->room_to_irc ($room);
  my $in = $self->knuddler_to_nick ($knuddler);

  delete $self->{channels}->{lc $ic}->{lc $in};
  delete $self->{rooms}->{lc $room}->{lc $knuddler};

  $self->{s}->send_msg ($self->{icl}, $self->ircpre ($in), "PART", "parted nick", $ic);
}

sub handle_room_list {
  my ($self, $rooms) = @_;
  $self->room_to_irc ($_) for keys %$rooms;
}

sub change_room {
  my ($self, $oroom, $nroom) = @_;

  my $oic = $self->room_to_irc ($oroom);
  my $nic = $self->room_to_irc ($nroom);

  delete $self->{rooms}->{lc $oroom};
  delete $self->{channels}->{lc $oic};

  delete $self->{myrooms}->{lc $oroom};
  $self->{myrooms}->{lc $nroom} = 1;

  $self->{s}->send_msg ($self->{icl}, $self->{s}->mk_clpref ($self->{icl}), "PART", "change room", $oic);
  $self->{s}->send_msg ($self->{icl}, $self->{s}->mk_clpref ($self->{icl}), "JOIN", undef, $nic);
}

sub handle_room_info {
  my ($self, $room, $ri) = @_;

  $self->{myrooms}->{lc $room} = 1;
  $self->{s}->send_msg ($self->{icl}, $self->{s}->mk_clpref ($self->{icl}), "JOIN", undef, $self->room_to_irc ($room));
}


sub find_any_room {
  my ($self) = @_;

  return (keys %{$self->{myrooms}})[0];
}

sub send_keepalive_client {
  my ($self) = @_;
  my $r = $self->find_any_room ();

  print "KNUDDELS PING\n";
  return if not defined $r;
  print "PING TO $f->{knuddelroom} $f->{knuddelnick}\n";
  
  $self->{c}->send_room_msg ($r, "/knuschel");
}

package main;
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;
use YAML;

my %CFG = (
  server_cl_nick => "_",
  server_cl_user => "server",
  server_cl_host => "localhost",
  server_prefix  => "test.de",

  knuddel_nick   => "Net-Knuddels",
  knuddel_pass   => "lolfe",
  knuddel_chan   => "Flirt Private",
);

scan_config ();

my $KDL;
my $client;
my $ircsrv;
my $irc_client;

sub scan_config {
  my $config = "$ENV{HOME}/.knuddels2irc2.rc";

  if (! -e $config) { return; }
  
  my $h = YAML::LoadFile $config;

  if (defined $h and ref $h eq "HASH") {
    %CFG = (%CFG, %$h);
  } else {
    die "$config is not a map!";
  }
}

sub ready_irc_server {
  $ircsrv = Net::IRC::Server->new (srv_prefix => $CFG{server_prefix});

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

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

  $ircsrv->set_cmd_cb ('*', sub { 
    my $c = uc $_[1]->{command};
    return 1;
  }); # default handler ;) Overwrite _anything_ the server does

  $ircsrv->set_cmd_cb ('PING', sub {
    my ($cl, $msg) = @_;
    $ircsrv->send_srv_msg ($cl, "PONG", $msg->{params}->[0]);
  });
  $ircsrv->set_cmd_cb ('NICK', sub {
    my ($cl, $msg) = @_;
    $cl->{nickname} = $msg->{params}[0];
  });

  $ircsrv->set_cmd_cb ('USER', sub {
    my ($cl, $msg) = @_;
    $cl->{username} = $msg->{params}->[0];
    $cl->{realname} = $msg->{params}->[3];

    $ircsrv->send_srv_msg ($irc_client, 
                     "001", 
                     "Welcome to NET::IRCServer! " 
                     . $ircsrv->mk_clpref ($cl), 
                     $cl->{nickname});
  });

  $ircsrv->set_cmd_cb ('NAMES', sub {
    my ($cl, $msg) = @_;
    return if not defined $msg->{params}[0];
    $KDL->send_nameslist ($msg->{params}[0]);
  });

  $ircsrv->set_cmd_cb ('PART', sub {
    my ($cl, $msg) = @_;
    $KDL->send_exit_room ($msg->{params}[0]);
  });

  $ircsrv->set_cmd_cb ('JOIN', sub {
    my ($cl, $msg) = @_;
    print "ENTER ROOM: $msg->{params}[0]\n";
    $KDL->send_enter_room ($msg->{params}[0]);
  });

  $ircsrv->set_cmd_cb ('LIST', sub {

#    for (sort { $a cmp $b } keys %knuddel_channels) {
#      my $chan = $knuddel_channels{$_};
 #     my $c = room_to_irc ($chan->{name});

  #    $ircsrv->send_srv_msg (
   #      $irc_client,
    #     "322",
     #    $chan->{name} . ($chan->{full_flag} ? " (full)" : ""), 
      #   $irc_client->{nickname},
       #  "$c", 
#         $chan->{user_count});
 #   }
  #  $ircsrv->send_srv_msg ($irc_client, "323", "End of LIST", $irc_client->{nickname});
  });

#  $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 {
=pod
    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;
=cut
  });

  $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 ();
        
        if (defined $irc_client) {
          $newfh->close;
          print "NEWCL\n";
          return;
        }

        $irc_client = { hostname => inet_ntoa ($addr), socket => $newfh };
        $KDL->set_ircclient ($irc_client);

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

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

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

            } else {
              $ircsrv->feed_irc_data ($irc_client, $data);
            }
         });
    });
}
sub connect_knuddels {
  $client->login;
  Event->io (
    fd => $client->fh, 
    poll => 'r', 
    cb => sub { 
      my $e = shift;

      if (not $client->ready) {
        $e->w->cancel;
      }
    });
}

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

$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";
$KDL    = new Knuddler c => $client, s => $ircsrv;


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

$client->register (login => sub {
   $KDL->activate_client;

   Event->timer (interval => 60, cb => sub {
     $KDL->send_keepalive_client ();
   });
});

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

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

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

$client->register (action_room => sub {
  $KDL->handle_room_action ($_[0], $_[1]);
});

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

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

   $KDL->handle_userlist ($room);
});

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

$client->register (change_room => sub {
  my ($r, $nr) = @_;
  $KDL->change_room ($r, $nr);
});

$client->register (room_list => sub {
  my ($room_hash) = @_;
  $KDL->handle_room_list ($room_hash);
});

$client->register (dialog => sub {
  $KDL->handle_dialog ($_[0]);
});

ready_irc_server;
connect_knuddels;
Event::loop;