File Coverage

blib/lib/Redis/Fast/Hash.pm
Criterion Covered Total %
statement 6 32 18.7
branch 0 6 0.0
condition n/a
subroutine 2 10 20.0
pod n/a
total 8 48 16.6


line stmt bran cond sub pod time code
1             package Redis::Fast::Hash;
2              
3             # ABSTRACT: tie Perl hashes to Redis hashes
4             # VERSION
5             # AUTHORITY
6              
7 1     1   80377 use strict;
  1         13  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         546  
9             require Tie::Hash;
10             require Redis::Fast;
11             our @ISA = qw(Redis::Fast Tie::StdHash);
12              
13              
14             sub TIEHASH {
15 0     0     my ($class, $prefix, @rest) = @_;
16 0           my $self = $class->new(@rest);
17              
18 0           $self->__set_data({});
19 0 0         $self->__get_data->{prefix} = $prefix ? "$prefix:" : '';
20              
21 0           return $self;
22             }
23              
24             sub STORE {
25 0     0     my ($self, $key, $value) = @_;
26 0           $self->set($self->__get_data->{prefix} . $key, $value);
27             }
28              
29             sub FETCH {
30 0     0     my ($self, $key) = @_;
31 0           $self->get($self->__get_data->{prefix} . $key);
32             }
33              
34             sub FIRSTKEY {
35 0     0     my $self = shift;
36 0           $self->__get_data->{prefix_keys} = [$self->keys($self->__get_data->{prefix} . '*')];
37 0           $self->NEXTKEY;
38             }
39              
40             sub NEXTKEY {
41 0     0     my $self = shift;
42              
43 0           my $key = shift @{ $self->__get_data->{prefix_keys} };
  0            
44 0 0         return unless defined $key;
45              
46 0           my $p = $self->__get_data->{prefix};
47 0 0         $key =~ s/^$p// if $p;
48 0           return $key;
49             }
50              
51             sub EXISTS {
52 0     0     my ($self, $key) = @_;
53 0           $self->exists($self->__get_data->{prefix} . $key);
54             }
55              
56             sub DELETE {
57 0     0     my ($self, $key) = @_;
58 0           $self->del($self->__get_data->{prefix} . $key);
59             }
60              
61             sub CLEAR {
62 0     0     my ($self) = @_;
63 0           $self->del($_) for $self->keys($self->__get_data->{prefix} . '*');
64 0           $self->__get_data->{prefix_keys} = [];
65             }
66              
67              
68             1; ## End of Redis::Fast::Hash
69              
70             =head1 NAME
71              
72             Redis::Fast::Hash - tie Perl hashes to Redis hashes
73              
74             =head1 SYNOPSYS
75              
76             ## Create fake hash using keys like 'hash_prefix:KEY'
77             tie %my_hash, 'Redis::Fast::Hash', 'hash_prefix', @Redis_new_parameters;
78              
79             ## Treat the entire Redis database as a hash
80             tie %my_hash, 'Redis::Fast::Hash', undef, @Redis_new_parameters;
81              
82             $value = $my_hash{$key};
83             $my_hash{$key} = $value;
84              
85             @keys = keys %my_hash;
86             @values = values %my_hash;
87              
88             %my_hash = reverse %my_hash;
89              
90             %my_hash = ();
91              
92              
93             =head1 DESCRIPTION
94              
95             Ties a Perl hash to Redis::Fast. Note that it doesn't use Redis Hashes, but
96             implements a fake hash using regular keys like "prefix:KEY".
97              
98             If no C is given, it will tie the entire Redis database as a hash.
99              
100             Future versions will also allow you to use real Redis hash structures.
101              
102             =cut