File Coverage

blib/lib/Tie/Redis/Candy/Hash.pm

Criterion	Covered	Total	%
statement	15	43	34.8
branch	0	10	0.0
condition			n/a
subroutine	5	13	38.4
pod			n/a
total	20	66	30.3

# This file was part of Redis, licensed under:
#
#   The Artistic License 2.0 (GPL Compatible)
#
# Copyright (c) 2015 by Pedro Melo, Damien Krotkine.

package Tie::Redis::Candy::Hash;

# ABSTRACT: tie Perl hashes to Redis hashes - the candy way

use strict;
use warnings;
use Carp;
use CBOR::XS qw(encode_cbor decode_cbor);
use base 'Tie::Hash';

our $VERSION = '0.004';    # VERSION

sub TIEHASH {
    my ( $class, $redis, $prefix ) = @_;

    die "whaa: $redis" unless ref $redis eq 'Redis';

    $prefix = $prefix ? $prefix . ':' : '';

    my $self = {
        prefix => $prefix,
        redis  => $redis,
    };

    return bless( $self, $class );
}

sub STORE {
    my ( $self, $key, $value ) = @_;
    $self->{redis}->set( $self->{prefix} . $key, encode_cbor($value) );
}

sub FETCH {
    my ( $self, $key ) = @_;
    my $data = $self->{redis}->get( $self->{prefix} . $key );
    return unless defined $data;
    decode_cbor($data);
}

sub FIRSTKEY {
    my $self = shift;
    $self->{prefix_keys} = [ $self->{redis}->keys( $self->{prefix} . '*' ) ];
    $self->NEXTKEY;
}

sub NEXTKEY {
    my $self = shift;

    my $key = shift @{ $self->{prefix_keys} };
    return unless defined $key;

    my $p = quotemeta $self->{prefix};
    $key =~ s/^$p// if $p;
    return $key;
}

sub EXISTS {
    my ( $self, $key ) = @_;
    $self->{redis}->exists( $self->{prefix} . $key );
}

sub DELETE {
    my ( $self, $key ) = @_;
    $self->{redis}->del( $self->{prefix} . $key );
}

sub CLEAR {
    my ($self) = @_;
    $self->{redis}->del($_) for $self->{redis}->keys( $self->{prefix} . '*' );
    $self->{prefix_keys} = [];
}

1;

__END__