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

#!/usr/bin/perl

use strict;

use Socket;
use IO::Socket::INET;

use YAML;
use Encode;
use Event;
use Net::Knuddels;
use Algorithm::MarkovChain;

my @CHANNELS = (
  'Flirt', 
  'Flirt Private', 
  'Flirt Private 2', 
  'Singles 11-14', 
  'Singles 11-14 2', 
  'Singles 15-17',

  'Flirt 2', 
  'Singles 11-14 3', 
  'Singles 15-17 2',
  'Flirt 3', 
  'Singles 11-14 4', 
  'Singles 15-17 3',
  'Flirt 4', 
  'Singles 11-14 5', 
  'Singles 15-17 4',
  'Flirt 5', 
  'Singles 11-14 6', 
  'Singles 15-17 5',
  'Flirt 6', 
  'Singles 11-14 7', 
  'Singles 15-17 6',
  'Flirt 7', 
  'Singles 11-14 8', 
  'Singles 15-17 7',
  'Flirt 8', 
  'Singles 11-14 9', 
  'Singles 15-17 8',
);

my $logdir = "logs/";

my $Knick = "ich bin suess";
my $Kpass = "qwerty";

my $client;

my $seed = Load do { open my $fh, "<", "markovbot.dat"; binmode $fh, ":utf8"; local $/; <$fh> };
$seed ||= [];

my $markov = new Algorithm::MarkovChain;

sub seed_msg {
   my $msg = $_[0];
   my @msg = $msg =~ m/(\S+)/g;

   $markov->seed (symbols => \@msg, longest => 10);
}

for (@$seed) {
   seed_msg $_;
}

sub gen_reply {
   my ($msg) = @_;

   join " ", $markov->spew (length => 15, stop_at_terminal => 1)
}

Event->signal (signal => "INT", cb => sub { Event::unloop(-1) });

Event->timer (interval => 60, cb => sub {
   open my $fh, ">", "markovbot.dat~"
      or return;
   print $fh Encode::encode_utf8 Dump $seed;
   close $fh;
   rename "markovbot.dat~", "markovbot.dat";
});

sub connect_knuddels {
  $client->login;
  Event->io (
    fd => $client->fh, 
    poll => 'r', 
    cb => sub { 
      my $e = shift;
      if (not $client->ready) {
        $e->w->cancel;
      }
    });
}

sub logit {
  my ($msg, $file, $src, $dst, $room) = @_;

  unless (-e $logdir) {
    mkdir $logdir;
  }

  unless (open T, ">>$logdir/$file") {
    warn "Couldn't open for appending $logdir/$src: $!\n";
    return;
  }

  print T "$room\t$src\t$dst\t$msg\n";
  close T;
}

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

$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";

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

$client->register (login => sub {
   for (@CHANNELS) {
      print "JOIN($_)\n";
      $client->enter_room ($_, $Knick, $Kpass);
      sleep 1;
   }
});

$client->register (msg_room => sub {
   my ($room, $user, $msg) = @_;
});

my @queue;

Event->timer (interval => 1, cb => sub {
   my $msg = shift @queue
      or return;

   logit ($msg->[2], $msg->[0], $Knick, $msg->[0], $msg->[1]);
   $client->send_priv_msg (@$msg);
});

my %last;

$client->register (msg_priv_nondup => sub {
   my ($room, $src, $dst, $msg) = @_;

   return if $last{$src} eq $msg; $last{$src} = $msg;

   $msg =~ s/\260[^\260]*\260//g;

   print "($room) $src >> $msg\n";
   logit ($msg, $src, $src, $dst, $room);

   push @$seed, $msg;

   my $reply = gen_reply $msg;

   my $delay = 30 * (rand) ** 5 + 0.3 * length $reply;

   print "($room) $src << $reply ($delay)\n";

   Event->timer (after => $delay, cb => sub {
      push @queue, [$src, $room, $reply];
   });
});

connect_knuddels;
Event::loop;

