/[Redis.pre-github]/lib/Redis/Hash.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /lib/Redis/Hash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 59 - (show annotations)
Wed Jun 17 16:49:17 2009 UTC (10 years, 1 month ago) by dpavlin
File size: 1249 byte(s)
document and test redis object for issuing normal commands
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;

  ViewVC Help
Powered by ViewVC 1.1.26