initial commit

.gitignore

@@ -0,0 +1,3 @@
+brain
+*.swp
+config.yml

MarkovBot/Commands.pm

@@ -0,0 +1,44 @@
+package MarkovBot::Commands;
+use base qw(Exporter);
+
+our @EXPORT = qw(getCommandSubs);
+
+use FindBin qw($Bin);
+use lib $Bin;
+use MarkovBot::Ignore;
+
+sub commandPing() {
+  return "Pong!";
+}
+
+sub commandIgnore() {
+  my $command = shift;
+
+  if (scalar( @{$command} ) != 2) {
+    return "Usage: .ignore <user>";
+  }
+
+  ignore($command->[1]);
+  return "Now ignoring ".$command->[1].".";
+}
+
+sub commandUnignore() {
+  my $command = shift;
+
+  if (scalar( @{$command} ) != 2) {
+    return "Usage: .unignore <user>";
+  }
+
+  unignore($command->[1]);
+  return "No longer ignoring ".$command->[1].".";
+}
+
+sub getCommandSubs() {
+  return {
+    "ping" => \&commandPing,
+    "ignore" => \&commandIgnore,
+    "unignore" => \&commandUnignore,
+  };
+}
+
+1;

MarkovBot/Config.pm

@@ -0,0 +1,19 @@
+package MarkovBot::Config;
+use base qw(Exporter);
+
+our @EXPORT = qw(config);
+
+use FindBin qw($Bin);
+use YAML::Tiny;
+
+sub config( $ ) {
+  # config(var)
+  # returns config value
+  
+  my $var = shift;
+  
+  my $yaml = YAML::Tiny->read( "$Bin/config.yml" );
+  return $yaml->[0]->{$var};
+}
+
+1;

MarkovBot/Ignore.pm

@@ -0,0 +1,43 @@
+package MarkovBot::Ignore;
+use base qw(Exporter);
+
+our @EXPORT = qw(ignore unignore isIgnored);
+
+use FindBin qw($Bin);
+use lib $Bin;
+
+use MarkovBot::Config;
+use MarkovBot::Redis;
+
+sub ignore( $ ) {
+  # ignore($user)
+
+  my $user = shift;
+  my $redis = redis();
+  my $redis_prefix = config("redis_prefix");
+
+  $redis->sadd("$redis_prefix:ignore", $user);
+}
+
+sub unignore( $ ) {
+  # unignore($user)
+  
+  my $user = shift;
+  my $redis = redis();
+  my $redis_prefix = config("redis_prefix");
+
+  $redis->srem("$redis_prefix:ignore", $user);
+}
+
+sub isIgnored( $ ) {
+  # isIngored($user)
+  # returns 0 or 1
+
+  my $user = shift;
+  my $redis = redis();
+  my $redis_prefix = config("redis_prefix");
+
+  return $redis->sismember("$redis_prefix:ignore", $user);
+}
+
+1;

MarkovBot/Learning.pm

@@ -0,0 +1,38 @@
+package MarkovBot::Learning;
+use base qw(Exporter);
+
+our @EXPORT = qw(learn);
+
+use FindBin qw($Bin);
+use lib $Bin;
+
+use MarkovBot::Config;
+use MarkovBot::Redis;
+
+sub learn( $ ) {
+  # input - line to be learned
+  # returns - nothing
+  
+  my $redis = redis();
+  my $redis_prefix = config("redis_prefix");
+
+  $_ = shift;
+
+  # learn - add a line of text to the brain
+  $_ = $_." ___end___";
+  $_ = lc $_;
+  $_ =~ y/\,\.\!\?\(\)//d;
+
+  # Split it into individual words
+  my @words = split(' ', $_);
+
+  # Disregard short sentences
+  return if scalar(@words < 4);
+
+  for (my $i = 0; $i <= $#words-2; $i++) {
+    # $words[$i] $words[$i+1] => $words[$i+2]
+    $redis->rpush("$redis_prefix:chains:$words[$i],$words[$i+1]", $words[$i+2]);
+  }
+}
+
+1;

MarkovBot/Redis.pm

@@ -0,0 +1,16 @@
+package MarkovBot::Redis;
+use base qw(Exporter);
+
+our @EXPORT = qw(redis);
+
+use Redis;
+
+sub redis() {
+  # Returns a redis object
+  # This is fairly useless but in the future could be used to
+  # pass specific options to redis.
+
+  return Redis->new();
+}
+
+1;

config.default.yml

@@ -0,0 +1,13 @@
+#
+# Redis Settings
+#
+redis_prefix: markov
+
+#
+# IRC Settings
+#
+irc_server: irc.foo.bar
+irc_port: 6667
+irc_channel: "#baz"
+irc_nickname: shithead-ng
+irc_nickname2: shithead

cpanfile

@@ -0,0 +1,5 @@
+#!/usr/bin/env perl
+requires "YAML::Tiny" => "0";
+requires "Bot::BasicBot" => "0";
+requires "Redis" => "0";
+requires "YAML::Tiny" => "0";

load-brain.pl

@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+use 5.010;
+use strict;
+use warnings;
+use Redis;
+use FindBin qw($Bin);
+
+use lib $Bin;
+
+use MarkovBot::Config;
+
+# Load Configuration
+
+my $redis_prefix = config("redis_prefix");
+my $brain_file = $ARGV[0];
+
+my $redis = Redis->new();
+
+open BRAIN, $brain_file or die $!;
+
+while (<BRAIN>) {
+
+  # Apply preprocessing to the line
+  $_ = $_ . "___end___";
+  $_ = lc $_;
+  $_ =~ y/\,\.\!\?\(\)//d;
+
+  # Split it into individual words
+  my @words = split(' ', $_);
+
+  # Disregard short sentences
+  next if scalar(@words < 4);
+
+  for (my $i = 0; $i <= $#words-2; $i++) {
+    # $words[$i] $words[$i+1] => $words[$i+2]
+    $redis->rpush("$redis_prefix:chains:$words[$i],$words[$i+1]", $words[$i+2]);
+  }
+
+}
+
+close BRAIN;

markov.pl

@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+use 5.010;
+use strict;
+use warnings;
+use Redis;
+use FindBin qw($Bin);
+
+use lib $Bin;
+
+package MarkovBot;
+use base qw/Bot::BasicBot/;
+
+use MarkovBot::Config;
+use MarkovBot::Learning;
+use MarkovBot::Ignore;
+use MarkovBot::Commands;
+
+sub said {
+  my $self = shift;
+  my $msg = shift;
+
+  # Ignore PMs and ignored users
+  return if $msg->{channel} eq 'msg';
+  return if isIgnored($msg->{who});
+
+  # Intercept commands
+  if ($msg->{body} =~ m/^\.\w+/) {
+    
+    my $command = $msg->{body};
+    my @command = split(" ", $command);
+    my $bare = $command[0];
+    $bare =~ s/^\.//;
+
+    my %subs = %{getCommandSubs()};
+
+    if (defined $subs{$bare}) {
+      my $ret = $subs{$bare}->(\@command);
+      $self->say( channel => config("irc_channel"), body => $ret ) unless $ret eq "___null___";
+    }
+
+  }
+
+  # Learn
+  learn $msg->{body};
+
+}
+
+MarkovBot->new(
+
+  server => config("irc_server"),
+  port => config("irc_port"),
+  channels => [config("irc_channel")],
+
+  nick => config("irc_nickname"),
+  alt_nicks => [config("irc_nickname2")],
+  username => config("irc_nickname"),
+  name => config("irc_nickname"),
+
+)->run();