File Coverage

blib/lib/Tie/Hash/RedisDB.pm
Criterion Covered Total %
statement 21 56 37.5
branch 0 10 0.0
condition 0 10 0.0
subroutine 7 18 38.8
pod 0 1 0.0
total 28 95 29.4


line stmt bran cond sub pod time code
1             package Tie::Hash::RedisDB;
2              
3 1     1   237820 use strict;
  1         5  
  1         30  
4 1     1   8 use warnings;
  1         1  
  1         55  
5             our $VERSION = '1.02';
6              
7 1     1   6 use Carp qw(croak);
  1         2  
  1         43  
8 1     1   625 use JSON;
  1         9732  
  1         5  
9 1     1   188 use Scalar::Util qw(reftype);
  1         2  
  1         46  
10 1     1   16 use RedisDB;
  1         3  
  1         25  
11 1     1   6 use Try::Tiny;
  1         2  
  1         518  
12              
13             my $json = JSON->new->utf8->allow_nonref;
14              
15             sub TIEHASH {
16 0     0     my ($self, $addr, $args) = @_;
17              
18             # Don't want to be crazy strict, but at least something which implies they know how this works.
19 0           my $whatsit = reftype $args;
20              
21 0 0         croak 'Must supply a lookup element' unless defined $addr;
22 0 0 0       croak 'Arguments must be supplied as a hash reference.'
23             unless ($whatsit // '') eq 'HASH';
24              
25             # All easy server definition for Cache::RedisDB users
26 0   0       my $ruri = $args->{redis_uri} // $ENV{REDIS_CACHE_SERVER};
27 0 0         croak 'Must supply a redis_redis' unless $ruri;
28              
29             my $node = {
30             EXP_SECONDS => $args->{expiry},
31             DEL_ON_UNTIE => 0,
32 0   0       WHERE => join(chr(2), ($args->{namespace} // "THRDB"), $addr),
33             REDIS => RedisDB->new(url => $ruri),
34             };
35              
36 0           return bless $node, $self;
37              
38             }
39              
40             sub FETCH {
41 0     0     my ($self, $key) = @_;
42              
43 0           my $val = $self->{REDIS}->hget($self->{WHERE}, $key);
44              
45 0   0       return $val && $json->decode($val);
46             }
47              
48             sub STORE {
49 0     0     my ($self, $key, $val) = @_;
50              
51 0           my $redis = $self->{REDIS};
52              
53 0           $redis->hset($self->{WHERE}, $key, $json->encode($val));
54 0 0         if (my $expiry = $self->{EXP_SECONDS}) {
55 0           $redis->expire($self->{WHERE}, $expiry);
56             }
57              
58 0           return 1;
59             }
60              
61             sub DELETE {
62 0     0     my ($self, $key) = @_;
63              
64 0           return $self->{REDIS}->hdel($self->{WHERE}, $key);
65             }
66              
67             sub CLEAR {
68 0     0     my ($self) = @_;
69              
70 0           return $self->{REDIS}->del($self->{WHERE});
71             }
72              
73             sub EXISTS {
74 0     0     my ($self, $key) = @_;
75              
76 0           return $self->{REDIS}->hexists($self->{WHERE}, $key);
77             }
78              
79             sub FIRSTKEY {
80 0     0     my ($self) = @_;
81              
82 0           $self->{_keys} = $self->{REDIS}->hkeys($self->{WHERE});
83              
84 0           return $self->NEXTKEY;
85             }
86              
87             sub NEXTKEY {
88 0     0     my ($self) = @_;
89              
90 0           return shift @{$self->{_keys}};
  0            
91             }
92              
93             sub UNTIE {
94 0     0     my ($self) = @_;
95              
96 0 0         return $self->{DEL_ON_UNTIE} ? $self->CLEAR : 1;
97             }
98              
99             sub DESTROY {
100 0     0     my ($self) = @_;
101              
102 0           return $self->UNTIE;
103             }
104              
105             sub delete {
106 0     0 0   my ($self) = @_;
107              
108 0           return $self->{DEL_ON_UNTIE} = 1;
109             }
110              
111             1;
112             __END__