File Coverage

blib/lib/Bot/Cobalt/Plugin/RDB.pm

Criterion	Covered	Total	%
statement	21	23	91.3
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	29	31	93.5

package Bot::Cobalt::Plugin::RDB;
$Bot::Cobalt::Plugin::RDB::VERSION = '0.021001';
use v5.10;
use strictures 2;

use File::Spec;
use List::Util 'shuffle', 'first';
use POSIX ();

use Bot::Cobalt;
use Bot::Cobalt::Common;
use Bot::Cobalt::Plugin::RDB::Database;

use POE;

sub new {
  bless {

    ## Errors from DB -> RPL values:
    RPL_MAP => {
      RDB_NOTPERMITTED => "RDB_ERR_NOTPERMITTED",

      RDB_INVALID_NAME => "RDB_ERR_INVALID_NAME",

      RDB_EXISTS       => "RDB_ERR_RDB_EXISTS",

      RDB_DBFAIL       => "RPL_DB_ERR",

      RDB_FILEFAILURE  => "RDB_UNLINK_FAILED",

      RDB_NOSUCH       => "RDB_ERR_NO_SUCH_RDB",
      RDB_NOSUCH_ITEM  => "RDB_ERR_NO_SUCH_ITEM",
    },

  }, shift
}

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

  unless ($self->{DBMGR}) {
    my $cfg = core->get_plugin_cfg($self);
    my $cachekeys = $cfg->{Opts}->{CacheItems} // 30;

    my $rdbdir = File::Spec->catdir(
      core()->var,
      $cfg->{Opts}->{RDBDir} ? $cfg->{Opts}->{RDBDir} : ('db', 'rdb')
    );

    $self->{DBMGR} = Bot::Cobalt::Plugin::RDB::Database->new(
      CacheKeys => $cachekeys,
      RDBDir    => $rdbdir,
    );
  }

  $self->{DBMGR}
}

sub rand_delay {
  my ($self, $delay) = @_;
  return $self->{RANDDELAY} = $delay if defined $delay;
  $self->{RANDDELAY}
}

sub SessionID {
  my ($self, $id) = @_;
  return $self->{SESSID} = $id if defined $id;
  $self->{SESSID}
}

sub AsyncSessionID {
  my ($self, $id) = @_;
  return $self->{ASYNCID} = $id if defined $id;
  $self->{ASYNCID}
}

sub Cobalt_register {
  my ($self, $core) = splice @_, 0, 2;

  register($self, 'SERVER',
    [
      'public_msg',
      'rdb_broadcast',
      'rdb_triggered',
    ],
  );

  ## if the rdbdir doesn't exist, ::Database will try to create it
  ## (it'll also handle creating 'main' for us)
  my $dbmgr = $self->DBmgr;

  ## we'll die out here if there's a problem with 'main' :
  my $keys_c = $dbmgr->get_keys('main');
  core->Provided->{randstuff_items} = $keys_c;

  ## kickstart a randstuff timer (named timer for rdb_broadcast)
  ## delay is in Opts->RandDelay as a timestr
  ## (0 turns off timer)
  my $cfg = core->get_plugin_cfg( $self );
  my $randdelay = $cfg->{Opts}->{RandDelay} // '30m';
  logger->debug("randdelay: $randdelay");

  $randdelay = timestr_to_secs($randdelay) unless $randdelay =~ /^\d+$/;

  $self->rand_delay( $randdelay );

  if ($randdelay) {
    core->timer_set( $randdelay,
      {
        Event => 'rdb_broadcast',
        Alias => core->get_plugin_alias($self)
      },
      'RANDSTUFF'
    );
  }

  if ($cfg->{Opts}->{AsyncSearch}) {
    logger->debug("spawning Session to handle AsyncSearch");

    POE::Session->create(
      object_states => [
        $self => [
          '_start',

          'poe_post_search',

          'poe_got_result',

          'poe_got_error',
        ],
      ],
    );
  }

  logger->info("Registered, $keys_c items in main RDB");

  return PLUGIN_EAT_NONE
}

sub Cobalt_unregister {
  my ($self, $core) = splice @_, 0, 2;

  logger->info("Unregistering RDB");

  $poe_kernel->alias_remove('sess_'. core->get_plugin_alias($self) );

  if ( $self->AsyncSessionID ) {
    $poe_kernel->post( $self->AsyncSessionID, 'shutdown' );
  }

  delete core->Provided->{randstuff_items};

  core->timer_del('RANDSTUFF');

  return PLUGIN_EAT_NONE
}


