1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
package Plugin::Markov;
use strict;
use warnings;
use HTTP::Tiny;
use HTML::Parser;
use HTML::Entities;
use utf8;
use Encode;
use IdaliusConfig qw/assert_scalar/;
my $config;
my %markov_data;
sub configure
{
my $self = shift;
my $cmdref = shift;
shift; # run_command
$config = shift;
IdaliusConfig::assert_scalar($config, $self, "chance");
die "chance must be non-negative" unless $config->{chance};
IdaliusConfig::assert_scalar($config, $self, "log_file");
die "log_file must be specified" unless $config->{log_file};
# Perform the actual learning from log file
die "Failed to learn markov\n" unless markov_learn();
$cmdref->($self, "markov", sub { $self->markov_cmd(@_); });
return $self;
}
sub markov_learn
{
open(my $f, "<", $config->{log_file})
or die ("Cannot open $config->{log_file}: $!\n");
while (<$f>) {
chomp;
utf8::decode($_);
my @words = split /\s+/, $_;
# Learning is the same for all but last word
for (my $i = 0; $i < @words - 1; $i++) {
my $word = $words[$i];
my $next_word = $words[$i + 1]; # +1 safe beacuse of loop bounds
push @{$markov_data{$word}}, $next_word;
}
# Now handle special case; last word must be learned as being followed by EOL ("")
push @{$markov_data{$words[@words - 1]}}, "";
}
close($f);
return 1;
}
sub random_trigger_odds
{
return int(rand(100)) < $config->{chance};
}
# FIXME factor out with other modules
sub some
{
my @choices = @_;
return $choices[rand(@choices)];
}
sub do_markov
{
my $word = $_[0];
$word = some(keys %markov_data) unless $word;
my $message = "";
my $i = 0;
do {
$i++;
$message .= "$word ";
$word = some(@{$markov_data{$word}});
} until(not $word or $word eq "" or $i == 1000);
return $message;
}
sub markov_cmd
{
my ($self, $irc, $logger, $who, $where, $ided, $rest, $no_reenter, @arguments) = @_;
my $seed = $arguments[0];
return do_markov($seed);
return "foo";
}
sub on_message
{
my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_;
return "" unless random_trigger_odds();
return do_markov(some(split " ", $what));
}
sub on_action {
on_message(@_);
}
1;
|
