From 9474f5570bdce3f118d2fcb8916fee66bf2f4b26 Mon Sep 17 00:00:00 2001 From: Tom Ryder Date: Fri, 10 Jun 2016 02:08:02 +1200 Subject: First public commit --- bin/irc-ebooks-feed | 120 +++++++++++++++++++++++++++++++++++++++++++ bin/irc-ebooks-run | 61 ++++++++++++++++++++++ bin/irc-ebooks-test | 64 +++++++++++++++++++++++ lib/IRC/Ebooks.pm | 95 ++++++++++++++++++++++++++++++++++ share/irc-ebooks.sample.conf | 11 ++++ 5 files changed, 351 insertions(+) create mode 100755 bin/irc-ebooks-feed create mode 100755 bin/irc-ebooks-run create mode 100755 bin/irc-ebooks-test create mode 100644 lib/IRC/Ebooks.pm create mode 100644 share/irc-ebooks.sample.conf diff --git a/bin/irc-ebooks-feed b/bin/irc-ebooks-feed new file mode 100755 index 0000000..c8d49a4 --- /dev/null +++ b/bin/irc-ebooks-feed @@ -0,0 +1,120 @@ +#!/usr/bin/env perl + +# +# Feed an IRC::Ebooks bot IRC files for its brain. +# +# Author: Tom Ryder +# +package IRC::Ebooks::Feed; + +# Force me to write this properly +use warnings; +use strict; +use utf8; +use autodie; + +# Everything's UTF-8 +use utf8::all; + +# Require Perl v5.14 +use 5.014; + +# Import required modules +use Carp; +use Const::Fast; +use Config::Tiny; +use English qw(-no_match_vars); +use Getopt::Long::Descriptive; +use List::MoreUtils qw(any); + +# Our custom module +use IRC::Ebooks; + +# Declare package version +our $VERSION = 0.1; + +# Expected line format, all else ignored +const my $LINE_FORMAT => qr{ + ^ # Start of line + [\d:]* # Timestamp + \s+ # At least one space + <\W*(?\w+)> # Nickname in angle brackets + \s+ # At least one space + (?.+) # The message said + $ # End of line +}msx; + +# Skip text lines that match these patterns +const my @SKIP_PATTERNS => ( + qr{ <[@%+ ]?\w+> }msx, # Looks like nick (probably a quote) + qr{ \d:\d }msx, # Looks like timestamp (probably a quote) + qr{ :// }msx, # Looks like URL +); + +# Delete these from text +const my @DELETE_PATTERNS => ( + qr{ ^\w+:\s }msx, # Address in form of "nick: " + qr{ ["()\[\]] }msx, # Punctuations marks that may unbalance +); + +# Import required modules +my ( $opt, $usage ) = describe_options( + 'irc-ebooks-feed %o [IRCLOGFILE ...]', + [ + 'config|c=s', + 'configuration file', + { default => '/etc/irc-ebooks.conf' }, + ], + [ 'dump|d', 'dump the text that would be learned to stdout instead' ], + [ 'help', 'print usage message and exit' ], +); + +# Give help if needed +if ( $opt->help ) { + print {*STDOUT} $usage->text + or carp q{Couldn't write to stdout}; + exit; +} + +# Read configuration +my $config = Config::Tiny->read( $opt->config ) + or croak sprintf q{Couldn't read configuration file %s}, $opt->config; + +# Create IRC::Ebooks object +my $irc_ebooks = IRC::Ebooks->new($config) + or croak q{Failed to create IRC::Ebooks object}; + +# Read from input files +while ( my $line = <> ) { + chomp $line; + + # Ignore line if not in expected format + $line =~ $LINE_FORMAT or next; + + # Get nick and text from match vars + my $nick = $LAST_PAREN_MATCH{nick}; + my $text = $LAST_PAREN_MATCH{text}; + + # Ignore line if the person we're emulating didn't say it + next if $nick ne $config->{options}->{learn}; + + # Ignore line if any of the skip patterns matched + next if any { $text =~ $_ } @SKIP_PATTERNS; + + # Filter out any unwanted parts of the text + for (@DELETE_PATTERNS) { + $text =~ s{$_}{}gmsx; + } + + # If the user chose --dump, just print the text + if ( $opt->dump ) { + say {*STDOUT} $text + or carp q{Couldn't write to stdout}; + } + + # Otherwise, have the bot learn it + else { + $irc_ebooks->learn($text); + } +} + diff --git a/bin/irc-ebooks-run b/bin/irc-ebooks-run new file mode 100755 index 0000000..a50c3b4 --- /dev/null +++ b/bin/irc-ebooks-run @@ -0,0 +1,61 @@ +#!/usr/bin/env perl + +# +# Run an IRC::Ebooks bot. +# +# Author: Tom Ryder +# +package IRC::Ebooks::Run; + +# Force me to write this properly +use warnings; +use strict; +use utf8; +use autodie; + +# Everything's UTF-8 +use utf8::all; + +# Require Perl v5.14 +use 5.014; + +# Import required modules +use Carp; +use Config::Tiny; +use Getopt::Long::Descriptive; + +# Our custom module +use IRC::Ebooks; + +# Declare package version +our $VERSION = 0.1; + +# Set options +my ( $opt, $usage ) = describe_options( + 'irc-ebooks-feed %o [IRCLOGFILE ...]', + [ + 'config|c=s', + 'configuration file', + { default => '/etc/irc-ebooks.conf' }, + ], + [ 'help', 'print usage message and exit' ], +); + +# Give help if needed +if ( $opt->help ) { + print {*STDOUT} $usage->text + or carp q{Couldn't write to stdout}; + exit; +} + +# Read configuration +my $config = Config::Tiny->read( $opt->config ) + or croak sprintf q{Couldn't read configuration file %s}, $opt->config; + +# Create IRC::Ebooks object +my $irc_ebooks = IRC::Ebooks->new($config) + or croak q{Failed to create IRC::Ebooks object}; + +# Run it +$irc_ebooks->run(); + diff --git a/bin/irc-ebooks-test b/bin/irc-ebooks-test new file mode 100755 index 0000000..e79f0da --- /dev/null +++ b/bin/irc-ebooks-test @@ -0,0 +1,64 @@ +#!/usr/bin/env perl + +# +# Test an IRC::Ebooks bot. +# +# Author: Tom Ryder +# +package IRC::Ebooks::Test; + +# Force me to write this properly +use warnings; +use strict; +use utf8; +use autodie; + +# Everything's UTF-8 +use utf8::all; + +# Require Perl v5.14 +use 5.014; + +# Import required modules +use Carp; +use Config::Tiny; +use Getopt::Long::Descriptive; + +# Our custom module +use IRC::Ebooks; + +# Declare package version +our $VERSION = 0.1; + +# Set options +my ( $opt, $usage ) = describe_options( + 'irc-ebooks-feed %o [IRCLOGFILE ...]', + [ + 'config|c=s', + 'configuration file', + { default => '/etc/irc-ebooks.conf' }, + ], + [ 'help', 'print usage message and exit' ], +); + +# Give help if needed +if ( $opt->help ) { + print {*STDOUT} $usage->text + or carp q{Couldn't write to stdout}; + exit; +} + +# Read configuration +my $config = Config::Tiny->read( $opt->config ) + or croak sprintf q{Couldn't read configuration file %s}, $opt->config; + +# Create IRC::Ebooks object +my $irc_ebooks = IRC::Ebooks->new($config) + or croak q{Failed to create IRC::Ebooks object}; + +# Have him respond to each line of standard input +while (<>) { + chomp; + say $irc_ebooks->reply($_); +} + diff --git a/lib/IRC/Ebooks.pm b/lib/IRC/Ebooks.pm new file mode 100644 index 0000000..bd5e923 --- /dev/null +++ b/lib/IRC/Ebooks.pm @@ -0,0 +1,95 @@ +# +# Learn from an IRC log, and make conversation. +# +# Author: Tom Ryder +# +package IRC::Ebooks; +use parent qw( Bot::BasicBot ); + +# Force me to write this properly +use warnings; +use strict; +use utf8; +use autodie; + +# Everything's UTF8 +use utf8::all; + +# Require Perl v5.14 +use 5.014; + +# Import required modules +use Any::Moose; # dpkg: libany-moose-perl +use Carp; # dpkg: perl-base +use Const::Fast; # dpkg: libconst-fast-perl + +# More modules, these aren't in Debian packages, use dh-make-perl(1p) +use Hailo; + +# Decree package version +our $VERSION = 0.1; + +# Default probability of talking +const my $CHATTER_DEFAULT => 1; + +# Constructor +sub new { + my ( $class, $config ) = @_; + my $self = $class->SUPER::new( %{ $config->{irc} } ); + + # Read channel from config + $self->{channel} = $config->{irc}->{channels}; + + # Read brain path from config + $self->{brain} = $config->{options}->{brain} + or croak 'brainfile not specified in config'; + + # Figure out whether to try reading from brainfile + $self->{hailo} = Hailo->new( brain => $self->{brain} ) + or croak sprintf 'Failed to load brain at %s', $self->{brain}; + + # Read chatter from config, or use default + $self->{chatter} = $config->{options}->{chatter}; + $self->{chatter} ||= $CHATTER_DEFAULT; + + # Reject impossible chatter level + if ( $self->{chatter} < 0 or $self->{chatter} > 1 ) { + croak sprintf 'Invalid chatter probability %s', $self->{chatter}; + } + + # All constructed, return self + return $self; +} + +# Learn to say something +sub learn { + my ( $self, $text ) = @_; + return $self->{hailo}->learn($text); +} + +# Learn the topic +sub topic { + my ( $self, $change ) = @_; + return ( $self->{topic} = $change->{topic} ); +} + +# Say something random about the topic +sub speak { + my ($self) = @_; + my $text = $self->{hailo}->reply( $self->{topic} ); + $text = lc $text; + $text =~ s{[.]$}{}msx; + return $text; +} + +# Tick event, used for initiating random chatter +sub tick { + my ($self) = @_; + if ( $self->{chatter} > rand ) { + $self->say( channel => $self->{channel}, body => $self->speak ); + } + return 1; +} + +1; + diff --git a/share/irc-ebooks.sample.conf b/share/irc-ebooks.sample.conf new file mode 100644 index 0000000..ef16f34 --- /dev/null +++ b/share/irc-ebooks.sample.conf @@ -0,0 +1,11 @@ +[irc] +server = irc.example.org +port = 6667 +channels = #irc_ebooks +nick = irc_ebooks +username = ircebooks + +[options] +brain = /var/irc-ebooks/brain.sql +chatter = 0.025 +learn = yournick -- cgit v1.2.3