lib/Redis/Hash.pm

   1 package Redis::Hash;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Tie::Hash;
   7 use base qw/Redis Tie::StdHash/;
   8
   9 =head1 NAME
  10
  11 Redis::Hash - tie perl hashes into Redis
  12
  13 =head1 SYNOPSYS
  14
  15   tie %name, 'Redis::Hash', 'prefix';
  16
  17   my $o = tie %foobar, 'Redis::Hash', 'foobar';
  18   print $o->info->{used_memory}; # or any redis command
  19
  20 =cut
  21
  22 # mandatory methods
  23 sub TIEHASH {
  24         my ($class,$name) = @_;
  25         my $self = Redis->new;
  26         $name .= ':' if $name;
  27         $self->{name} = $name || '';
  28         bless $self => $class;
  29 }
  30
  31 sub STORE {
  32         my ($self,$key,$value) = @_;
  33         $self->set( $self->{name} . $key, $value );
  34 }
  35
  36 sub FETCH {
  37         my ($self,$key) = @_;
  38         $self->get( $self->{name} . $key );
  39 }
  40
  41 sub FIRSTKEY {
  42         my $self = shift;
  43         $self->{keys} = [ $self->keys( $self->{name} . '*' ) ];
  44         $self->NEXTKEY;
  45 }
  46
  47 sub NEXTKEY {
  48         my $self = shift;
  49         my $key = shift @{ $self->{keys} } || return;
  50         my $name = $self->{name};
  51         $key =~ s{^$name}{} || warn "can't strip $name from $key";
  52         return $key;
  53 }
  54
  55 sub EXISTS {
  56         my ($self,$key) = @_;
  57         $self->exists( $self->{name} . $key );
  58 }
  59
  60 sub DELETE {
  61         my ($self,$key) = @_;
  62         $self->del( $self->{name} . $key );
  63 }
  64
  65 sub CLEAR {
  66         my ($self) = @_;
  67         $self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
  68         $self->{keys} = [];
  69 }
  70
  71 1;