commit 0406af43b4fac46126281016259d26509d5e41ff Author: Al Beano Date: Sat Apr 30 22:53:26 2016 +0100 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b1d4982 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +brain +*.swp +config.yml diff --git a/MarkovBot/Commands.pm b/MarkovBot/Commands.pm new file mode 100644 index 0000000..86d3bc1 --- /dev/null +++ b/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 "; + } + + ignore($command->[1]); + return "Now ignoring ".$command->[1]."."; +} + +sub commandUnignore() { + my $command = shift; + + if (scalar( @{$command} ) != 2) { + return "Usage: .unignore "; + } + + unignore($command->[1]); + return "No longer ignoring ".$command->[1]."."; +} + +sub getCommandSubs() { + return { + "ping" => \&commandPing, + "ignore" => \&commandIgnore, + "unignore" => \&commandUnignore, + }; +} + +1; diff --git a/MarkovBot/Config.pm b/MarkovBot/Config.pm new file mode 100644 index 0000000..68b5e5c --- /dev/null +++ b/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; diff --git a/MarkovBot/Ignore.pm b/MarkovBot/Ignore.pm new file mode 100644 index 0000000..f924e7b --- /dev/null +++ b/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; diff --git a/MarkovBot/Learning.pm b/MarkovBot/Learning.pm new file mode 100644 index 0000000..578717b --- /dev/null +++ b/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; diff --git a/MarkovBot/Redis.pm b/MarkovBot/Redis.pm new file mode 100644 index 0000000..5e02d29 --- /dev/null +++ b/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; diff --git a/config.default.yml b/config.default.yml new file mode 100644 index 0000000..567dedd --- /dev/null +++ b/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 diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..7b7d9b1 --- /dev/null +++ b/cpanfile @@ -0,0 +1,5 @@ +#!/usr/bin/env perl +requires "YAML::Tiny" => "0"; +requires "Bot::BasicBot" => "0"; +requires "Redis" => "0"; +requires "YAML::Tiny" => "0"; diff --git a/load-brain.pl b/load-brain.pl new file mode 100644 index 0000000..25c0ed7 --- /dev/null +++ b/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 () { + + # 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; diff --git a/markov.pl b/markov.pl new file mode 100644 index 0000000..8b622d4 --- /dev/null +++ b/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();