File Coverage

blib/lib/Redis/Hash.pm

Criterion	Covered	Total	%
statement	12	37	32.4
branch	0	6	0.0
condition			n/a
subroutine	4	12	33.3
pod			n/a
total	16	55	29.0

#
# This file is part of Redis
#
# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
#   The Artistic License 2.0 (GPL Compatible)
#
package Redis::Hash;
$Redis::Hash::VERSION = '1.998'; # TRIAL
# ABSTRACT: tie Perl hashes to Redis hashes
# VERSION
# AUTHORITY

use strict;
use warnings;
use Tie::Hash;
use base qw/Redis Tie::StdHash/;


sub TIEHASH {
  my ($class, $prefix, @rest) = @_;
  my $self = $class->new(@rest);

  $self->{prefix} = $prefix ? "$prefix:" : '';

  return $self;
}

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

sub FETCH {
  my ($self, $key) = @_;
  $self->get($self->{prefix} . $key);
}

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

sub NEXTKEY {
  my $self = shift;

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

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

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

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

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


1;    ## End of Redis::Hash

__END__