initial commit
This commit is contained in:
commit
0406af43b4
|
@ -0,0 +1,3 @@
|
||||||
|
brain
|
||||||
|
*.swp
|
||||||
|
config.yml
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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
|
|
@ -0,0 +1,5 @@
|
||||||
|
#!/usr/bin/env perl
|
||||||
|
requires "YAML::Tiny" => "0";
|
||||||
|
requires "Bot::BasicBot" => "0";
|
||||||
|
requires "Redis" => "0";
|
||||||
|
requires "YAML::Tiny" => "0";
|
|
@ -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;
|
|
@ -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();
|
Loading…
Reference in New Issue