Revision:	1.11
Committed:	Sat Jan 29 00:23:07 2005 UTC (21 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.10:	+59 -25 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	elmex	1.1	#!/usr/bin/perl
2
3			use strict;
4	root	1.2
5	elmex	1.1	use Socket;
6			use IO::Socket::INET;
7	root	1.2
8			use YAML;
9			use Encode;
10	elmex	1.1	use Event;
11			use Net::Knuddels;
12	root	1.2	use Algorithm::MarkovChain;
13	elmex	1.1
14			my @CHANNELS = (
15	elmex	1.3	'Flirt',
16	root	1.11	'Flirt Private',
17			'Flirt Private 2',
18	root	1.10	'Singles 11-14',
19			'Singles 11-14 2',
20			'Singles 15-17',
21	root	1.11
22			'Flirt 2',
23			'Singles 11-14 3',
24			'Singles 15-17 2',
25			'Flirt 3',
26			'Singles 11-14 4',
27			'Singles 15-17 3',
28			'Flirt 4',
29			'Singles 11-14 5',
30			'Singles 15-17 4',
31			'Flirt 5',
32			'Singles 11-14 6',
33			'Singles 15-17 5',
34			'Flirt 6',
35			'Singles 11-14 7',
36			'Singles 15-17 6',
37			'Flirt 7',
38			'Singles 11-14 8',
39			'Singles 15-17 7',
40			'Flirt 8',
41			'Singles 11-14 9',
42			'Singles 15-17 8',
43	elmex	1.1	);
44
45	elmex	1.4	my $logdir = "logs/";
46
47	elmex	1.1	my $Knick = "ich bin suess";
48			my $Kpass = "qwerty";
49
50			my $client;
51
52	root	1.11	my $seed = Load do { open my $fh, "<", "markovbot.dat"; binmode $fh, ":utf8"; local $/; <$fh> };
53	root	1.2	$seed \|\|= [];
54
55	root	1.11	my $markov = new Algorithm::MarkovChain;
56
57			sub seed_msg {
58			my $msg = $_[0];
59			my @msg = $msg =~ m/(\S+)/g;
60
61			$markov->seed (symbols => \@msg, longest => 10);
62			}
63
64			for (@$seed) {
65			seed_msg $_;
66			}
67
68			sub gen_reply {
69			my ($msg) = @_;
70
71			join " ", $markov->spew (length => 15, stop_at_terminal => 1)
72			}
73
74			Event->signal (signal => "INT", cb => sub { Event::unloop(-1) });
75	root	1.2
76	root	1.8	Event->timer (interval => 60, cb => sub {
77	root	1.11	open my $fh, ">", "markovbot.dat~"
78	root	1.2	or return;
79			print $fh Encode::encode_utf8 Dump $seed;
80			close $fh;
81	root	1.11	rename "markovbot.dat~", "markovbot.dat";
82	root	1.2	});
83
84	elmex	1.1	sub connect_knuddels {
85			$client->login;
86			Event->io (
87			fd => $client->fh,
88			poll => 'r',
89			cb => sub {
90			my $e = shift;
91			if (not $client->ready) {
92			$e->w->cancel;
93			}
94			});
95			}
96
97	elmex	1.4	sub logit {
98	elmex	1.6	my ($msg, $file, $src, $dst, $room) = @_;
99	elmex	1.4
100			unless (-e $logdir) {
101			mkdir $logdir;
102			}
103
104	elmex	1.6	unless (open T, ">>$logdir/$file") {
105	elmex	1.4	warn "Couldn't open for appending $logdir/$src: $!\n";
106			return;
107			}
108
109			print T "$room\t$src\t$dst\t$msg\n";
110			close T;
111			}
112
113	elmex	1.1	####################################################################################
114			########################## MAIN START ##############################################
115			####################################################################################
116
117			$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";
118
119	root	1.11	#$client->register (ALL => sub {
120	root	1.7	# use Dumpvalue;
121			# print "---\n";
122			# Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]);
123			#});
124
125	elmex	1.1	$client->register (login => sub {
126	root	1.11	for (@CHANNELS) {
127			print "JOIN($_)\n";
128			$client->enter_room ($_, $Knick, $Kpass);
129			sleep 1;
130			}
131	elmex	1.1	});
132
133			$client->register (msg_room => sub {
134			my ($room, $user, $msg) = @_;
135	root	1.2	});
136
137			my @queue;
138
139			Event->timer (interval => 1, cb => sub {
140			my $msg = shift @queue
141			or return;
142
143	elmex	1.6	logit ($msg->[2], $msg->[0], $Knick, $msg->[0], $msg->[1]);
144	root	1.2	$client->send_priv_msg (@$msg);
145	elmex	1.1	});
146
147	root	1.11	my %last;
148
149			$client->register (msg_priv_nondup => sub {
150	elmex	1.1	my ($room, $src, $dst, $msg) = @_;
151
152	root	1.11	return if $last{$src} eq $msg; $last{$src} = $msg;
153	root	1.2
154	root	1.7	$msg =~ s/\260[^\260]*\260//g;
155
156	root	1.2	print "($room) $src >> $msg\n";
157	elmex	1.6	logit ($msg, $src, $src, $dst, $room);
158	root	1.2
159	root	1.11	push @$seed, $msg;
160	elmex	1.1
161	root	1.11	my $reply = gen_reply $msg;
162	elmex	1.1
163	root	1.9	my $delay = 30 * (rand) ** 5 + 0.3 * length $reply;
164
165	root	1.8	print "($room) $src << $reply ($delay)\n";
166	elmex	1.1
167	root	1.2	Event->timer (after => $delay, cb => sub {
168			push @queue, [$src, $room, $reply];
169			});
170	elmex	1.1	});
171
172			connect_knuddels;
173			Event::loop;
174	root	1.7