lib/Redis/Hash.pm

package Redis::Hash;

use strict;
use warnings;

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

=head1 NAME

Redis::Hash - tie perl hashes into Redis

=head1 SYNOPSYS

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

=cut

# mandatory methods
sub TIEHASH {
        my ($class,$name) = @_;
        my $self = $class->new;
        $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} . '*') ];
        unshift @{ $self->{keys} };
} 

sub NEXTKEY {
        my $self = shift;
        unshift @{ $self->{keys} };
}

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} . '*' ) );
}

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			=head1 NAME
10
11			Redis::Hash - tie perl hashes into Redis
12
13			=head1 SYNOPSYS
14
15			tie %$name, 'Redis::Hash', 'name';
16
17			=cut
18
19			# mandatory methods
20			sub TIEHASH {
21			my ($class,$name) = @_;
22			my $self = $class->new;
23			$self->{name} = $name \|\| '';
24			bless $self => $class;
25			}
26
27			sub STORE {
28			my ($self,$key,$value) = @_;
29			$self->set( $self->{name} . $key, $value );
30			}
31
32			sub FETCH {
33			my ($self,$key) = @_;
34			$self->get( $self->{name} . $key );
35			}
36
37			sub FIRSTKEY {
38			my $self = shift;
39			$self->{keys} = [ $self->keys( $self->{name} . '*') ];
40			unshift @{ $self->{keys} };
41			}
42
43			sub NEXTKEY {
44			my $self = shift;
45			unshift @{ $self->{keys} };
46			}
47
48			sub EXISTS {
49			my ($self,$key) = @_;
50			$self->exists( $self->{name} . $key );
51			}
52
53			sub DELETE {
54			my ($self,$key) = @_;
55			$self->del( $self->{name} . $key );
56			}
57
58			sub CLEAR {
59			my ($self) = @_;
60			$self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
61			}
62
63			1;