File Coverage

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

Criterion	Covered	Total	%
statement	38	38	100.0
branch	3	4	75.0
condition			n/a
subroutine	13	13	100.0
pod			n/a
total	54	55	98.1

# 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 qw(croak);
use CBOR::XS qw(encode_cbor decode_cbor);
use base 'Tie::Hash';

our $VERSION = '1.000';    # VERSION

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

    croak "not a Redis instance: $redis"
      unless ref($redis) =~ m{^(?:Test::Mock::)?Redis$};

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

    return bless( $self, $class );
}

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

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

sub FIRSTKEY {
    my $self = shift;
    $self->{keys} = [ $self->{redis}->hkeys( $self->{key} ) ];
    $self->NEXTKEY;
}

sub NEXTKEY {
    my $self = shift;
    shift @{ $self->{keys} };
}

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

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

sub CLEAR {
    my ($self) = @_;
    $self->{redis}->del( $self->{key} );
    delete $self->{keys};
}

1;

__END__