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