sub Bot_public_msg {
  my ($self, $core) = splice @_, 0, 2;
  my $msg     = ${$_[0]};
  my $context = $msg->context;

  my @handled = qw/
    randstuff
    randq
    rdb
  /;

  ## would be better in a public_cmd_, but eh, darkbot legacy syntax..
  return PLUGIN_EAT_NONE unless $msg->highlight;

  ## uses message_array_sp, ie spaces are preserved
  ## (so don't include them prior to rdb names, for example)
  my $msg_arr = $msg->message_array_sp;

  ## since this is a highlighted message, bot's nickname is first
  my ($cmd, @message) = @$msg_arr[1 .. (scalar @$msg_arr - 1)];
  $cmd = lc($cmd||'');

  ## ..if it's not @handled we don't care:
  return PLUGIN_EAT_NONE unless $cmd and first {; $_ eq $cmd } @handled;

  logger->debug("dispatching $cmd");

  ## dispatcher:
  my ($id, $resp);

  CMD: {
    if ($cmd eq "randstuff") {
      $resp = $self->_cmd_randstuff(\@message, $msg);
      last CMD
    }

    if ($cmd eq "randq") {
      $resp = $self->_cmd_randq(\@message, $msg, 'randq');
      last CMD
    }

    if ($cmd eq "rdb") {
      $resp = $self->_cmd_rdb(\@message, $msg);
      last CMD
    }
  }

  my $channel = $msg->channel;

  if (defined $resp) {
    logger->debug("dispatching msg -> $channel");
    broadcast( 'message', $context, $channel, $resp );
  }

  PLUGIN_EAT_NONE
}


  ### command handlers ###

sub _cmd_randstuff {
  ## $parsed_msg_a  == message_array without prefix/cmd
  ## $msg == original message obj
  my ($self, $parsed_msg_a, $msg) = @_;
  my @message = @{ $parsed_msg_a };

  my $src_nick = $msg->src_nick;
  my $context  = $msg->context;

  my $pcfg = core->get_plugin_cfg( $self );

  my $required_level = $pcfg->{RequiredLevels}->{rdb_add_item} // 1;

  my $rplvars;
  $rplvars->{nick} = $src_nick;

  unless ( core->auth->level($context, $src_nick) >= $required_level ) {
    return core->rpl( 'RPL_NO_ACCESS', $rplvars )
  }

  ## randstuff is 'main', darkbot legacy:
  my $rdb = 'main';
  $rplvars->{rdb} = $rdb;

  ## ...but this may be randstuff ~rdb ... syntax:
  if (@message && index($message[0], '~') == 0) {
    $rdb = substr(shift @message, 1);
    $rplvars->{rdb} = $rdb;

    my $dbmgr = $self->DBmgr;
    unless ($rdb && $dbmgr->dbexists($rdb) ) {
      ## ~rdb specified but nonexistant
      return core->rpl( 'RDB_ERR_NO_SUCH_RDB', $rplvars );
    }
  }

  ## should have just the randstuff itself now (and maybe a different rdb):
  my $randstuff_str = join ' ', @message;
  $randstuff_str = decode_irc($randstuff_str);

  unless ($randstuff_str) {
    return core->rpl( 'RDB_ERR_NO_STRING', $rplvars )
  }

  ## call _add_item
  my $username = core->auth->username($context, $src_nick);
  my ($newidx, $err) =
    $self->_add_item($rdb, $randstuff_str, $username);
  $rplvars->{index} = $newidx;
  ## _add_item returns either a status from ::Database->put
  ## or a new item key:

  unless ($newidx) {

    if ($err eq "RDB_DBFAIL") {
      return core->rpl( 'RPL_DB_ERR', $rplvars )
    } elsif ($err eq "RDB_NOSUCH") {
      return core->rpl( 'RDB_ERR_NO_SUCH_RDB', $rplvars )
    } else {
      return "Unknown error status: $err"
    }

  } else {
    return core->rpl( 'RDB_ITEM_ADDED', $rplvars )
  }

}

sub _select_random {
  my ($self, $msg, $rdb, $quietfail) = @_;

  my $dbmgr  = $self->DBmgr;

  my($item_ref, $content);

  try {
    $item_ref = $dbmgr->random($rdb);
    $content = $self->_content_from_ref($item_ref)
            // '(undef - broken db?)';
  } catch {
    logger->debug("_select_random failure $_");
    my $rpl = $self->{RPL_MAP}->{$_};
    $content = core->rpl( $rpl,
      nick => $msg->src_nick // '',
      rdb  => $rdb,
    );

    0
  } or return if $quietfail;

  if ($self->{LastRandom} && $self->{LastRandom} eq $content) {
    try {
      $item_ref = $dbmgr->random($rdb);
      $content = $self->_content_from_ref($item_ref)
            // '(undef - broken db?)';
    } catch {
      my $rpl = $self->{RPL_MAP}->{$_};
      $content = core->rpl( $rpl,
        nick => $msg->src_nick // '',
        rdb  => $rdb,
      );
      undef
    } or return if $quietfail;
  }

  $self->{LastRandom} = $content;

  return $content // ''
}


