File Coverage

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

Criterion	Covered	Total	%
statement	44	46	95.6
branch	16	22	72.7
condition	8	20	40.0
subroutine	9	9	100.0
pod	0	5	0.0
total	77	102	75.4

package Bot::Cobalt::Plugin::RDB::SearchCache;
$Bot::Cobalt::Plugin::RDB::SearchCache::VERSION = '0.021001';
## This is a fairly generic in-memory cache object.
##
## It's intended for use with Plugin::RDB, but will likely work for
## just about situation where you want to store a set number of keys
## mapping an identifier to an array reference.
##
## This can be useful for caching the results of deep searches against
## Bot::Cobalt::DB instances, for example.
##
## This may get moved out to the core lib directory, in which case this
## module will become a placeholder.

use 5.10.1;
use strictures 2;

use Time::HiRes ();

sub new {
  my $self = +{ Cache => +{} };
  my $class = shift;
  bless $self, $class;

  my %opts = @_;
  $self->MaxKeys($opts{MaxKeys} || 30);

  $self
}

sub cache {
  my ($self, $ckey, $match, $resultset) = @_;
  ## should be passed rdb, search str, and array of matching indices

  return unless defined $ckey and defined $match;
  $resultset = [] unless ref $resultset eq 'ARRAY';

  ## _shrink will do the right thing depending on size of cache
  ## (MaxKeys can be used to adjust cachesize per-rdb 'on the fly')
  $self->_shrink($ckey);

  $self->{Cache}->{$ckey}->{$match} = +{
    TS => Time::HiRes::time(),
    Results => $resultset,
  };
}

sub fetch {
  my ($self, $ckey, $match) = @_;

  return
    unless defined $ckey
    and defined $match
    and exists $self->{Cache}->{$ckey}
    and $self->{Cache}->{$ckey}->{$match};

  my $ref = $self->{Cache}->{$ckey}->{$match};
  wantarray ? @{ $ref->{Results} } : $ref->{Results}
}

sub MaxKeys {
  my ($self, $max) = @_;
  return $self->{MAX_KEYS} = $max if defined $max;
  $self->{MAX_KEYS}
}

sub invalidate {
  my ($self, $ckey, $match) = @_;
  ## should be called on add/del operations

  unless (defined $ckey) {
    ## invalidate all by not passing an arg
    $self->{Cache} = +{};
    return
  }

  return unless exists $self->{Cache}->{$ckey}
         and keys %{ $self->{Cache}->{$ckey} } ;

  return delete $self->{Cache}->{$ckey}->{$match}
    if defined $match;

  delete $self->{Cache}->{$ckey}
}

sub _shrink {
  my ($self, $ckey) = @_;

  return unless defined $ckey and ref $self->{Cache}->{$ckey};

  my $cacheref = $self->{Cache}->{$ckey};

  return unless scalar keys %$cacheref > $self->MaxKeys;

  my @cached = sort {
      $cacheref->{$a}->{TS} <=> $cacheref->{$b}->{TS}
    } keys %$cacheref;

  my $deleted = 0;

  while (scalar keys %$cacheref > $self->MaxKeys) {
    my $nextkey = shift @cached;
    ++$deleted if delete $cacheref->{$nextkey};
  }

  $deleted
}

1;
__END__