aboutsummaryrefslogtreecommitdiff
path: root/Plugin
diff options
context:
space:
mode:
authorDavid Phillips <david@sighup.nz>2019-09-29 15:16:38 +1300
committerDavid Phillips <david@sighup.nz>2019-09-29 15:16:38 +1300
commit6ded0c1f6f34e115f6e60db0e475cf9cbce04de5 (patch)
tree119a011589725e14b510a2a1eb4471e3c27f721b /Plugin
parent892c385e04880f723567b3611eb945093f1eed8b (diff)
downloadidalius-6ded0c1f6f34e115f6e60db0e475cf9cbce04de5.tar.xz
Add new rough-and-ready/PoC Markov plugin
Diffstat (limited to 'Plugin')
-rw-r--r--Plugin/Markov.pm110
1 files changed, 110 insertions, 0 deletions
diff --git a/Plugin/Markov.pm b/Plugin/Markov.pm
new file mode 100644
index 0000000..a8d5f8f
--- /dev/null
+++ b/Plugin/Markov.pm
@@ -0,0 +1,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;