sub _cmd_randq {
  my ($self, $parsed_msg_a, $msg, $type, $rdbpassed, $strpassed) = @_;
  my @message = @{ $parsed_msg_a };

  ## also handler for 'rdb search rdb str'
  my $dbmgr = $self->DBmgr;

  my($str, $rdb);
  if    ($type eq 'random') {
    ## this is actually deprecated
    ## use '~main' rdb info3 topic trick instead
    return $self->_select_random($msg, 'main')
  } elsif ($type eq 'rdb') {
    $rdb = $rdbpassed;
    $str = $strpassed;
  } else {    ## 'randq'
    $rdb = 'main';
    ## search what looks like irc quotes by default:
    $str = shift @message // '<*>';
  }

  logger->debug("_cmd_randq; dispatching search for $str in $rdb");

  if ( $self->SessionID ) {
    ## if we have asyncsearch, post and return immediately

    unless ( $dbmgr->dbexists($rdb) ) {
      return core->rpl( 'RDB_ERR_NO_SUCH_RDB',
        nick => $msg->src_nick,
        rdb  => $rdb,
      );
    }

    $poe_kernel->post( $self->SessionID,
      'poe_post_search',
      $rdb,
      $str,
      {          ## Hints hash
        Glob     => $str,
        Context  => $msg->context,
        Channel  => $msg->channel,
        Nickname => $msg->src_nick,
        GetType  => 'string',
        RDB      => $rdb,
      },
    );

    logger->debug("_cmd_randq; search ($rdb) dispatched to AsyncSearch");

    return
  }

  my($rpl, $match);

  try {
    $match = $dbmgr->search($rdb, $str, 'WANTONE')
  } catch {
    logger->debug("_cmd_randq; Database->search() err: $_");
    $rpl = $self->{RPL_MAP}->{$_};
  };

  return "No matches found for $str" if not defined $match;

  return core->rpl( $rpl,
    nick => $msg->src_nick,
    rdb  => $rdb,
  ) if defined $rpl;

  my $item_ref = try {
    $dbmgr->get($rdb, $match)
  } catch {
    logger->debug("_cmd_randq; Database->get() err: $_");
    $rpl = $self->{RPL_MAP}->{$_};
  };

  return core->rpl( $rpl,
        nick  => $msg->src_nick,
        rdb   => $rdb,
        index => $match,
  ) if defined $rpl;

  logger->debug("_cmd_randq; item found: $match");


  my $content = $self->_content_from_ref($item_ref)
            // '(undef - broken db?)';

  return "[$match] $content"
}


sub _cmd_rdb {
  ## Command dispatcher for:
  ##   rdb add
  ##   rdb del
  ##   rdb get
  ##   rdb dbadd
  ##   rdb dbdel
  ##   rdb info
  ##   rdb search
  ##   rdb searchidx
  ## FIXME rdb dblist ?
  my ($self, $parsed_msg_a, $msg) = @_;
  my @message = @{ $parsed_msg_a };

  my $pcfg = core->get_plugin_cfg( $self );
  my $required_levs = $pcfg->{RequiredLevels} // {};
  ## this hash maps commands to levels.
  ## commands not found here aren't recognized.
  my %access_levs = (
    ## FIXME document these ...
    count  => $required_levs->{rdb_count}     // 0,
    get    => $required_levs->{rdb_get_item}  // 0,
    dblist => $required_levs->{rdb_dblist}    // 0,
    info   => $required_levs->{rdb_info}      // 0,
    dbadd  => $required_levs->{rdb_create}    // 9999,
    dbdel  => $required_levs->{rdb_delete}    // 9999,
    add    => $required_levs->{rdb_add_item}  // 2,
    del    => $required_levs->{rdb_del_item}  // 3,
    search    => $required_levs->{rdb_search} // 0,
    searchidx => $required_levs->{rdb_search} // 0,
  );

  my $cmd = lc(shift @message || '');
  $cmd = 'del' if $cmd eq 'delete';

  my @handled = keys %access_levs;
  unless ($cmd && first {; $_ eq $cmd } @handled) {
    return "Commands: add   ; del  , info   ; "
           ."get   ; search(idx)   ; count   ; "
           ."dbadd  ; dbdel ";
  }

  my $context  = $msg->context;
  my $nickname = $msg->src_nick;

  my $user_lev = core->auth->level($context, $nickname) // 0;
  unless ($user_lev >= $access_levs{$cmd}) {
    return core->rpl( 'RPL_NO_ACCESS',
      nick => $nickname,
    );
  }

  my $method = '_cmd_rdb_'.$cmd;

  if ( $self->can($method) ) {
    logger->debug("dispatching $method");
    return $self->$method($msg, \@message)
  }

  return "No handler found for command $cmd"
}

sub _cmd_rdb_dbadd {
  my ($self, $msg, $parsed_args) = @_;

  my $dbmgr = $self->DBmgr;

  my ($rdb) = @$parsed_args;

  return 'Syntax: rdb dbadd ' unless $rdb;

  return 'RDB name must be in the a-z0-9 set'
    unless $rdb =~ /^[a-z0-9]+$/;

  return 'RDB name must be less than 32 characters'
    unless length $rdb <= 32;

  logger->debug("_cmd_rdb_dbadd; issuing createdb()");

  my $rpl;
  try {
    $dbmgr->createdb($rdb);
    $rpl = "RDB_CREATED";
  } catch {
    logger->debug("createdb() failure: $_");
    $rpl = $self->{RPL_MAP}->{$_};
  };

  my %rplvars = (
    nick => $msg->src_nick,
    rdb  => $rdb,
    op   => 'dbadd',
  );

  return core->rpl( $rpl, %rplvars )
}

