#!/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; 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 ('PRIVMSG', sub { my ($cl, $msg) = @_; my $targ = $msg->{params}->[0]; my $imsg = $msg->{params}->[1]; print "::: $targ :: $imsg \n"; print join(',', keys %knuddel_channels). "<<<<<<<<\n"; 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 ({ nickname => "|", username => "server", hostname => "localhost" }, 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/[ä]/ae/g; # $knuddel_nick =~ s/[Ä]/ae/g; # $knuddel_nick =~ s/[ö]/oe/g; # $knuddel_nick =~ s/[Ö]/Oe/g; # $knuddel_nick =~ s/[ü]/ue/g; # $knuddel_nick =~ s/[Ü]/Ue/g; # $knuddel_nick =~ s/[ß]/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 (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;