File Coverage

blib/lib/Mojar/Cache.pm

Criterion	Covered	Total	%
statement	38	60	63.3
branch	8	10	80.0
condition	5	7	71.4
subroutine	7	15	46.6
pod	3	14	21.4
total	61	106	57.5

package Mojar::Cache;
use Mojo::Base -base;

# Attributes

has namespace => 'main';
has on_get_error => sub { sub { require Carp; Carp::croak @_ } };
has on_set_error => sub { sub { require Carp; Carp::croak @_ } };

has slots => sub { [] };
has 'max_keys';

# Public methods

sub new {
  my ($proto, %param) = @_;
  my $self = $proto->SUPER::new(%param);
  $self->{store} = {};
  return $self;
}

# Getting and setting

sub get {
  my ($self, $key) = @_;
  my $value;
  eval {
    $value = $self->{store}{$self->namespace}{$key};
    1;
  }
  or do {
    my $e = $@ // 'Failed get';
    $self->on_get_error->($e);
  };
  return $value;
}

sub set {
  my ($self, $key, $value) = @_;
  eval {
    my $slots = $self->slots;
    unless ($self->is_valid($key)) {
      push @$slots, $key;
      while ($self->max_keys and scalar @$slots > $self->max_keys) {
        # Too many in the bed
        $self->remove(shift @$slots);
      }
    }
    $self->{store}{$self->namespace}{$key} = $value;
    1;
  }
  or do {
    my $e = $@ // 'Failed set';
    $self->on_set_error->($e);
  };
  return $self;
}

sub compute {
  my ($self, $key, $code) = @_;
  my $cache = $self->{store}{$self->namespace};
  return $cache->{$key} if exists $cache->{$key};

  my $value = $code->($key);
  $self->set($key => $value);
  return $value;
}

# Removing

sub remove {
  my ($self, $key) = @_;
  delete $self->{store}{$self->namespace}{$key};
  return $self;
}

# Inspecting keys

sub is_valid {
  my ($self, $key) = @_;
  return exists $self->{store}{$self->namespace}{$key};
}

# Atomic operations

sub append {
  my ($self, $key, $further_text) = @_;
  $self->{store}{$self->namespace}{$key} .= $further_text;
  return $self;
}

# Namespace operations

sub clear {
  my $self = shift;
  $self->{store}{$self->namespace} = {};
  return $self;
}

sub get_keys { keys %{ $_[0]{store}{$_[0]->namespace} } }

# Multiple key/value operations

sub get_multi_arrayref {
  my ($self, $keys_ref) = @_;
  my $cache = $self->{store}{$self->namespace};
  return [ map $cache->{$_}, @$keys_ref ];
}

sub get_multi_hashref {
  my ($self, $keys_ref) = @_;
  my $cache = $self->{store}{$self->namespace};
  return { map $_ => $cache->{$_}, @$keys_ref };
}

sub set_multi {
  my ($self, $hashref) = @_;
  while (my ($k, $v) = each %$hashref) {
    $self->set($k => $v);
  }
  return $self;
}

sub remove_multi {
  my ($self, $keys_ref) = @_;
  $self->remove($_) foreach @$keys_ref;
  return $self;
}

sub to_hashref { $_[0]{store}{$_[0]->namespace} || {} }

1;
__END__