1 |
#!/usr/bin/perl |
2 |
|
3 |
use strict; |
4 |
|
5 |
use Event; |
6 |
use Net::Knuddels; |
7 |
|
8 |
my $client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710"; |
9 |
|
10 |
$client->login; |
11 |
|
12 |
my %channels; |
13 |
|
14 |
#0 "t" |
15 |
#1 ">" |
16 |
#2 "-" |
17 |
#3 "Schmusemann wird von NiceLovelyGirl z\344rtlich gek\374sst..." |
18 |
|
19 |
$client->register (b => sub { |
20 |
for (@_) { |
21 |
if ($_ ne "-") { |
22 |
|
23 |
} else { |
24 |
|
25 |
|
26 |
} |
27 |
} |
28 |
}); |
29 |
|
30 |
$client->register (UNHANDLED => sub { |
31 |
use Dumpvalue; |
32 |
print "---\n"; |
33 |
Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]); |
34 |
}); |
35 |
|
36 |
$client->register (login => sub { |
37 |
$client->set_nick ("Flirt 3", "Net-Knuddels", "lolfe"); |
38 |
}); |
39 |
|
40 |
$client->register (msg_room => sub { |
41 |
my ($room, $user, $msg) = @_; |
42 |
print "($room) $user: $msg\n"; |
43 |
}); |
44 |
|
45 |
$client->register (msg_priv => sub { |
46 |
my ($room, $src, $dst, $msg) = @_; |
47 |
print "($room) ########### $src an $dst: $msg\n"; |
48 |
}); |
49 |
|
50 |
$client->register (join_room => sub { |
51 |
print "$_[1]->{name} joined $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n"; |
52 |
|
53 |
}); |
54 |
|
55 |
$client->register (part_room => sub { |
56 |
print "$_[1]->{name} left $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n"; |
57 |
}); |
58 |
|
59 |
$client->register (user_list => sub { |
60 |
my ($room, $list) = @_; |
61 |
print "***** USER LIST FUER $room *****\n"; |
62 |
|
63 |
printf ("%s (%d) [%s]\n", $_->{name}, $_->{age}, $_->{gender}) |
64 |
for sort { $a->{name} cmp $b->{name} } values %$list; |
65 |
|
66 |
print scalar (keys %$list)." users\n"; |
67 |
print "********************************\n"; |
68 |
}); |
69 |
|
70 |
$client->register (room_info => sub { |
71 |
my ($room, $ri) = @_; |
72 |
print "ROOM INFO: $room : $ri->{picture}\n"; |
73 |
}); |
74 |
|
75 |
Event->io ( fd => $client->fh, poll => 'r', cb => sub { $client->ready }); |
76 |
|
77 |
Event::loop; |
78 |
|
79 |
|