sub _cmd_rdb_dbdel {
  my ($self, $msg, $parsed_args) = @_;

  my ($rdb) = @$parsed_args;

  return 'Syntax: rdb dbdel ' unless $rdb;

  my $rplvars = {
    nick => $msg->src_nick,
    rdb  => $rdb,
    op   => 'dbdel',
  };

  my ($retval, $err) = $self->_delete_rdb($rdb);

  my $rpl;
  if ($retval) {
    $rpl = 'RDB_DELETED';
  } else {
    DBDELERR: {
      if ($err eq 'RDB_NOTPERMITTED') {
        $rpl = 'RDB_ERR_NOTPERMITTED';  last DBDELERR
      }

      if ($err eq 'RDB_NOSUCH') {
        $rpl = 'RDB_ERR_NO_SUCH_RDB';   last DBDELERR
      }

      if ($err eq 'RDB_DBFAIL') {
        $rpl = 'RPL_DB_ERR';            last DBDELERR
      }

      if ($err eq 'RDB_FILEFAILURE') {
        $rpl = 'RDB_UNLINK_FAILED';     last DBDELERR
      }

      my $errstr = "BUG; Unknown err $err from _delete_rdb";
      logger->warn($errstr);
      return $errstr
    }
  }

  return core->rpl( $rpl, $rplvars )
}

sub _cmd_rdb_add {
  my ($self, $msg, $parsed_args) = @_;

  my ($rdb, @pieces) = @$parsed_args;
  my $item = join ' ', @pieces;

  return 'Syntax: rdb add  ' unless $rdb and $item;

  my $rplvars = {
    nick => $msg->src_nick,
    rdb  => $rdb,
  };

  my $username = core->auth->username($msg->context, $msg->src_nick);

  my ($retval, $err) =
    $self->_add_item($rdb, decode_irc($item), $username);

  my $rpl;
  if ($retval) {
    $rplvars->{index} = $retval;
    $rpl = 'RDB_ITEM_ADDED';
  } else {
    RDBADDERR: {
      if ($err eq 'RDB_NOSUCH') {
        $rpl = 'RDB_ERR_NO_SUCH_RDB';  last RDBADDERR
      }

      if ($err eq 'RDB_DBFAIL') {
        $rpl = 'RPL_DB_ERR';           last RDBADDERR
      }

      my $errstr = "BUG; Unknown err $err from _add_item";
      logger->warn($errstr);
      return $errstr
    }
  }

  return core->rpl( $rpl, $rplvars )
}

sub _cmd_rdb_del {
  my ($self, $msg, $parsed_args) = @_;

  my ($rdb, @item_indexes) = @$parsed_args;

  return 'Syntax: rdb del  '
    unless $rdb and @item_indexes;

  my $rplvars = {
    nick => $msg->src_nick,
    rdb  => $rdb,
  };

  my $username = core->auth->username($msg->context, $msg->src_nick);

  INDEX: for my $item_idx (@item_indexes) {
    my ($retval, $err) =
      $self->_delete_item($rdb, $item_idx, $username);

    $rplvars->{index} = $item_idx;

    my $rpl;

    if ($retval) {
      $rpl = "RDB_ITEM_DELETED";
    } else {
      ITEMDELERR: {
        if ($err eq 'RDB_NOSUCH') {
          $rpl = 'RDB_ERR_NO_SUCH_RDB';   last ITEMDELERR
        }
        if ($err eq 'RDB_DBFAIL') {
          $rpl = 'RPL_DB_ERR';            last ITEMDELERR
        }
        if ($err eq 'RDB_NOSUCH_ITEM') {
          $rpl = 'RDB_ERR_NO_SUCH_ITEM';  last ITEMDELERR
        }
        my $errstr = "BUG; Unknown err $err from _delete_item";
        logger->warn($errstr);
        return $errstr
      }

    }

    broadcast( 'message',
      $msg->context,
      $msg->channel,
      core->rpl($rpl, $rplvars)
    );

  } ## INDEX

  return
}

sub _cmd_rdb_get {
  my ($self, $msg, $parsed_args) = @_;

  my $dbmgr = $self->DBmgr;

  my ($rdb, $idx) = @$parsed_args;

  return 'Syntax: rdb get  '
    unless $rdb and $idx;

  return "Invalid item index ID"
    unless $idx =~ /^[0-9a-f]+$/i;

  $idx = lc($idx);

  my $rplvars = {
    nick => $msg->src_nick,
    rdb  => $rdb,
    ## Cut the index ID in response string to 16 chars
    ## Gives some flex without making flooding too easy
    index => substr($idx, 0, 16),
  };

  unless ( $dbmgr->dbexists($rdb) ) {
    return core->rpl( 'RDB_ERR_NO_SUCH_RDB', $rplvars );
  }

  my ($item_ref, $rpl);

  try {
    $item_ref = $dbmgr->get($rdb, $idx)
  } catch {
    logger->debug("_cmd_rdb_get; Database->get error $_");
    $rpl = $self->{RPL_MAP}->{$_}
  };

  return core->rpl( $rpl, $rplvars )
    if defined $rpl;

  my $content = $self->_content_from_ref($item_ref)
    // '(undef - broken db?)' ;

  return "[$idx] $content"
}

