File Coverage

blib/lib/Suggest/PrePop.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Suggest::PrePop;

use strict;
use warnings;
our $VERSION = '1.0.0';

use Moose;

use Cache::RedisDB;

has cache_namespace => (
    is      => 'ro',
    isa     => 'Str',
    default => 'SUGGEST-PREPOP',
);

my $key_sep = '<>';

has _lex_key => (
    is      => 'ro',
    isa     => 'Str',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return join($key_sep, $self->cache_namespace, 'ITEMS_BY_LEX');
    },
);

has _cnt_key => (
    is      => 'ro',
    isa     => 'Str',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return join($key_sep, $self->cache_namespace, 'ITEMS_BY_COUNT');
    },
);

has min_activity => (
    is      => 'ro',
    isa     => 'Int',
    default => 5,
);

has entries_limit => (
    is      => 'ro',
    isa     => 'Int',
    default => 32768,
);

has top_count => (
    is      => 'ro',
    isa     => 'Int',
    default => 5,
);

# Convenience
sub _redis { Cache::RedisDB->redis }

sub add {
    my ($self, $item, $count) = @_;

    $count //= 1;    # Most of the time we'll just get a single entry

    # For now, we just assume supplied items are well-formed
    my $redis = $self->_redis;

    # Lexically sorted items are all zero-scored
    $redis->zadd($self->_lex_key, 0, $item);

    # Score sorted items get incremented.
    return $redis->zincrby($self->_cnt_key, $count, $item);
}

sub ask {
    my ($self, $prefix, $count) = @_;

    $count //= $self->top_count;  # If they don't say we try to find the 5 best.

    my $redis = $self->_redis;

    my @full =
      map  { $_->[0] }
      sort { $b->[1] <=> $a->[1] }
      grep { $_->[1] >= $self->min_activity }
      map  { [$_, $redis->zscore($self->_cnt_key, $_)] } @{
        $redis->zrangebylex(
            $self->_lex_key,
            '[' . $prefix,
            '[' . $prefix . "\xff"
          ) // []};

    return [scalar(@full <= $count) ? @full : @full[0 .. $count - 1]];
}

sub prune {
    my ($self, $keep) = @_;

    $keep //= $self->entries_limit;

    my $redis = $self->_redis;

    # Count key is the one from which results are collated, so even
    # if things are out of sync, this is the one about which we care.
    return 0 if ($redis->zcard($self->_cnt_key) <= $keep);

    my $final_index = -1 * $keep - 1;    # Range below is inclusive.
    my @to_prune = @{$redis->zrange($self->_cnt_key, 0, $final_index)};
    my $count    = scalar @to_prune;

    # We're going to do this the slow way to keep them in sync.
    foreach my $item (@to_prune) {
        $redis->zrem($self->_cnt_key, $item);
        $redis->zrem($self->_lex_key, $item);
    }

    return $count;
}

1;

__END__