ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-Knuddels/eg/elizabot
Revision: 1.1
Committed: Fri Jan 28 02:47:19 2005 UTC (19 years, 4 months ago) by elmex
Branch: MAIN
CVS Tags: HEAD
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/perl/bin/perl
2
3 use strict;
4 use Chatbot::Eliza;
5 use IO::Select;
6 use Socket;
7 use IO::Socket::INET;
8 use Event;
9 use Net::Knuddels;
10
11 my @CHANNELS = (
12 'Flirt',
13 'Flirt 2',
14 'Flirt 3',
15 'Flirt 4',
16 );
17
18 #my $Knick = "baileysmaedl";
19 my $Knick = "baileysmaedl";
20 my $Kpass = "qwerty";
21
22 my %bots;
23
24 my $client;
25
26 my @outcbs;
27
28 sub connect_knuddels {
29 $client->login;
30 Event->io (
31 fd => $client->fh,
32 poll => 'r',
33 cb => sub {
34 my $e = shift;
35 if (not $client->ready) {
36 $e->w->cancel;
37 }
38 });
39 }
40
41 ####################################################################################
42 ########################## MAIN START ##############################################
43 ####################################################################################
44
45 $client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";
46
47
48 $client->register (UNHANDLED => sub {
49 use Dumpvalue;
50 print "---\n";
51 Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]);
52 });
53
54 $client->register (login => sub {
55 $client->enter_room ($_, $Knick, $Kpass)
56 for (@CHANNELS);
57
58 Event->timer (interval => 7, cb => sub {
59 my $a = shift @outcbs;
60 $a->() if defined $a;
61 });
62 });
63
64 $client->register (msg_room => sub {
65 my ($room, $user, $msg) = @_;
66 # print "($room) $user: $msg\n";
67 });
68
69 $client->register (msg_priv => sub {
70 my ($room, $src, $dst, $msg) = @_;
71 return if $src =~ m/^James$/i;
72 return if $src =~ m/^$Knick$/i;
73
74 unless (defined $bots{lc $src}) {
75 $bots{lc $src} = new Chatbot::Eliza "knuddel", "deutsch.txt";
76 }
77 my $ans = $bots{lc $src}->transform ($msg);
78 push @outcbs, sub { $client->send_priv_msg ($src, $room, $ans); };
79 if (open T, ">>tmp/$src") {
80 print T "($room) $src an $dst >> $msg\n";
81 print T "($room) $dst an $src << $ans\n";
82 close T;
83 } else {
84 print "Couldn't open tmp/$src: $!\n";
85
86 }
87 print "($room) ########### $src an $dst : $msg\n";
88 print "($room) ########### $src an $dst<<< $ans\n";
89 });
90
91 $client->register (dialog => sub {
92 for my $l (@{$_[0]}) {
93 $l =~ s/\260[^\260]*\260//g;
94 print $l."\n";
95 }
96 });
97
98 $client->register (join_room => sub {
99 print "$_[1]->{name} joined $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
100 });
101
102 $client->register (part_room => sub {
103 print "$_[1]->{name} left $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
104 });
105
106 $client->register (user_list => sub {
107 my ($room, $list) = @_;
108 print "***** USER JOIN FUER $room *****\n";
109 print scalar (keys %$list)." users\n";
110 print "********************************\n";
111 });
112
113 $client->register (room_info => sub {
114 my ($room, $ri) = @_;
115 print "ROOM INFO: $room : $ri->{picture}\n";
116 });
117
118 connect_knuddels;
119 Event::loop;