sub _cmd_rdb_info {
  my ($self, $msg, $parsed_args) = @_;

  my $dbmgr = $self->DBmgr;

  my ($rdb, $idx) = @$parsed_args;

  return 'Syntax: rdb info  '
    unless $rdb;

  my $rplvars = {
    nick => $msg->src_nick,
    rdb  => $rdb,
  };

  return core->rpl( 'RDB_ERR_NO_SUCH_RDB', $rplvars )
    unless $dbmgr->dbexists($rdb);

  if (!$idx) {

    return try {
      my $n_keys = $dbmgr->get_keys($rdb);
      "RDB $rdb has $n_keys items"
    } catch {
      "RDB::Database error: ".$_
    }

  } else {
    return "Invalid item index ID"
      unless $idx =~ /^[0-9a-f]+$/i;

    $idx = lc($idx);
  }

  $rplvars->{index} = substr($idx, 0, 16);

  my ($item_ref, $rpl);

  try {
    $item_ref = $dbmgr->get($rdb, $idx)
  } catch {
    logger->debug("_cmd_rdb_info; Database->get error $_");
    $rpl = $self->{RPL_MAP}->{$_}
  };

  return core->rpl( $rpl, $rplvars )
    if defined $rpl;

  my $addedat_ts = ref $item_ref eq 'HASH' ?
                   $item_ref->{AddedAt} : $item_ref->[1];

  my $added_by   = ref $item_ref eq 'HASH' ?
                   $item_ref->{AddedBy} : $item_ref->[2];

  $rplvars->{date} = POSIX::strftime(
    "%Y-%m-%d", localtime( $addedat_ts )
  );

  $rplvars->{time} = POSIX::strftime(
    "%H:%M:%S (%Z)", localtime( $addedat_ts )
  );

  $rplvars->{addedby} = $added_by // '(undef)' ;

  return core->rpl( 'RDB_ITEM_INFO', $rplvars );
}

sub _cmd_rdb_count {
  my ($self, $msg, $parsed_args) = @_;

  my ($rdb, $str) = @$parsed_args;

  ## count  is the same as info
  return $self->_cmd_rdb_info($msg, $parsed_args)
    unless defined $str;

  return 'Syntax: rdb count  '
    unless defined $rdb;

  my $indices = $self->_searchidx($msg, 'count', $rdb, $str);

  ## Same deal as searchidx, return immediately if this is async.
  return unless ref $indices eq 'ARRAY';

  my $count = @$indices;
  return $msg->src_nick .": Found $count matches";
}

sub _cmd_rdb_search {
  my ($self, $msg, $parsed_args) = @_;

  ## Pass-thru to _cmd_randq

  my ($rdb, $str) = @$parsed_args;

  $str = '*' unless $str;
  return 'Syntax: rdb search  ' unless $rdb;

  return $self->_cmd_randq([], $msg, 'rdb', $rdb, $str)
}

sub _cmd_rdb_searchidx {
  my ($self, $msg, $parsed_args) = @_;

  my ($rdb, $str) = @$parsed_args;

  return 'Syntax: rdb searchidx  '
    unless $rdb and $str;

  my $indices = $self->_searchidx($msg, 'indexes', $rdb, $str);

  ## if we posted out to asyncsearch, return immediately
  return unless ref $indices eq 'ARRAY';

  ## otherwise we should have indices
  $indices->[0] = 'No matches' unless @$indices;
  my $count = @$indices;

  my (@returned, $prefix);
  if ($count > 30) {
    @returned = @$indices[0 .. 29];
    $prefix   = "Matches (30 of $count): ";
  } else {
    @returned = @$indices;
    $prefix   = "Matches: ";
  }

  return $prefix.join('  ', @returned);
}
  ### self-events ###

sub Bot_rdb_triggered {
  ## Bot_rdb_triggered $context, $channel, $nick, $rdb
  my ($self, $core) = splice @_, 0, 2;
  my $context = ${$_[0]};
  my $channel = ${$_[1]};
  my $nick    = ${$_[2]};
  my $rdb     = ${$_[3]};
  my $orig    = ${$_[4]};
  my $questionstr = ${$_[5]};

  ## event normally triggered by Info3 when a topic references a ~rdb
  ## grab a random response and throw it back at the pipeline
  ## info3 plugin can pick it up and do variable replacement on it

  logger->debug("received rdb_triggered");

  my $dbmgr = $self->DBmgr;

  ## if referenced rdb doesn't exist, send orig string
  my $send_orig;
  unless ( $dbmgr->dbexists($rdb) ) {
      ++$send_orig;
  }

  ## construct fake msg obj for _select_random
  my $new_msg = Bot::Cobalt::IRC::Message::Public->new(
    context => $context,
    src     => $nick . '!fake@host',
    targets => [ $channel ],
    message => '',
  );

  my $random = $send_orig ? $orig
               : $self->_select_random($new_msg, $rdb, 'quietfail') ;

  if (exists core()->Provided->{info_topics}) {
    broadcast( 'info3_relay_string',
      $context, $channel, $nick, $random, $questionstr
    );
  } else {
    logger->warn("RDB plugin cannot trigger, Info3 is missing");
  }
  return PLUGIN_EAT_ALL
}

