lib/Redis/Hash.pm

package Redis::Hash;

use strict;
use warnings;

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

use Data::Dump qw/dump/;

=head1 NAME

Redis::Hash - tie perl hashes into Redis

=head1 SYNOPSYS

  tie %name, 'Redis::Hash', 'prefix';

  my $o = tie %foobar, 'Redis::Hash', 'foobar';
  print $o->info->{used_memory}; # or any redis command

=cut

# mandatory methods
sub TIEHASH {
        my ($class,$name) = @_;
        my $self = Redis->new;
        $name .= ':' if $name;
        $self->{name} = $name || '';
        bless $self => $class;
}

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

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

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

sub NEXTKEY {
        my $self = shift;
        my $key = shift @{ $self->{keys} } || return;
        my $name = $self->{name};
        $key =~ s{^$name}{} || warn "can't strip $name from $key";
        return $key;
}

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

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

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

1;
1	dpavlin	42	package Redis::Hash;
2
3			use strict;
4			use warnings;
5
6			use Tie::Hash;
7			use base qw/Redis Tie::StdHash/;
8
9	dpavlin	43	use Data::Dump qw/dump/;
10
11	dpavlin	42	=head1 NAME
12
13			Redis::Hash - tie perl hashes into Redis
14
15			=head1 SYNOPSYS
16
17	dpavlin	43	tie %name, 'Redis::Hash', 'prefix';
18	dpavlin	42
19	dpavlin	59	my $o = tie %foobar, 'Redis::Hash', 'foobar';
20			print $o->info->{used_memory}; # or any redis command
21
22	dpavlin	42	=cut
23
24			# mandatory methods
25			sub TIEHASH {
26			my ($class,$name) = @_;
27	dpavlin	43	my $self = Redis->new;
28			$name .= ':' if $name;
29	dpavlin	42	$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	dpavlin	43	$self->{keys} = [ $self->keys( $self->{name} . '*' ) ];
46			$self->NEXTKEY;
47	dpavlin	42	}
48
49			sub NEXTKEY {
50			my $self = shift;
51	dpavlin	43	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	dpavlin	42	}
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	dpavlin	43	$self->{keys} = [];
71	dpavlin	42	}
72
73			1;