File Coverage

blib/lib/Data/SortedSet/Shared/Strings.pm

Criterion	Covered	Total	%
statement	96	96	100.0
branch	29	34	85.2
condition	10	14	71.4
subroutine	33	33	100.0
pod	0	24	0.0
total	168	201	83.5

package Data::SortedSet::Shared::Strings;
use strict;
use warnings;
use Carp ();
use Data::Intern::Shared ();
use Data::SortedSet::Shared ();

our $VERSION = '0.02';

# ---- construction ----

sub new {
    my ($class, %opt) = @_;
    my $max = $opt{max};
    Carp::croak("new: 'max' is required") unless defined $max;
    my $set  = Data::SortedSet::Shared->new($opt{set}, $max);
    my $keys = Data::Intern::Shared->new($opt{keys}, $opt{max_keys} // $max, $opt{arena} // 0);
    return bless { set => $set, keys => $keys }, $class;
}

# wrap two already-constructed shared objects (e.g. memfd-backed)
sub wrap {
    my ($class, $set, $keys) = @_;
    Carp::croak("wrap: expected a Data::SortedSet::Shared")
        unless ref $set && $set->isa('Data::SortedSet::Shared');
    Carp::croak("wrap: expected a Data::Intern::Shared")
        unless ref $keys && $keys->isa('Data::Intern::Shared');
    return bless { set => $set, keys => $keys }, $class;
}

sub set        { $_[0]{set} }     # the underlying Data::SortedSet::Shared
sub key_table  { $_[0]{keys} }    # the underlying Data::Intern::Shared

# ---- mutators (intern the key -> id) ----

sub add {
    my ($self, $str, $score) = @_;
    my $id = $self->{keys}->intern($str);
    return undef unless defined $id;          # key table full
    return $self->{set}->add($id, $score);
}

sub incr {
    my ($self, $str, $delta) = @_;
    my $id = $self->{keys}->intern($str);
    Carp::croak("incr: key table full") unless defined $id;
    return $self->{set}->incr($id, $delta);
}

sub remove {
    my ($self, $str) = @_;
    my $id = $self->{keys}->id_of($str);
    return defined $id ? $self->{set}->remove($id) : 0;
}

sub add_many {
    my ($self, $rows) = @_;
    Carp::croak("add_many: expected an arrayref") unless ref $rows eq 'ARRAY';
    my @id_rows;
    for my $r (@$rows) {
        next unless ref $r eq 'ARRAY' && @$r >= 2;
        next if $r->[1] != $r->[1];           # skip a NaN score before interning (no ghost key slot)
        my $id = $self->{keys}->intern($r->[0]);
        last unless defined $id;              # key table full -> stop
        push @id_rows, [ $id, $r->[1] ];
    }
    return $self->{set}->add_many(\@id_rows);
}

sub clear { $_[0]{set}->clear; $_[0]{keys}->clear; return }

# ---- lookup (id_of the key; undef short-circuits) ----

sub score    { my $id = $_[0]{keys}->id_of($_[1]); defined $id ? $_[0]{set}->score($id)    : undef }
sub rank     { my $id = $_[0]{keys}->id_of($_[1]); defined $id ? $_[0]{set}->rank($id)     : undef }
sub rev_rank { my $id = $_[0]{keys}->id_of($_[1]); defined $id ? $_[0]{set}->rev_rank($id) : undef }
sub exists   { my $id = $_[0]{keys}->id_of($_[1]); defined $id ? $_[0]{set}->exists($id)   : 0 }
sub count          { $_[0]{set}->count }
sub count_in_score { shift->{set}->count_in_score(@_) }

# ---- rank / range (decode ids back to strings) ----

sub _decode {
    my ($self, $ws, @list) = @_;
    my $k = $self->{keys};
    return map { $k->string($_) } @list unless $ws;
    my @out;
    for (my $i = 0; $i < @list; $i += 2) { push @out, $k->string($list[$i]), $list[$i + 1] }
    return @out;
}

sub at_rank {
    my $id = $_[0]{set}->at_rank($_[1]);
    return defined $id ? $_[0]{keys}->string($id) : undef;
}

sub range_by_rank {
    my ($self, $start, $stop, %opt) = @_;
    $self->_decode($opt{withscores}, $self->{set}->range_by_rank($start, $stop, %opt));
}
sub rev_range_by_rank {
    my ($self, $start, $stop, %opt) = @_;
    $self->_decode($opt{withscores}, $self->{set}->rev_range_by_rank($start, $stop, %opt));
}
sub range_by_score {
    my ($self, $min, $max, %opt) = @_;
    $self->_decode($opt{withscores}, $self->{set}->range_by_score($min, $max, %opt));
}
sub rev_range_by_score {
    my ($self, $max, $min, %opt) = @_;
    $self->_decode($opt{withscores}, $self->{set}->rev_range_by_score($max, $min, %opt));
}

# ---- pop / peek (id -> string) ----

for my $m (qw(pop_min pop_max peek_min peek_max)) {
    no strict 'refs';
    *$m = sub {
        my ($id, $score) = $_[0]{set}->$m;
        return defined $id ? ($_[0]{keys}->string($id), $score) : ();
    };
}

# ---- iteration ----

sub each {
    my ($self, $cb) = @_;
    my $k = $self->{keys};
    $self->{set}->each(sub { $cb->($k->string($_[0]), $_[1]) });
    return;
}

# ---- lifecycle ----

sub sync  { $_[0]{set}->sync; $_[0]{keys}->sync; return }
sub unlink { $_[0]{set}->unlink; $_[0]{keys}->unlink; return }
sub stats { { set => $_[0]{set}->stats, keys => $_[0]{keys}->stats } }

1;
__END__