[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 2', 
  'Flirt 3', 
  'Flirt 4', 
  'Singles 11-14',
  'Singles 11-14 2',
  'Singles 11-14 3',
);

my $logdir = "logs/";

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

my $client;

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

$SIG{INT} = sub { Event::unloop(-1) };

Event->timer (interval => 1, cb => sub {
   open my $fh, ">", "markovd.dat~"
      or return;
   print $fh Encode::encode_utf8 Dump $seed;
   close $fh;
   rename "markovd.dat~", "markovd.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 (login => sub {
   $client->enter_room ($_, $Knick, $Kpass)
     for (@CHANNELS);
});

$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);
});

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

   return if $src eq "James";
   return if $src eq $Knick;

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

   push @$seed, grep $_, $msg =~ /(\S+)/g;

   my $markov = new Algorithm::MarkovChain;
   $markov->seed (symbols => $seed, longest => 7);

   my $reply = join " ", $markov->spew (length => 1, stop_at_terminal => 1);

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

   my $delay = (rand 8) + 0.2 * length $reply;
   warn "delay $delay\n";

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

connect_knuddels;
Event::loop;
Revision:	1.6
Committed:	Fri Jan 28 03:32:52 2005 UTC (21 years, 7 months ago) by elmex
Branch:	MAIN
Changes since 1.5:	+4 -4 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			'Flirt 2',
17			'Flirt 3',
18			'Flirt 4',
19	elmex	1.5	'Singles 11-14',
20			'Singles 11-14 2',
21			'Singles 11-14 3',
22	elmex	1.1	);
23
24	elmex	1.4	my $logdir = "logs/";
25
26	elmex	1.1	my $Knick = "ich bin suess";
27			my $Kpass = "qwerty";
28
29			my $client;
30
31	root	1.2	my $seed = Load do { open my $fh, "<", "markovd.dat"; binmode $fh, ":utf8"; local $/; <$fh> };
32			$seed \|\|= [];
33
34			$SIG{INT} = sub { Event::unloop(-1) };
35
36			Event->timer (interval => 1, cb => sub {
37			open my $fh, ">", "markovd.dat~"
38			or return;
39			print $fh Encode::encode_utf8 Dump $seed;
40			close $fh;
41			rename "markovd.dat~", "markovd.dat";
42			});
43
44	elmex	1.1	sub connect_knuddels {
45			$client->login;
46			Event->io (
47			fd => $client->fh,
48			poll => 'r',
49			cb => sub {
50			my $e = shift;
51			if (not $client->ready) {
52			$e->w->cancel;
53			}
54			});
55			}
56
57	elmex	1.4	sub logit {
58	elmex	1.6	my ($msg, $file, $src, $dst, $room) = @_;
59	elmex	1.4
60			unless (-e $logdir) {
61			mkdir $logdir;
62			}
63
64	elmex	1.6	unless (open T, ">>$logdir/$file") {
65	elmex	1.4	warn "Couldn't open for appending $logdir/$src: $!\n";
66			return;
67			}
68
69			print T "$room\t$src\t$dst\t$msg\n";
70			close T;
71			}
72
73	elmex	1.1	####################################################################################
74			########################## MAIN START ##############################################
75			####################################################################################
76
77			$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";
78
79			$client->register (login => sub {
80			$client->enter_room ($_, $Knick, $Kpass)
81			for (@CHANNELS);
82			});
83
84			$client->register (msg_room => sub {
85			my ($room, $user, $msg) = @_;
86	root	1.2	});
87
88			my @queue;
89
90			Event->timer (interval => 1, cb => sub {
91			my $msg = shift @queue
92			or return;
93
94	elmex	1.6	logit ($msg->[2], $msg->[0], $Knick, $msg->[0], $msg->[1]);
95	root	1.2	$client->send_priv_msg (@$msg);
96	elmex	1.1	});
97
98			$client->register (msg_priv => sub {
99			my ($room, $src, $dst, $msg) = @_;
100
101	root	1.2	return if $src eq "James";
102			return if $src eq $Knick;
103
104			print "($room) $src >> $msg\n";
105	elmex	1.6	logit ($msg, $src, $src, $dst, $room);
106	root	1.2
107			push @$seed, grep $_, $msg =~ /(\S+)/g;
108
109			my $markov = new Algorithm::MarkovChain;
110			$markov->seed (symbols => $seed, longest => 7);
111	elmex	1.1
112	root	1.2	my $reply = join " ", $markov->spew (length => 1, stop_at_terminal => 1);
113	elmex	1.1
114	root	1.2	print "($room) $src << $reply\n";
115	elmex	1.1
116	root	1.2	my $delay = (rand 8) + 0.2 * length $reply;
117			warn "delay $delay\n";
118	elmex	1.1
119	root	1.2	Event->timer (after => $delay, cb => sub {
120			push @queue, [$src, $room, $reply];
121			});
122	elmex	1.1	});
123
124			connect_knuddels;
125			Event::loop;