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';

=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	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	=cut
20
21	# mandatory methods
22	sub TIEHASH {
23	my ($class,$name) = @_;
24	my $self = Redis->new;
25	$name .= ':' if $name;
26	$self->{name} = $name \|\| '';
27	bless $self => $class;
28	}
29
30	sub STORE {
31	my ($self,$key,$value) = @_;
32	$self->set( $self->{name} . $key, $value );
33	}
34
35	sub FETCH {
36	my ($self,$key) = @_;
37	$self->get( $self->{name} . $key );
38	}
39
40	sub FIRSTKEY {
41	my $self = shift;
42	$self->{keys} = [ $self->keys( $self->{name} . '*' ) ];
43	$self->NEXTKEY;
44	}
45
46	sub NEXTKEY {
47	my $self = shift;
48	my $key = shift @{ $self->{keys} } \|\| return;
49	my $name = $self->{name};
50	$key =~ s{^$name}{} \|\| warn "can't strip $name from $key";
51	return $key;
52	}
53
54	sub EXISTS {
55	my ($self,$key) = @_;
56	$self->exists( $self->{name} . $key );
57	}
58
59	sub DELETE {
60	my ($self,$key) = @_;
61	$self->del( $self->{name} . $key );
62	}
63
64	sub CLEAR {
65	my ($self) = @_;
66	$self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
67	$self->{keys} = [];
68	}
69
70	1;