sub Bot_rdb_broadcast {
  my ($self, $core) = splice @_, 0, 2;
  ## our timer self-event

  ## reset timer unless randdelay is 0
  if ($self->rand_delay) {
    $core->timer_set( $self->rand_delay,
      {
        Event => 'rdb_broadcast',
        Alias => $core->get_plugin_alias($self)
      },
      'RANDSTUFF'
    );

    logger->debug("rdb_broadcast; timer reset; ".$self->rand_delay);
  }

  my $mock_msg = Bot::Cobalt::IRC::Message::Public->new(
    context => '',
    src     => '',
    targets => [],
    message => '',
  );

  my $random = $self->_select_random($mock_msg, 'main', 'quietfail')
               // return PLUGIN_EAT_ALL;

  ## iterate channels cfg
  ## throw randstuffs at configured channels unless told not to
  my $servers = $core->Servers;

  SERVER: for my $context (keys %$servers) {
    my $c_obj = $core->get_irc_context($context);

    next SERVER unless $c_obj->connected;

    my $irc   = $core->get_irc_obj($context) || next SERVER;
    my $chcfg = $core->get_channels_cfg($context) || next SERVER;

    logger->debug("rdb_broadcast to $context");

    my $on_channels = $irc->channels || {};
    my $casemap  = $core->get_irc_casemap($context) || 'rfc1459';
    my @channels = map { lc_irc($_, $casemap) } keys %$on_channels;

    my $evtype;
    if ( index($random, '+') == 0 ) {
      ## action
      $random = substr($random, 1);
      $evtype = 'action';
    } else {
      $evtype = 'message';
    }

    logger->debug("rdb_broadcast; type is $evtype");

    @channels = grep {
      $chcfg->{ lc_irc($_, $casemap) }->{rdb_randstuffs} // 1
    } @channels;

    if ($evtype eq 'message') {
      my $maxtargets = $c_obj->maxtargets;
      while (my @targets = splice @channels, 0, $maxtargets) {
        my $tcount = @targets;
        my $targetstr = join ',', @targets;

        logger->debug(
          "rdb_broadcast (MSG) to $tcount targets (max $maxtargets)",
          "($context -> $targetstr)"
        );

        broadcast($evtype, $context, $targetstr, $random);
      }
    } else {
      ## FIXME
      ##  Seeing incorrect output when directing ACTION to multiple
      ##  channels; TESTME
      for my $targetstr (@channels) {
        logger->debug(
          "rdb_broadcast (ACTION) to $targetstr",
        );
        broadcast($evtype, $context, $targetstr, $random)
      }
    }

  } # SERVER

  return PLUGIN_EAT_ALL  ## theoretically no one else cares
}


### util methods

sub _content_from_ref {
  ## Backwards-compat retrieval.
  ## (Old-style RDB items were hashrefs.)
  my ($self, $ref) = @_;
  ref $ref eq 'HASH' ? $ref->{String} : $ref->[0]
}

sub _searchidx {
  my ($self, $msg, $type, $rdb, $string) = @_;
  $rdb   = 'main' unless $rdb;
  $string = '<*>' unless $string;

  my $dbmgr = $self->DBmgr;

  if ( $self->SessionID ) {
    ## if we have asyncsearch, return immediately

    unless ( $dbmgr->dbexists($rdb) ) {
      return core->rpl( 'RDB_ERR_NO_SUCH_RDB',
        nick => $msg->src_nick,
        rdb  => $rdb,
      );
    }

    logger->debug("_searchidx; dispatching to poe_post_search");

    $poe_kernel->post( $self->SessionID,
      'poe_post_search',
      $rdb,
      $string,
      {          ## Hints hash
        Glob     => $string,
        Context  => $msg->context,
        Channel  => $msg->channel,
        Nickname => $msg->src_nick,
        GetType  => $type,
        RDB      => $rdb,
      },
    );

    return
  }

  return try {
    logger->debug("_searchidx; dispatching (blocking) search");
    scalar $dbmgr->search($rdb, $string)
  } catch {
    logger->debug("_searchidx failure; $_");
    undef ## FIXME throw exception ?
  }
}

sub _add_item {
  my ($self, $rdb, $item, $username) = @_;
  return unless $rdb and defined $item;

  $username = '-undefined' unless $username;

  my $dbmgr = $self->DBmgr;
  unless ( $dbmgr->dbexists($rdb) ) {
    logger->debug("cannot add item to nonexistant rdb: $rdb");
    return (0, 'RDB_NOSUCH')
  }

  my $itemref = [ $item, time(), $username ];

  my ($status, $err);
  try {
    $status = $dbmgr->put($rdb, $itemref)
  } catch {
    $err = $_
  };

  return(0, $err) if defined $err;

  ## otherwise we should've gotten the new key back:
  my $pref = core->Provided;
  ++$pref->{randstuff_items} if $rdb eq 'main';

  return $status
}

