view release on metacpan or  search on metacpan

ex/ai-bot.pl  view on Meta::CPAN

  has db_file => ( is => 'ro', default => sub { $ENV{DB_FILE} || 'ai-bot.db' } );
  has _dbh => ( is => 'ro', lazy => 1, builder => '_build_dbh' );

  sub _build_dbh {
    my ($self) = @_;
    my $dbh = DBI->connect('dbi:SQLite:dbname=' . $self->db_file, '', '', {
      RaiseError => 1, sqlite_unicode => 1,
    });
    $dbh->do('CREATE TABLE IF NOT EXISTS conversations (
      id INTEGER PRIMARY KEY, nick TEXT, message TEXT, response TEXT,
      channel TEXT, created_at DATETIME DEFAULT CURRENT_TIMESTAMP
    )');
    $dbh->do('CREATE TABLE IF NOT EXISTS notes (
      id INTEGER PRIMARY KEY, nick TEXT, content TEXT,
      created_at DATETIME DEFAULT CURRENT_TIMESTAMP
    )');
    return $dbh;
  }

  sub store_conversation {
    my ($self, %a) = @_;
    $self->_dbh->do(
      'INSERT INTO conversations (nick, message, response, channel) VALUES (?,?,?,?)',
      undef, @a{qw(nick message response channel)},
    );
  }

  sub recall {
    my ($self, $query, $limit) = @_;
    $limit //= 5;
    my $rows = $self->_dbh->selectall_arrayref(
      'SELECT nick, message, response FROM conversations WHERE message LIKE ? OR response LIKE ? ORDER BY id DESC LIMIT ?',
      { Slice => {} }, "%$query%", "%$query%", $limit,
    );
    return join("\n---\n", map { "<$_->{nick}> $_->{message}\n$_->{response}" } @$rows);
  }

  sub save_note {
    my ($self, $nick, $content) = @_;
    $self->_dbh->do('INSERT INTO notes (nick, content) VALUES (?,?)', undef, $nick, $content);
  }

  sub recall_notes {
    my ($self, $nick, $query, $limit) = @_;
    $limit //= 10;
    my $rows;
    if ($nick) {
      $rows = $self->_dbh->selectall_arrayref(
        'SELECT id, nick, content FROM notes WHERE nick = ? AND content LIKE ? ORDER BY id DESC LIMIT ?',
        { Slice => {} }, $nick, "%$query%", $limit,
      );
    } else {
      $rows = $self->_dbh->selectall_arrayref(
        'SELECT id, nick, content FROM notes WHERE content LIKE ? ORDER BY id DESC LIMIT ?',
        { Slice => {} }, "%$query%", $limit,
      );
    }
    return join("\n", map { "#$_->{id} [$_->{nick}] $_->{content}" } @$rows);
  }

  sub update_note {
    my ($self, $id, $content) = @_;
    my $rows = $self->_dbh->do('UPDATE notes SET content = ? WHERE id = ?', undef, $content, $id);
    return $rows > 0;
  }

  sub delete_note {
    my ($self, $id) = @_;
    my $rows = $self->_dbh->do('DELETE FROM notes WHERE id = ?', undef, $id);
    return $rows > 0;
  }

  __PACKAGE__->meta->make_immutable;
}

# --- The IRC Bot ---

package BertBot;
use Moses;
use namespace::autoclean;
use IO::Async::Loop::POE;
use Future::AsyncAwait;
use Net::Async::MCP;
use MCP::Server;
use Module::Runtime qw( use_module );
use Langertha::Raider;

server ( $ENV{IRC_SERVER} || 'irc.perl.org' );
nickname ( $BOT_NICK );
channels ( $ENV{IRC_CHANNELS} ? split(/,/, $ENV{IRC_CHANNELS}) : '#ai' );

has memory => (
  is => 'ro', lazy => 1, traits => ['NoGetopt'],
  default => sub { MemoryStore->new },
);

has _mcp => ( is => 'rw', traits => ['NoGetopt'] );
has _raider => ( is => 'rw', traits => ['NoGetopt'] );
has _msg_buffer => (
  is => 'rw', traits => ['NoGetopt'],
  default => sub { {} },  # { channel => [messages] }
);
has _buffer_timers => (
  is => 'rw', traits => ['NoGetopt'],
  default => sub { {} },  # { channel => alarm_id }
);
has _processing => (
  is => 'rw', traits => ['NoGetopt'],
  default => 0,
);
has _pending_raid => (
  is => 'rw', traits => ['NoGetopt'],
  default => sub { undef },
);
has _rate_limit_wait => (
  is => 'rw', traits => ['NoGetopt'],
  default => 0,
);

sub _build_mcp_server {
  my ($self) = @_;