File Coverage

blib/lib/Metabrik/Client/Redis.pm
Criterion Covered Total %
statement 9 101 8.9
branch 0 54 0.0
condition 0 8 0.0
subroutine 3 25 12.0
pod 1 21 4.7
total 13 209 6.2


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # client::redis Brik
5             #
6             package Metabrik::Client::Redis;
7 1     1   840 use strict;
  1         2  
  1         29  
8 1     1   6 use warnings;
  1         3  
  1         28  
9              
10 1     1   6 use base qw(Metabrik::System::Service Metabrik::System::Package);
  1         2  
  1         516  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             server => [ qw(ip_address) ],
20             port => [ qw(port) ],
21             _redis => [ ],
22             },
23             attributes_default => {
24             server => '127.0.0.1',
25             port => 6379,
26             },
27             commands => {
28             install => [ ], # Inherited
29             start => [ ], # Inherited
30             stop => [ ], # Inherited
31             status => [ ], # Inherited
32             connect => [ ],
33             command => [ qw(command $arg1 $arg2 ... $argN) ],
34             command_as_list => [ qw(command $arg1 $arg2 ... $argN) ],
35             time => [ ],
36             disconnect => [ ],
37             quit => [ ], # Same as disconnect
38             dbsize => [ ],
39             exists => [ qw(key) ],
40             get => [ qw(key) ],
41             set => [ qw(key value) ],
42             del => [ qw(key) ],
43             mget => [ qw($key_list) ],
44             hset => [ qw(key $hash) ],
45             hget => [ qw(key hash_field) ],
46             hgetall => [ qw(key) ],
47             client_list => [ ],
48             client_getname => [ ],
49             list_databases => [ qw(database) ],
50             list_keys => [ qw(database keys|OPTIONAL) ],
51             flushall => [ ],
52             },
53             require_modules => {
54             'Redis' => [ ],
55             },
56             need_packages => {
57             ubuntu => [ qw(redis-server) ],
58             debian => [ qw(redis-server) ],
59             kali => [ qw(redis-server) ],
60             },
61             need_services => {
62             ubuntu => [ qw(redis-server) ],
63             debian => [ qw(redis-server) ],
64             },
65             };
66             }
67              
68             sub connect {
69 0     0 0   my $self = shift;
70              
71 0 0 0       my $redis = Redis->new(
      0        
      0        
72             server => $self->server.':'.$self->port,
73             name => 'redis_connection',
74             cnx_timeout => defined($self->global) && $self->global->ctimeout || 3,
75             read_timeout => defined($self->global) && $self->global->rtimeout || 3,
76             write_timeout => defined($self->global) && $self->global->rtimeout || 3,
77             ) or return $self->log->error("connect: redis connection error");
78              
79 0           return $self->_redis($redis);
80             }
81              
82             sub _get_redis {
83 0     0     my $self = shift;
84              
85 0           my $redis = $self->_redis;
86 0 0         $self->brik_help_run_undef_arg('connect', $redis) or return;
87              
88 0           return $redis;
89             }
90              
91             #
92             # Command list: http://redis.io/commands
93             #
94             # Or 'run client::redis command command'
95             #
96             sub command {
97 0     0 0   my $self = shift;
98 0           my ($cmd, @args) = @_;
99              
100 0 0         my $redis = $self->_get_redis or return;
101              
102 0           my $r = $redis->$cmd(@args);
103 0 0         if (! defined($r)) {
104 0           return $self->log->error("command: $cmd failed");
105             }
106              
107 0           return $r;
108             }
109              
110             #
111             # Dump content from db10:
112             #
113             # run client::redis command select 10
114             # run client::redis command_as_list keys *
115             #
116             sub command_as_list {
117 0     0 0   my $self = shift;
118 0           my ($cmd, @args) = @_;
119              
120 0 0         my $redis = $self->_get_redis or return;
121              
122 0           my @r = $redis->$cmd(@args);
123              
124 0           return \@r;
125             }
126              
127             sub time {
128 0     0 0   my $self = shift;
129              
130 0           return $self->command('time');
131             }
132              
133             sub disconnect {
134 0     0 0   my $self = shift;
135              
136 0 0         my $r = $self->command('quit') or return;
137 0           $self->_redis(undef);
138              
139 0           return $r;
140             }
141              
142             sub quit {
143 0     0 0   my $self = shift;
144              
145 0           return $self->disconnect;
146             }
147              
148             sub dbsize {
149 0     0 0   my $self = shift;
150              
151 0           return $self->command('dbsize');
152             }
153              
154             sub exists {
155 0     0 0   my $self = shift;
156 0           my ($key) = @_;
157              
158 0 0         $self->brik_help_run_undef_arg('exists', $key) or return;
159              
160 0           return $self->command('exists', $key);
161             }
162              
163             sub get {
164 0     0 0   my $self = shift;
165 0           my ($key) = @_;
166              
167 0 0         $self->brik_help_run_undef_arg('get', $key) or return;
168              
169 0           return $self->command('get', $key);
170             }
171              
172             sub set {
173 0     0 0   my $self = shift;
174 0           my ($key, $value) = @_;
175              
176 0 0         $self->brik_help_run_undef_arg('set', $key) or return;
177 0 0         $self->brik_help_run_undef_arg('set', $value) or return;
178              
179 0           return $self->command('set', $key, $value);
180             }
181              
182             sub del {
183 0     0 0   my $self = shift;
184 0           my ($key) = @_;
185              
186 0 0         $self->brik_help_run_undef_arg('del', $key) or return;
187              
188 0           return $self->command('del', $key);
189             }
190              
191             sub mget {
192 0     0 0   my $self = shift;
193 0           my ($key_list) = @_;
194              
195 0 0         $self->brik_help_run_undef_arg('mget', $key_list) or return;
196 0 0         $self->brik_help_run_invalid_arg('mget', $key_list, 'ARRAY') or return;
197              
198 0           return $self->command('mget', @$key_list);
199             }
200              
201             sub hset {
202 0     0 0   my $self = shift;
203 0           my ($hashname, $hash) = @_;
204              
205 0 0         $self->brik_help_run_undef_arg('hset', $hashname) or return;
206 0 0         $self->brik_help_run_undef_arg('hset', $hash) or return;
207 0 0         $self->brik_help_run_invalid_arg('hset', $hash, 'HASH') or return;
208              
209 0 0         my $redis = $self->_get_redis or return;
210              
211 0           for (keys %$hash) {
212 0 0         $redis->hset($hashname, $_, $hash->{$_}) or next;
213             }
214              
215 0           $redis->wait_all_responses;
216              
217 0           return $hash;
218             }
219              
220             sub hget {
221 0     0 0   my $self = shift;
222 0           my ($hashname, $field) = @_;
223              
224 0 0         $self->brik_help_run_undef_arg('hget', $hashname) or return;
225 0 0         $self->brik_help_run_undef_arg('hget', $field) or return;
226              
227 0           return $self->command('hget', $hashname, $field);
228             }
229              
230             sub hgetall {
231 0     0 0   my $self = shift;
232 0           my ($hashname) = @_;
233              
234 0 0         $self->brik_help_run_undef_arg('hgetall', $hashname) or return;
235              
236 0 0         my $r = $self->command('hgetall', $hashname) or return;
237              
238 0           my %h = @{$r};
  0            
239              
240 0           return \%h;
241             }
242              
243             sub client_list {
244 0     0 0   my $self = shift;
245              
246 0 0         my $r = $self->command('client_list') or return;
247              
248 0           return [ split(/\n/, $r) ];
249             }
250              
251             sub client_getname {
252 0     0 0   my $self = shift;
253              
254 0 0         my $r = $self->command('client_getname') or return;
255              
256 0           return [ split(/\n/, $r) ];
257             }
258              
259             sub list_databases {
260 0     0 0   my $self = shift;
261              
262 0           return $self->command('info', 'keyspace');
263             }
264              
265             sub list_keys {
266 0     0 0   my $self = shift;
267 0           my ($database, $keys) = @_;
268              
269 0   0       $keys ||= '*';
270 0 0         $self->brik_help_run_undef_arg('list_keys', $database) or return;
271              
272 0 0         my $r = $self->command('select', $database) or return;
273 0           $self->log->info("list_keys: $r");
274              
275 0 0         my @r = $self->command_as_list('keys', $keys) or return;
276              
277 0           return \@r;
278             }
279              
280             sub flushall {
281 0     0 0   my $self = shift;
282              
283 0           return $self->command('flushall');
284             }
285              
286             1;
287              
288             __END__