sub _delete_item {
  my ($self, $rdb, $item_idx, $username) = @_;
  return unless $rdb and defined $item_idx;

  my $dbmgr = $self->DBmgr;

  unless ( $dbmgr->dbexists($rdb) ) {
    logger->debug("cannot delete from nonexistant rdb: $rdb");
    return(0, 'RDB_NOSUCH')
  }

  my ($status, $err);
  try {
    $status = $dbmgr->del($rdb, $item_idx)
  } catch {
    $err = $_
  };

  return(0, $err) if defined $err;

  my $pref = core->Provided;
  --$pref->{randstuff_items} if $rdb eq 'main';

  return $item_idx
}


sub _delete_rdb {
  my ($self, $rdb) = @_;
  return unless $rdb;

  my $pcfg = core->get_plugin_cfg( $self );

  my $can_delete = $pcfg->{Opts}->{AllowDelete} // 0;

  unless ($can_delete) {
    logger->debug("attempted delete but AllowDelete = 0");
    return (0, 'RDB_NOTPERMITTED')
  }

  my $dbmgr = $self->DBmgr;

  unless ( $dbmgr->dbexists($rdb) ) {
    logger->debug("cannot delete nonexistant rdb $rdb");
    return (0, 'RDB_NOSUCH')
  }

  if ($rdb eq 'main') {
    ## check if this is 'main'
    ##  check core cfg to see if we can delete 'main'
    ##  default to no
    my $can_del_main = $pcfg->{Opts}->{AllowDeleteMain} // 0;
    unless ($can_del_main) {
      logger->debug(
        "attempted to delete main but AllowDelete Main = 0"
      );
      return (0, 'RDB_NOTPERMITTED')
    }
  }

  my ($status, $err);
  try {
    $status = $dbmgr->deldb($rdb)
  } catch {
    $err = $_
  };

  return(0, $err) if defined $err;

  return 1
}


## POE

sub _start {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];

  $self->SessionID( $_[SESSION]->ID );

  $kernel->alias_set('sess_'. core->get_plugin_alias($self) );

  # if you change the default (5) adjust default etc/plugins/rdb.conf ->
  my $maxworkers = core()->get_plugin_cfg($self)->{Opts}->{AsyncSearch};
  $maxworkers = 5 unless $maxworkers =~ /^[0-9]+$/ and $maxworkers > 1;

  ## spawn asyncsearch sess
  require Bot::Cobalt::Plugin::RDB::AsyncSearch;

  my $asid = Bot::Cobalt::Plugin::RDB::AsyncSearch->spawn(
    MaxWorkers  => $maxworkers,
    ResultEvent => 'poe_got_result',
    ErrorEvent  => 'poe_got_error',
  );

  $self->AsyncSessionID( $asid );
}

