[ViewVC] Annotation of: cvs/Net-Knuddels/eg/knuddels2irc

#!/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;


Revision:	1.1
Committed:	Fri Jan 14 20:56:01 2005 UTC (21 years, 8 months ago) by elmex
Branch:	MAIN
Log Message:	a first knuddesl2irc gateway.
#	User	Rev	Content
1	elmex	1.1	#!/usr/bin/perl
2
3			use strict;
4			use lib '../Net-IRC-Server/';
5			use IO::Select;
6			use Socket;
7			use IO::Socket::INET;
8			use Event;
9			use Net::Knuddels;
10			use Net::IRC::Server;
11
12			my $client;
13			my $ircsrv;
14			my %irc_clients;
15
16			my %knuddel_to_irc;
17			my %irc_to_knuddel;
18			my %knuddel_channels;
19			my %irc_chan_to_knuddel;
20
21			my $kn_active;
22
23			my %privmsg_receiver;
24
25
26			sub ready_irc_server {
27			$ircsrv = Net::IRC::Server->new (srv_prefix => "this.de");
28
29			$ircsrv->set_send_cb (sub {
30			my ($cl, $data, @msg) = @_;
31
32			if (not defined $cl->{socket}) {
33			return 1;
34			}
35
36			}, 'PRIVMSG');
37
38			$ircsrv->set_cmd_cb ('!', sub {
39			my ($cl, $msg) = @_;
40			$privmsg_receiver{$cl->{nickname}} = $cl;
41			});
42
43			$ircsrv->set_cmd_cb ('PRIVMSG', sub {
44			my ($cl, $msg) = @_;
45
46			my $targ = $msg->{params}->[0];
47			my $imsg = $msg->{params}->[1];
48
49			print "::: $targ :: $imsg \n";
50			print join(',', keys %knuddel_channels). "<<<<<<<<\n";
51			if (defined $knuddel_channels{lc $targ}) {
52			$client->send_room_msg (irc_to_room ($targ), $imsg);
53
54			return 1;
55			} elsif (defined $irc_to_knuddel{lc $targ}) {
56			my $cl = $irc_to_knuddel{lc $targ};
57
58			$client->send_priv_msg ($cl->{knuddelnick}, $cl->{knuddelroom}, $imsg);
59			return 1;
60			}
61			return 0;
62			});
63			$ircsrv->set_send_cb (sub {
64			my ($cl, $data) = @_;
65
66			if (defined $cl->{socket}) { # a knuddels-client
67
68			$cl->{socket}->syswrite ($data);
69			print "send $cl->{nickname}> $data"
70			}
71			});
72
73			my $sock = IO::Socket::INET->new(
74			Listen => 5,
75			# LocalAddr => localhost,
76			LocalPort => 6667,
77			Proto => 'tcp',
78			ReuseAddr => 1);
79
80			if (!$sock) { die "Couldn't get listening socket: $!\n" }
81
82			Event->io (
83			fd => $sock,
84			poll => 'r',
85			cb => sub {
86			my $newfh = $sock->accept ();
87			my $addr = $newfh->sockaddr ();
88			$irc_clients{$newfh} = { hostname => inet_ntoa ($addr), socket => $newfh };
89
90			Event->io (
91			fd => $newfh,
92			poll => 'r',
93			cb => sub {
94			my ($e) = @_;
95
96			my $data;
97			my $c = $newfh->sysread ($data, 2048);
98			print "recv $irc_clients{$newfh}->{nickname}> $data";
99
100			if ($c == 0) {
101			$e->w->cancel ();
102			$newfh->close ();
103
104			} else {
105			$ircsrv->feed_irc_data ($irc_clients{$newfh}, $data);
106			}
107			});
108			});
109			}
110			sub connect_knuddels {
111			return if $kn_active; # don't make another login if we are already in
112
113			$client->login;
114			Event->io (
115			fd => $client->fh,
116			poll => 'r',
117			cb => sub {
118			my $e = shift;
119			if (not $client->ready) {
120			$e->w->cancel;
121			}
122			});
123			}
124
125			sub room_to_irc {
126			my $o = $_[0];
127			$_[0] =~ s/[ ]/_/g;
128			$_[0] =~ s/[^a-zA-Z0-9_-]*//g;
129			$irc_chan_to_knuddel{lc "#$_[0]"} = $o;
130			lc "#$_[0]"
131			}
132
133			sub irc_to_room {
134			$irc_chan_to_knuddel{lc $_[0]};
135			}
136
137			sub knuddel_room_msg {
138			my ($room, $user, $msg) = @_;
139
140			$room = room_to_irc $room;
141			my $kncl = $knuddel_channels{$room}->{knd}->{lc $user};
142			$ircsrv->generic_msg ($kncl, $room, "PRIVMSG", $msg);
143			}
144
145			sub knuddel_priv_msg {
146			my ($room, $src, $dst, $msg) = @_;
147
148			my $srccl = $knuddel_to_irc{lc $src};
149			# not of much meaning ;) # my $dstcl = $knuddel_channels{room_to_irc $room}->{knd}->{lc $dst};
150
151			$ircsrv->generic_msg ($srccl, $_, "PRIVMSG", $msg) for keys %privmsg_receiver;
152			}
153
154			sub part_knuddels_nick {
155			my ($knuddels_nick, $room) = @_;
156
157			$room = room_to_irc $room;
158
159			my $kncl = $knuddel_channels{$room}->{knd}->{lc $knuddels_nick};
160			delete $knuddel_channels{$room}->{irc}->{lc $kncl->{nickname}};
161
162			$ircsrv->part_channel ($kncl, $room)
163			}
164
165			sub action_knuddels {
166			my ($room, $action) = @_;
167			$ircsrv->generic_msg ({ nickname => "\|", username => "server", hostname => "localhost" },
168			room_to_irc ($room), "PRIVMSG", $action) for keys %privmsg_receiver;
169			}
170
171			sub join_knuddels_nick {
172			my ($knuddel_nick, $age, $gender, $room) = @_;
173			my $orig_knick = $knuddel_nick;
174			$knuddel_nick =~ s/[ ]/_/g;
175			# $knuddel_nick =~ s/[ä]/ae/g;
176			# $knuddel_nick =~ s/[Ä]/ae/g;
177			# $knuddel_nick =~ s/[ö]/oe/g;
178			# $knuddel_nick =~ s/[Ö]/Oe/g;
179			# $knuddel_nick =~ s/[ü]/ue/g;
180			# $knuddel_nick =~ s/[Ü]/Ue/g;
181			# $knuddel_nick =~ s/[ß]/ss/g;
182			$knuddel_nick =~ s/[^a-zA-Z0-9_-]*//g;
183
184			if (defined $irc_to_knuddel{lc $knuddel_nick}) {
185			my $d = 2;
186
187			while (defined $irc_to_knuddel{lc ($knuddel_nick.$d)}) {
188			$d++;
189			}
190			$knuddel_nick = $knuddel_nick.$d;
191			}
192
193			$irc_to_knuddel{lc $knuddel_nick} = {
194			nickname => $knuddel_nick,
195			username => $knuddel_nick,
196			hostname => "knuddels.de",
197			realname => "$knuddel_nick ($age) [$gender]",
198			knuddelnick => $orig_knick,
199			knuddelroom => $room,
200			registered => 1
201			};
202
203			my $kncl = $knuddel_to_irc{lc $orig_knick} = $irc_to_knuddel{lc $knuddel_nick};
204
205			$room = room_to_irc $room;
206
207			$knuddel_channels{$room}->{knd}->{lc $orig_knick} = $kncl;
208			$knuddel_channels{$room}->{irc}->{lc $knuddel_nick} = $kncl;
209
210			$ircsrv->join_channel ($kncl, $room)
211			}
212
213			####################################################################################
214			########################## MAIN START ##############################################
215			####################################################################################
216
217			$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";
218
219
220			$client->register (UNHANDLED => sub {
221			use Dumpvalue;
222			print "---\n";
223			Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]);
224			});
225
226			$client->register (login => sub {
227			$client->set_nick ("Wolke7 2", "Net-Knuddels", "lolfe");
228			$kn_active = 1;
229			});
230
231			$client->register (msg_room => sub {
232			my ($room, $user, $msg) = @_;
233			print "($room) $user: $msg\n";
234			knuddel_room_msg ($room, $user, $msg);
235			});
236
237			$client->register (msg_priv => sub {
238			my ($room, $src, $dst, $msg) = @_;
239			print "($room) ########### $src an $dst: $msg\n";
240			knuddel_priv_msg ($room, $src, $dst, $msg);
241			});
242
243			$client->register (join_room => sub {
244			print "$_[1]->{name} joined $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
245			join_knuddels_nick ($_[1]->{name}, $_[1]->{age}, $_[1]->{gender}, $_[0]);
246			});
247
248			$client->register (action_room => sub {
249			action_knuddels ($_[0], $_[1]);
250			});
251			$client->register (part_room => sub {
252			print "$_[1]->{name} left $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
253			part_knuddels_nick ($_[1]->{name}, $_[0]);
254			});
255
256			$client->register (user_list => sub {
257			my ($room, $list) = @_;
258			print "*** USER JOIN FUER $room ***\n";
259
260			join_knuddels_nick ($_->{name}, $_->{age}, $_->{gender}, $room)
261			for values %$list;
262
263			print scalar (keys %$list)." users\n";
264			print "********************************\n";
265			});
266
267			$client->register (room_info => sub {
268			my ($room, $ri) = @_;
269			print "ROOM INFO: $room : $ri->{picture}\n";
270			});
271
272			ready_irc_server;
273			connect_knuddels;
274			Event::loop;
275
276
277