view release on metacpan or  search on metacpan

lib/Algorithm/SpatialIndex/Storage/Redis.pm  view on Meta::CPAN

package Algorithm::SpatialIndex::Storage::Redis;
use 5.008001;
use strict;
use warnings;
use Carp qw(confess);

our $VERSION = '0.01';

use Scalar::Util qw(blessed);
use Redis;

use parent 'Algorithm::SpatialIndex::Storage';
use Sereal::Encoder;
use Sereal::Decoder;

use Class::XSAccessor {
  getters => {
    _conn    => 'redisconn',
    _prefix  => 'prefix',
    _encoder => 'encoder',
    _decoder => 'decoder',
  },
};

sub init {
  my $self = shift;
  my $opt = $self->{opt}{redis};

  # Determine key prefix
  my $prefix = $opt->{prefix};
  confess("Need Redis key name prefix for Redis storage backend")
    if not defined $prefix;
  $self->{prefix} = $prefix;

  # Setup (de)serializers
  my $enc = $opt->{encoder};
  if (blessed($enc)) {
    $self->{encoder} = $enc;
  }
  else {
    $self->{encoder} = Sereal::Encoder->new(ref($enc) eq 'HASH' ? $enc : ());
  }
  my $dec = $opt->{decoder};
  if (blessed($dec)) {
    $self->{decoder} = $dec;
  }
  else {
    $self->{decoder} = Sereal::Decoder->new(ref($dec) eq 'HASH' ? $dec : ());
  }

  # Connect to Redis
  my $conn = $opt->{conn};
  if (blessed($conn)) {
    $self->{redisconn} = $conn;
  }
  else {
    $self->{redisconn} = Redis->new(%$conn);
  }

  # Assert state of data in Redis
  $conn = $self->_conn;
  my $type;
  $type = $conn->type($prefix . "_options");
  if ($type eq "hash" || $type eq "none") {
    # fine
  } else {
    confess("Key for option storage in Redis (${prefix}_options) is of incompatible type");
  }

  $type = $conn->type($prefix . "_buckets");
  if ($type eq "hash" || $type eq "none") {
    # fine
  } else {
    confess("Key for bucket storage in Redis (${prefix}_buckets) is of incompatible type");
  }

  $type = $conn->type($prefix . "_nodes");
  if ($type eq "hash" || $type eq "none") {
    # fine
  } else {
    confess("Key for node storage in Redis (${prefix}_nodes) is of incompatible type");
  }
}

sub get_option {
  my $self = shift;
  return $self->_conn->hget($self->_prefix . "_options", shift);
}

sub set_option {
  my ($self, $key, $value) = @_;
  $self->_conn->hset($self->_prefix . "_options", $key, $value);
  return 1;
}

sub fetch_node {
  my ($self, $index) = @_;

  my $node = $self->_conn->hget($self->_prefix . "_nodes", $index);
  return() if not defined $node;
  return $self->_decoder->decode($node);
}

sub store_node {
  my ($self, $node) = @_;

  my $id = $node->id;
  my $conn = $self->_conn;
  my $key = $self->_prefix . "_nodes";
  if (not defined $id) {
    $id = $conn->hincrby($key, "top_id", 1);
    $node->id($id);
  }