sub poe_post_search {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($rdbname, $globstr, $hintshash) = @_[ARG0 .. $#_];

  logger->debug("Posting async search ($rdbname)");

  ## compose rdb path
  my $cfg = core->get_plugin_cfg($self);

  my $rdbdir = File::Spec->catdir(
    core()->var,
    $cfg->{Opts}->{RDBDir} ? $cfg->{Opts}->{RDBDir} : ('db', 'rdb')
  );

  my $rdbpath = File::Spec->catfile( $rdbdir, "$rdbname.rdb" );

  my $dbmgr = $self->DBmgr;

  if (my @matches = $dbmgr->cache_check($rdbname, $globstr) ) {
    ## have cached results in ::Database's cache
    ## yield back to ourselves and return
    $kernel->post( $_[SESSION], 'poe_got_result',
      \@matches,
      $hintshash,
    );
    return
  }

  my $re = glob_to_re_str($globstr);

  ## post a search w / hintshash
  $kernel->post( $self->AsyncSessionID,
    'search_rdb',
    $rdbpath,
    $re,
    $hintshash
  );
}

sub poe_got_result {
  my ($self, $kernel, $heap)  = @_[OBJECT, KERNEL, HEAP];
  my ($resultarr, $hintshash) = @_[ARG0, ARG1];

  my $context  = $hintshash->{Context};
  my $channel  = $hintshash->{Channel};
  my $nickname = $hintshash->{Nickname};
  ## type is: string, indexes, or count
  ##  (aka: randq / rdb search, rdb searchidx, rdb count)
  my $type     = $hintshash->{GetType};
  my $glob     = $hintshash->{Glob};
  my $rdb      = $hintshash->{RDB};

  logger->debug("Received async search response ($rdb)");

  my $resp;

  my $dbmgr = $self->DBmgr;

  RESPTYPE: for ($type) {
    if ($type eq 'string') {
      unless (@$resultarr) {
        $resp = "$nickname: No matches found for $glob";
      } else {
        ## cachable, we get a full set back
        $dbmgr->cache_push($rdb, $glob, $resultarr);

        my $itemkey = $resultarr->[rand @$resultarr];

        my ($item, $rpl);

        try {
          $item = $dbmgr->get($rdb, $itemkey)
        } catch {
          logger->debug("poe_got_result; error from get(): $_");
          $rpl = $self->{RPL_MAP}->{$_}
        };

        if (defined $rpl) {
          $resp = core->rpl( $rpl,
            nick  => $nickname,
            rdb   => $rdb,
            index => $itemkey,
          );
        } else {
          my $content = $self->_content_from_ref($item)
            // '(undef - broken db?)';

          $resp = "[$itemkey] $content"
        }
      }
      last RESPTYPE
    }

    if ($type eq 'indexes') {
      unless (@$resultarr) {
        $resp = "$nickname: No matches found for $glob";
      } else {
        $dbmgr->cache_push($rdb, $glob, $resultarr);

        my $count = @$resultarr;

        my (@returned, $prefix);

        if ($count > 30) {
          @returned = (shuffle @$resultarr)[0 .. 29];
          $prefix   = "$nickname: matches (30 / $count): ";
        } else {
          @returned = @$resultarr;
          $prefix   = "$nickname: matches ($count): ";
        }

        $resp = $prefix . join('  ', @returned);
      }
      last RESPTYPE
    }

    if ($type eq 'count') {
      $dbmgr->cache_push($rdb, $glob, $resultarr)
        if @$resultarr;

      my $count = @$resultarr;
      $resp = "$nickname: Found $count matches for $glob";
      last RESPTYPE
    }

  }

  broadcast( 'message', $context, $channel, $resp )
    if defined $resp;
}

sub poe_got_error {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($error, $hints) = @_[ARG0, ARG1];

  my $glob = $hints->{Glob};
  my $rdb  = $hints->{RDB};

  logger->warn("Received error from AsyncSearch: $rdb ($glob): $error");

  my $context  = $hints->{Context};
  my $channel  = $hints->{Channel};
  my $nickname = $hints->{Nickname};

  broadcast( 'message', $context, $channel,
    "$nickname: asyncsearch error: $error ($rdb)"
  );
}

1;

=pod

=head1 NAME

Bot::Cobalt::Plugin::RDB - Bot::Cobalt "random" DB plugin

=head1 DESCRIPTION

Jason Hamilton's B came with the concept of "randstuffs,"
randomized responses broadcast to channels via a timer.

Later versions included a search interface and "RDBs" -- discrete
'randstuff' databases that could be accessed via 'info' topic triggers
to return a random response.

B used essentially the same interface.
This B plugin attempts to expand on that concept.

This functionality is often useful to simulate humanoid responses to
conversation (by writing 'conversational' RDB replies triggered by
L topics), to implement IRC quotebots, or just
to fill your channel with random chatter.

The "randstuff" db is labelled "main" -- all other RDB names must be
in the [a-z0-9] set.

Requires L.

=head1 COMMANDS

Commands are prefixed with the bot's nickname, rather than CmdChar.

This is a holdover from darkbot legacy syntax.

   botnick: randq some*glob

=head2 randq

Search for a specified glob in RDB 'main' (randstuffs):

   bot: randq some+string*

See L for details regarding glob syntax.

=head2 randstuff

Add a new "randstuff" to the 'main' RDB

   bot: randstuff new randstuff string

A randstuff can also be an action; simply prefix the string with B<+> :

   bot: randstuff +dances around

Legacy darkbot-style syntax is supported; you can add items to RDBs
by prefixing the RDB name with B<~>, like so:

  randstuff ~myrdb some new string

The RDB must already exist; see L

=head2 rdb

=head3 rdb get

  rdb get

Retrieves the specified item from the specified RDB.

=head3 rdb info

  rdb info
  rdb info

Given just a RDB name, returns the number of items in the RDB.

Given a RDB name and a valid itemID, returns some metadata regarding the
item, including the username that added it and the date it was added.

=head3 rdb add

  rdb add

Add a new item to the specified RDB. Also see L

=head3 rdb del

  rdb del   [itemID ...]

Deletes items from the specified RDB.

=head3 rdb dbadd

  rdb dbadd

Creates a new, empty RDB.

=head3 rdb dbdel

  rdb dbdel

Deletes the specified RDB entirely.

Deletion may be disabled in the plugin's configuration file via the
B<< Opts->AllowDelete >> directive.

=head3 rdb search

  rdb search

Search within a specific RDB. Returns a single random response from the
result set. Also see L and L
for more details on search syntax.

=head3 rdb searchidx

  rdb searchidx

Returns all RDB item IDs matching the specified glob.

=head3 rdb count

  rdb count

Returns just the total number of matches for the specified glob.

=head2 random

'random' is not actually a built-in command; however, since you must have
L, a handy trick is to add a topic named 'random'
that triggers RDB 'main':

   bot: add random ~main

That will allow use of 'random' to pull a randomly-selected entry from the
'randstuffs' database.


=head1 EVENTS

=head2 Received events

=head3 rdb_broadcast

Self-triggered event.

Called on a timer to broadcast randstuffs from RDB "main."

Takes no arguments.

=head3 rdb_triggered

Triggered (usually by L) when a RDB is polled
for a random response.

Arguments are:

  $context, $channel, $nick, $rdb, $topic_value, $original_str

Broadcasts an L in response, which is picked up by
B to perform variable replacement before relaying back to the
calling channel.

=head2 Emitted events

=head3 info3_relay_string

Broadcast by L to be picked up by L.

Arguments are:

  $context, $channel, $nick, $string, $original

=head1 AUTHOR

Jon Portnoy

=cut