line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Redis::Namespace; |
2
|
|
|
|
|
|
|
|
3
|
21
|
|
|
21
|
|
3302963
|
use strict; |
|
21
|
|
|
|
|
209
|
|
|
21
|
|
|
|
|
627
|
|
4
|
21
|
|
|
21
|
|
109
|
use warnings; |
|
21
|
|
|
|
|
42
|
|
|
21
|
|
|
|
|
833
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.13'; |
6
|
|
|
|
|
|
|
|
7
|
21
|
|
|
21
|
|
2206
|
use Redis; |
|
21
|
|
|
|
|
147256
|
|
|
21
|
|
|
|
|
587
|
|
8
|
21
|
|
|
21
|
|
119
|
use Carp qw(carp croak); |
|
21
|
|
|
|
|
39
|
|
|
21
|
|
|
|
|
96577
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our %BEFORE_FILTERS = ( |
11
|
|
|
|
|
|
|
# do nothing |
12
|
|
|
|
|
|
|
none => sub { |
13
|
|
|
|
|
|
|
my ($self, @args) = @_; |
14
|
|
|
|
|
|
|
return @args; |
15
|
|
|
|
|
|
|
}, |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# GET key => GET namespace:key |
18
|
|
|
|
|
|
|
first => sub { |
19
|
|
|
|
|
|
|
my ($self, @args) = @_; |
20
|
|
|
|
|
|
|
if(@args) { |
21
|
|
|
|
|
|
|
my $first = shift @args; |
22
|
|
|
|
|
|
|
return ($self->add_namespace($first), @args); |
23
|
|
|
|
|
|
|
} else { |
24
|
|
|
|
|
|
|
return @args; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
}, |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# MGET key1 key2 => MGET namespace:key1 namespace:key2 |
29
|
|
|
|
|
|
|
all => sub { |
30
|
|
|
|
|
|
|
my ($self, @args) = @_; |
31
|
|
|
|
|
|
|
return $self->add_namespace(@args); |
32
|
|
|
|
|
|
|
}, |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
exclude_first => sub { |
35
|
|
|
|
|
|
|
my ($self, @args) = @_; |
36
|
|
|
|
|
|
|
if(@args) { |
37
|
|
|
|
|
|
|
my $first = shift @args; |
38
|
|
|
|
|
|
|
return ( |
39
|
|
|
|
|
|
|
$first, |
40
|
|
|
|
|
|
|
$self->add_namespace(@args), |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
} else { |
43
|
|
|
|
|
|
|
return @args; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
}, |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# BLPOP key1 key2 timeout => BLPOP namespace:key1 namespace:key2 timeout |
48
|
|
|
|
|
|
|
exclude_last => sub { |
49
|
|
|
|
|
|
|
my ($self, @args) = @_; |
50
|
|
|
|
|
|
|
if(@args) { |
51
|
|
|
|
|
|
|
my $last = pop @args; |
52
|
|
|
|
|
|
|
return ( |
53
|
|
|
|
|
|
|
$self->add_namespace(@args), |
54
|
|
|
|
|
|
|
$last |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
} else { |
57
|
|
|
|
|
|
|
return @args; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
}, |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# MSET key1 value1 key2 value2 => MSET namespace:key1 value1 namespace:key2 value2 |
62
|
|
|
|
|
|
|
alternate => sub { |
63
|
|
|
|
|
|
|
my ($self, @args) = @_; |
64
|
|
|
|
|
|
|
my @result; |
65
|
|
|
|
|
|
|
for my $i(0..@args-1) { |
66
|
|
|
|
|
|
|
if($i % 2 == 0) { |
67
|
|
|
|
|
|
|
push @result, $self->add_namespace($args[$i]); |
68
|
|
|
|
|
|
|
} else { |
69
|
|
|
|
|
|
|
push @result, $args[$i]; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
return @result; |
73
|
|
|
|
|
|
|
}, |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
keys => sub { |
76
|
|
|
|
|
|
|
my ($self, $pattern) = @_; |
77
|
|
|
|
|
|
|
return unless defined $pattern; |
78
|
|
|
|
|
|
|
my $namespace = $self->{namespace_escaped}; |
79
|
|
|
|
|
|
|
return "$namespace:$pattern"; |
80
|
|
|
|
|
|
|
}, |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sort => sub { |
83
|
|
|
|
|
|
|
my ($self, @args) = @_; |
84
|
|
|
|
|
|
|
my @res; |
85
|
|
|
|
|
|
|
if(@args) { |
86
|
|
|
|
|
|
|
my $first = shift @args; |
87
|
|
|
|
|
|
|
push @res, $self->add_namespace($first); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
while(@args) { |
90
|
|
|
|
|
|
|
my $option = lc shift @args; |
91
|
|
|
|
|
|
|
if($option eq 'limit') { |
92
|
|
|
|
|
|
|
my $start = shift @args; |
93
|
|
|
|
|
|
|
my $count = shift @args; |
94
|
|
|
|
|
|
|
push @res, $option, $start, $count; |
95
|
|
|
|
|
|
|
} elsif($option eq 'by' || $option eq 'store') { |
96
|
|
|
|
|
|
|
my $key = shift @args; |
97
|
|
|
|
|
|
|
push @res, $option, $self->add_namespace($key); |
98
|
|
|
|
|
|
|
} elsif($option eq 'get') { |
99
|
|
|
|
|
|
|
my $key = shift @args; |
100
|
|
|
|
|
|
|
($key) = $self->add_namespace($key) unless $key eq '#'; |
101
|
|
|
|
|
|
|
push @res, $option, $key; |
102
|
|
|
|
|
|
|
} else { |
103
|
|
|
|
|
|
|
push @res, $option; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
return @res; |
107
|
|
|
|
|
|
|
}, |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# EVAL script 2 key1 key2 arg1 arg2 => EVAL script 2 ns:key1 ns:key2 arg1 arg2 |
110
|
|
|
|
|
|
|
eval_style => sub { |
111
|
|
|
|
|
|
|
my ($self, $script, $number, @args) = @_; |
112
|
|
|
|
|
|
|
my @keys = $self->add_namespace(splice @args, 0, $number); |
113
|
|
|
|
|
|
|
return ($script, $number, @keys, @args); |
114
|
|
|
|
|
|
|
}, |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# ZINTERSTORE key0 2 key1 key2 SOME_OPTIONS => ZINTERSTORE ns:key0 2 ns:key1 ns:key2 |
117
|
|
|
|
|
|
|
exclude_options => sub { |
118
|
|
|
|
|
|
|
my ($self, $first, $number, @args) = @_; |
119
|
|
|
|
|
|
|
my @keys = $self->add_namespace(splice @args, 0, $number); |
120
|
|
|
|
|
|
|
return ($self->add_namespace($first), $number, @keys, @args); |
121
|
|
|
|
|
|
|
}, |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
scan => sub { |
125
|
|
|
|
|
|
|
my ($self, @args) = @_; |
126
|
|
|
|
|
|
|
my @res; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
my $namespace = $self->{namespace_escaped}; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# first arg is iteration key |
131
|
|
|
|
|
|
|
if(@args) { |
132
|
|
|
|
|
|
|
my $first = shift @args; |
133
|
|
|
|
|
|
|
push @res, $first; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# parse options |
137
|
|
|
|
|
|
|
my $has_pattern = 0; |
138
|
|
|
|
|
|
|
while(@args) { |
139
|
|
|
|
|
|
|
my $option = lc shift @args; |
140
|
|
|
|
|
|
|
if($option eq 'match') { |
141
|
|
|
|
|
|
|
my $pattern = shift @args; |
142
|
|
|
|
|
|
|
push @res, $option, "$namespace:$pattern"; |
143
|
|
|
|
|
|
|
$has_pattern = 1; |
144
|
|
|
|
|
|
|
} elsif($option eq 'count') { |
145
|
|
|
|
|
|
|
my $count = shift @args; |
146
|
|
|
|
|
|
|
push @res, $option, $count; |
147
|
|
|
|
|
|
|
} else { |
148
|
|
|
|
|
|
|
push @res, $option; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# add pattern option |
153
|
|
|
|
|
|
|
unless($has_pattern) { |
154
|
|
|
|
|
|
|
push @res, 'match', "$namespace:*"; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
return @res; |
158
|
|
|
|
|
|
|
}, |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# MIGRATE host port key destination-db timeout => MIGRATE host port namespace:key destination-db timeout |
161
|
|
|
|
|
|
|
# MIGRATE host port "" destination-db timeout KEYS => MIGRATE host port namespace:key destination-db timeout |
162
|
|
|
|
|
|
|
migrate => sub { |
163
|
|
|
|
|
|
|
my ($self, @args) = @_; |
164
|
|
|
|
|
|
|
my @res = splice @args, 0, 5; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# key may be the empty string in Redis-3.2 and above |
167
|
|
|
|
|
|
|
if(scalar @res >= 3 && $res[2] ne '') { |
168
|
|
|
|
|
|
|
($res[2]) = $self->add_namespace($res[2]); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
while(@args) { |
172
|
|
|
|
|
|
|
my $option = lc shift @args; |
173
|
|
|
|
|
|
|
if($option eq 'keys') { |
174
|
|
|
|
|
|
|
push @res, $option, $self->add_namespace(@args); |
175
|
|
|
|
|
|
|
@args = (); |
176
|
|
|
|
|
|
|
} else { |
177
|
|
|
|
|
|
|
push @res, $option; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
return @res; |
181
|
|
|
|
|
|
|
}, |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# GEORADIUS key longitude latitude radius m|km|ft|mi STORE key STOREDIST key => GEORADIUS namespace:key longitude latitude radius m|km|ft|mi STORE namespace:key STOREDIST namespace:key |
184
|
|
|
|
|
|
|
georadius => sub { |
185
|
|
|
|
|
|
|
my ($self, @args) = @_; |
186
|
|
|
|
|
|
|
my @res; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# key |
189
|
|
|
|
|
|
|
if(@args) { |
190
|
|
|
|
|
|
|
my $first = shift @args; |
191
|
|
|
|
|
|
|
push @res, $self->add_namespace($first); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# longitude latitude radius m|km|ft|mi |
195
|
|
|
|
|
|
|
push @res, splice @args, 0, 4; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
while(@args) { |
198
|
|
|
|
|
|
|
my $option = lc shift @args; |
199
|
|
|
|
|
|
|
if($option eq 'store' || $option eq 'storedist') { |
200
|
|
|
|
|
|
|
my $key = shift @args; |
201
|
|
|
|
|
|
|
push @res, $option, $self->add_namespace($key); |
202
|
|
|
|
|
|
|
} elsif($option eq 'count') { |
203
|
|
|
|
|
|
|
my $count = shift @args; |
204
|
|
|
|
|
|
|
push @res, $option, $count; |
205
|
|
|
|
|
|
|
} else { |
206
|
|
|
|
|
|
|
push @res, $option; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
return @res; |
210
|
|
|
|
|
|
|
}, |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# GEORADIUSBYMEMBER key member radius m|km|ft|mi STORE key STOREDIST key => GEORADIUSBYMEMBER namespace:key member radius m|km|ft|mi STORE namespace:key STOREDIST namespace:key |
213
|
|
|
|
|
|
|
georadiusbymember => sub { |
214
|
|
|
|
|
|
|
my ($self, @args) = @_; |
215
|
|
|
|
|
|
|
my @res; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# key |
218
|
|
|
|
|
|
|
if(@args) { |
219
|
|
|
|
|
|
|
my $first = shift @args; |
220
|
|
|
|
|
|
|
push @res, $self->add_namespace($first); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# member radius m|km|ft|mi |
224
|
|
|
|
|
|
|
push @res, splice @args, 0, 3; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
while(@args) { |
227
|
|
|
|
|
|
|
my $option = lc shift @args; |
228
|
|
|
|
|
|
|
if($option eq 'store' || $option eq 'storedist') { |
229
|
|
|
|
|
|
|
my $key = shift @args; |
230
|
|
|
|
|
|
|
push @res, $option, $self->add_namespace($key); |
231
|
|
|
|
|
|
|
} elsif($option eq 'count') { |
232
|
|
|
|
|
|
|
my $count = shift @args; |
233
|
|
|
|
|
|
|
push @res, $option, $count; |
234
|
|
|
|
|
|
|
} else { |
235
|
|
|
|
|
|
|
push @res, $option; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
return @res; |
239
|
|
|
|
|
|
|
}, |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# XREAD [COUNT count] [BLOCK milliseconds] STREAMS key [key ...] ID [ID ...] |
242
|
|
|
|
|
|
|
# => XREAD [COUNT count] [BLOCK milliseconds] STREAMS namespace:key [namespace:key ...] ID [ID ...] |
243
|
|
|
|
|
|
|
xread => sub { |
244
|
|
|
|
|
|
|
my ($self, @args) = @_; |
245
|
|
|
|
|
|
|
my @res; |
246
|
|
|
|
|
|
|
while(@args) { |
247
|
|
|
|
|
|
|
my $option = lc shift @args; |
248
|
|
|
|
|
|
|
if($option eq 'count' || $option eq 'block') { |
249
|
|
|
|
|
|
|
my $count = shift @args; |
250
|
|
|
|
|
|
|
push @res, $option, $count; |
251
|
|
|
|
|
|
|
} elsif ($option eq 'streams') { |
252
|
|
|
|
|
|
|
my $num = scalar(@args) / 2; |
253
|
|
|
|
|
|
|
push @res, $option, $self->add_namespace(@args[0..$num-1]), @args[$num..2*$num-1]; |
254
|
|
|
|
|
|
|
@args = (); |
255
|
|
|
|
|
|
|
} else { |
256
|
|
|
|
|
|
|
push @res, $option; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
return @res; |
260
|
|
|
|
|
|
|
}, |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# XREADGROUP GROUP group consumer [COUNT count] [BLOCK milliseconds] [NOACK] STREAMS key [key ...] ID [ID ...] |
263
|
|
|
|
|
|
|
# => XREADGROUP GROUP group consumer [COUNT count] [BLOCK milliseconds] [NOACK] STREAMS namespace:key [namespace:key ...] ID [ID ...] |
264
|
|
|
|
|
|
|
xreadgroup => sub { |
265
|
|
|
|
|
|
|
my ($self, @args) = @_; |
266
|
|
|
|
|
|
|
my @res; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# GROUP group consumer |
269
|
|
|
|
|
|
|
push @res, splice @args, 0, 3; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
while(@args) { |
272
|
|
|
|
|
|
|
my $option = lc shift @args; |
273
|
|
|
|
|
|
|
if($option eq 'count' || $option eq 'block') { |
274
|
|
|
|
|
|
|
my $count = shift @args; |
275
|
|
|
|
|
|
|
push @res, $option, $count; |
276
|
|
|
|
|
|
|
} elsif ($option eq 'noack') { |
277
|
|
|
|
|
|
|
push @res, $option; |
278
|
|
|
|
|
|
|
} elsif ($option eq 'streams') { |
279
|
|
|
|
|
|
|
my $num = scalar(@args) / 2; |
280
|
|
|
|
|
|
|
push @res, $option, $self->add_namespace(@args[0..$num-1]), @args[$num..2*$num-1]; |
281
|
|
|
|
|
|
|
@args = (); |
282
|
|
|
|
|
|
|
} else { |
283
|
|
|
|
|
|
|
push @res, $option; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
return @res; |
287
|
|
|
|
|
|
|
}, |
288
|
|
|
|
|
|
|
); |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
our %AFTER_FILTERS = ( |
291
|
|
|
|
|
|
|
# do nothing |
292
|
|
|
|
|
|
|
none => sub { |
293
|
|
|
|
|
|
|
my ($self, @args) = @_; |
294
|
|
|
|
|
|
|
return @args; |
295
|
|
|
|
|
|
|
}, |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# namespace:key1 namespace:key2 => key1 key2 |
298
|
|
|
|
|
|
|
all => sub { |
299
|
|
|
|
|
|
|
my ($self, @args) = @_; |
300
|
|
|
|
|
|
|
return $self->rem_namespace(@args); |
301
|
|
|
|
|
|
|
}, |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# namespace:key1 value => key1 value |
304
|
|
|
|
|
|
|
first => sub { |
305
|
|
|
|
|
|
|
my ($self, $first, @args) = @_; |
306
|
|
|
|
|
|
|
return ($self->rem_namespace($first), @args); |
307
|
|
|
|
|
|
|
}, |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
scan => sub { |
310
|
|
|
|
|
|
|
my ($self, $iter, $list) = @_; |
311
|
|
|
|
|
|
|
my @keys = map { $self->rem_namespace($_) } @$list; |
312
|
|
|
|
|
|
|
return ($iter, \@keys); |
313
|
|
|
|
|
|
|
}, |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# [ [ namespace:key1, [...] ], [ namespace:key2, [...] ] => [ [ key1, [...] ], [ key2, [...] ] |
316
|
|
|
|
|
|
|
xread => sub { |
317
|
|
|
|
|
|
|
my ($self, @args) = @_; |
318
|
|
|
|
|
|
|
return map { |
319
|
|
|
|
|
|
|
if ($_) { |
320
|
|
|
|
|
|
|
my ($key, @rest) = @$_; |
321
|
|
|
|
|
|
|
[$self->rem_namespace($key), @rest]; |
322
|
|
|
|
|
|
|
} else { |
323
|
|
|
|
|
|
|
$_; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} @args; |
326
|
|
|
|
|
|
|
}, |
327
|
|
|
|
|
|
|
); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
sub add_namespace { |
330
|
20
|
|
|
20
|
0
|
74
|
my ($self, @args) = @_; |
331
|
20
|
|
|
|
|
32
|
my $namespace = $self->{namespace}; |
332
|
20
|
50
|
|
|
|
40
|
return @args unless $namespace; |
333
|
|
|
|
|
|
|
|
334
|
20
|
|
|
|
|
30
|
my @result; |
335
|
20
|
|
|
|
|
30
|
for my $item(@args) { |
336
|
32
|
|
|
|
|
47
|
my $type = ref $item; |
337
|
32
|
100
|
66
|
|
|
125
|
if($item && !$type) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
338
|
16
|
|
|
|
|
39
|
push @result, "$namespace:$item"; |
339
|
|
|
|
|
|
|
} elsif($type eq 'SCALAR') { |
340
|
4
|
|
|
|
|
15
|
push @result, \"$namespace:$$item"; |
341
|
|
|
|
|
|
|
} elsif($type eq 'ARRAY') { |
342
|
4
|
|
|
|
|
13
|
push @result, [$self->add_namespace(@$item)]; |
343
|
|
|
|
|
|
|
} elsif($type eq 'HASH') { |
344
|
4
|
|
|
|
|
6
|
my %hash; |
345
|
4
|
|
|
|
|
16
|
while (my ($key, $value) = each %$item) { |
346
|
6
|
|
|
|
|
11
|
my ($new_key) = $self->add_namespace($key); |
347
|
6
|
|
|
|
|
24
|
$hash{$new_key} = $value; |
348
|
|
|
|
|
|
|
} |
349
|
4
|
|
|
|
|
9
|
push @result, \%hash; |
350
|
|
|
|
|
|
|
} else { |
351
|
4
|
|
|
|
|
8
|
push @result, $item; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
20
|
|
|
|
|
84
|
return @result; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub rem_namespace { |
358
|
20
|
|
|
20
|
0
|
79
|
my ($self, @args) = @_; |
359
|
20
|
|
|
|
|
32
|
my $namespace = $self->{namespace}; |
360
|
20
|
50
|
|
|
|
43
|
return @args unless $namespace; |
361
|
|
|
|
|
|
|
|
362
|
20
|
|
|
|
|
25
|
my @result; |
363
|
20
|
|
|
|
|
34
|
for my $item(@args) { |
364
|
32
|
|
|
|
|
56
|
my $type = ref $item; |
365
|
32
|
100
|
66
|
|
|
135
|
if($item && !$type) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
366
|
16
|
|
|
|
|
98
|
$item =~ s/^\Q$namespace://; |
367
|
16
|
|
|
|
|
46
|
push @result, $item; |
368
|
|
|
|
|
|
|
} elsif($type eq 'SCALAR') { |
369
|
4
|
|
|
|
|
9
|
my $tmp = $$item; |
370
|
4
|
|
|
|
|
38
|
$tmp =~ s/^\Q$namespace://; |
371
|
4
|
|
|
|
|
13
|
push @result, \$tmp; |
372
|
|
|
|
|
|
|
} elsif($type eq 'ARRAY') { |
373
|
4
|
|
|
|
|
37
|
push @result, [$self->rem_namespace(@$item)]; |
374
|
|
|
|
|
|
|
} elsif($type eq 'HASH') { |
375
|
4
|
|
|
|
|
6
|
my %hash; |
376
|
4
|
|
|
|
|
16
|
while (my ($key, $value) = each %$item) { |
377
|
6
|
|
|
|
|
21
|
my ($new_key) = $self->rem_namespace($key); |
378
|
6
|
|
|
|
|
26
|
$hash{$new_key} = $value; |
379
|
|
|
|
|
|
|
} |
380
|
4
|
|
|
|
|
10
|
push @result, \%hash; |
381
|
|
|
|
|
|
|
} else { |
382
|
4
|
|
|
|
|
9
|
push @result, $item; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} |
385
|
20
|
|
|
|
|
101
|
return @result; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# %UNSAFE_COMMANDS may break other namepace and/or change the state of redis-server. |
389
|
|
|
|
|
|
|
# these commands are disable in strict mode. |
390
|
|
|
|
|
|
|
our %UNSAFE_COMMANDS = ( |
391
|
|
|
|
|
|
|
cluster => 1, |
392
|
|
|
|
|
|
|
config => 1, |
393
|
|
|
|
|
|
|
flushall => 1, |
394
|
|
|
|
|
|
|
flushdb => 1, |
395
|
|
|
|
|
|
|
readonly => 1, |
396
|
|
|
|
|
|
|
readwrite => 1, |
397
|
|
|
|
|
|
|
replicaof => 1, |
398
|
|
|
|
|
|
|
slaveof => 1, |
399
|
|
|
|
|
|
|
shutdown => 1, |
400
|
|
|
|
|
|
|
); |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
our %COMMANDS = ( |
403
|
|
|
|
|
|
|
append => [ 'first' ], |
404
|
|
|
|
|
|
|
auth => [], |
405
|
|
|
|
|
|
|
bgrewriteaof => [], |
406
|
|
|
|
|
|
|
bgsave => [], |
407
|
|
|
|
|
|
|
bitcount => [ 'first' ], |
408
|
|
|
|
|
|
|
bitfield => [ 'first' ], |
409
|
|
|
|
|
|
|
bitpos => [ 'first' ], |
410
|
|
|
|
|
|
|
bitop => [ 'exclude_first' ], |
411
|
|
|
|
|
|
|
blpop => [ 'exclude_last', 'first' ], |
412
|
|
|
|
|
|
|
brpop => [ 'exclude_last', 'first' ], |
413
|
|
|
|
|
|
|
brpoplpush => [ 'exclude_last' ], |
414
|
|
|
|
|
|
|
bzpopmax => [ 'exclude_last', 'first' ], |
415
|
|
|
|
|
|
|
bzpopmin => [ 'exclude_last', 'first' ], |
416
|
|
|
|
|
|
|
client => [], |
417
|
|
|
|
|
|
|
cluster => [], |
418
|
|
|
|
|
|
|
command => [], |
419
|
|
|
|
|
|
|
config => [], |
420
|
|
|
|
|
|
|
dbsize => [], |
421
|
|
|
|
|
|
|
debug => [ 'exclude_first' ], |
422
|
|
|
|
|
|
|
decr => [ 'first' ], |
423
|
|
|
|
|
|
|
decrby => [ 'first' ], |
424
|
|
|
|
|
|
|
del => [ 'all' ], |
425
|
|
|
|
|
|
|
discard => [], |
426
|
|
|
|
|
|
|
dump => [ 'first' ], |
427
|
|
|
|
|
|
|
echo => [], |
428
|
|
|
|
|
|
|
exists => [ 'first' ], |
429
|
|
|
|
|
|
|
expire => [ 'first' ], |
430
|
|
|
|
|
|
|
expireat => [ 'first' ], |
431
|
|
|
|
|
|
|
eval => [ 'eval_style' ], |
432
|
|
|
|
|
|
|
evalsha => [ 'eval_style' ], |
433
|
|
|
|
|
|
|
exec => [], |
434
|
|
|
|
|
|
|
flushall => [], |
435
|
|
|
|
|
|
|
flushdb => [], |
436
|
|
|
|
|
|
|
geoadd => [ 'first' ], |
437
|
|
|
|
|
|
|
geodist => [ 'first' ], |
438
|
|
|
|
|
|
|
geohash => [ 'first' ], |
439
|
|
|
|
|
|
|
geopos => [ 'first' ], |
440
|
|
|
|
|
|
|
georadius => [ 'georadius' ], |
441
|
|
|
|
|
|
|
georadiusbymember=> [ 'georadiusbymember' ], |
442
|
|
|
|
|
|
|
get => [ 'first' ], |
443
|
|
|
|
|
|
|
getbit => [ 'first' ], |
444
|
|
|
|
|
|
|
getrange => [ 'first' ], |
445
|
|
|
|
|
|
|
getset => [ 'first' ], |
446
|
|
|
|
|
|
|
hscan => [ 'first' ], |
447
|
|
|
|
|
|
|
hset => [ 'first' ], |
448
|
|
|
|
|
|
|
hsetnx => [ 'first' ], |
449
|
|
|
|
|
|
|
hstrlen => [ 'first' ], |
450
|
|
|
|
|
|
|
hget => [ 'first' ], |
451
|
|
|
|
|
|
|
hincrby => [ 'first' ], |
452
|
|
|
|
|
|
|
hincrbyfloat => [ 'first' ], |
453
|
|
|
|
|
|
|
hmget => [ 'first' ], |
454
|
|
|
|
|
|
|
hmset => [ 'first' ], |
455
|
|
|
|
|
|
|
hdel => [ 'first' ], |
456
|
|
|
|
|
|
|
hexists => [ 'first' ], |
457
|
|
|
|
|
|
|
hlen => [ 'first' ], |
458
|
|
|
|
|
|
|
hkeys => [ 'first' ], |
459
|
|
|
|
|
|
|
hvals => [ 'first' ], |
460
|
|
|
|
|
|
|
hgetall => [ 'first' ], |
461
|
|
|
|
|
|
|
incr => [ 'first' ], |
462
|
|
|
|
|
|
|
incrby => [ 'first' ], |
463
|
|
|
|
|
|
|
incrbyfloat => [ 'first' ], |
464
|
|
|
|
|
|
|
info => [], |
465
|
|
|
|
|
|
|
keys => [ 'keys', 'all' ], |
466
|
|
|
|
|
|
|
lastsave => [], |
467
|
|
|
|
|
|
|
latency => [], |
468
|
|
|
|
|
|
|
lindex => [ 'first' ], |
469
|
|
|
|
|
|
|
linsert => [ 'first' ], |
470
|
|
|
|
|
|
|
llen => [ 'first' ], |
471
|
|
|
|
|
|
|
lolwut => [], |
472
|
|
|
|
|
|
|
lpop => [ 'first' ], |
473
|
|
|
|
|
|
|
lpush => [ 'first' ], |
474
|
|
|
|
|
|
|
lpushx => [ 'first' ], |
475
|
|
|
|
|
|
|
lrange => [ 'first' ], |
476
|
|
|
|
|
|
|
lrem => [ 'first' ], |
477
|
|
|
|
|
|
|
lset => [ 'first' ], |
478
|
|
|
|
|
|
|
ltrim => [ 'first' ], |
479
|
|
|
|
|
|
|
memory => [], |
480
|
|
|
|
|
|
|
mget => [ 'all' ], |
481
|
|
|
|
|
|
|
migrate => [ 'migrate' ], |
482
|
|
|
|
|
|
|
module => { |
483
|
|
|
|
|
|
|
list => [], |
484
|
|
|
|
|
|
|
load => [], |
485
|
|
|
|
|
|
|
unload => [], |
486
|
|
|
|
|
|
|
}, |
487
|
|
|
|
|
|
|
monitor => [], |
488
|
|
|
|
|
|
|
move => [ 'first' ], |
489
|
|
|
|
|
|
|
mscan => [ 'first' ], |
490
|
|
|
|
|
|
|
mset => [ 'alternate' ], |
491
|
|
|
|
|
|
|
msetnx => [ 'alternate' ], |
492
|
|
|
|
|
|
|
object => [ 'exclude_first' ], |
493
|
|
|
|
|
|
|
persist => [ 'first' ], |
494
|
|
|
|
|
|
|
pexpire => [ 'first' ], |
495
|
|
|
|
|
|
|
pexpireat => [ 'first' ], |
496
|
|
|
|
|
|
|
pfadd => [ 'first' ], |
497
|
|
|
|
|
|
|
pfcount => [ 'all' ], |
498
|
|
|
|
|
|
|
pfmerge => [ 'all' ], |
499
|
|
|
|
|
|
|
ping => [], |
500
|
|
|
|
|
|
|
psetex => [ 'first' ], |
501
|
|
|
|
|
|
|
psubscribe => [ 'all' ], |
502
|
|
|
|
|
|
|
psync => [], |
503
|
|
|
|
|
|
|
pttl => [ 'first' ], |
504
|
|
|
|
|
|
|
publish => [ 'first' ], |
505
|
|
|
|
|
|
|
punsubscribe => [ 'all' ], |
506
|
|
|
|
|
|
|
quit => [], |
507
|
|
|
|
|
|
|
randomkey => [], |
508
|
|
|
|
|
|
|
readonly => [], |
509
|
|
|
|
|
|
|
readwrite => [], |
510
|
|
|
|
|
|
|
rename => [ 'all' ], |
511
|
|
|
|
|
|
|
renamenx => [ 'all' ], |
512
|
|
|
|
|
|
|
replicaof => [], |
513
|
|
|
|
|
|
|
restore => [ 'first' ], |
514
|
|
|
|
|
|
|
role => [], |
515
|
|
|
|
|
|
|
rpop => [ 'first' ], |
516
|
|
|
|
|
|
|
rpoplpush => [ 'all' ], |
517
|
|
|
|
|
|
|
rpush => [ 'first' ], |
518
|
|
|
|
|
|
|
rpushx => [ 'first' ], |
519
|
|
|
|
|
|
|
sadd => [ 'first' ], |
520
|
|
|
|
|
|
|
save => [], |
521
|
|
|
|
|
|
|
scard => [ 'first' ], |
522
|
|
|
|
|
|
|
script => [], |
523
|
|
|
|
|
|
|
sdiff => [ 'all' ], |
524
|
|
|
|
|
|
|
sdiffstore => [ 'all' ], |
525
|
|
|
|
|
|
|
select => [], |
526
|
|
|
|
|
|
|
set => [ 'first' ], |
527
|
|
|
|
|
|
|
setbit => [ 'first' ], |
528
|
|
|
|
|
|
|
setex => [ 'first' ], |
529
|
|
|
|
|
|
|
setnx => [ 'first' ], |
530
|
|
|
|
|
|
|
setrange => [ 'first' ], |
531
|
|
|
|
|
|
|
shutdown => [], |
532
|
|
|
|
|
|
|
sinter => [ 'all' ], |
533
|
|
|
|
|
|
|
sinterstore => [ 'all' ], |
534
|
|
|
|
|
|
|
sismember => [ 'first' ], |
535
|
|
|
|
|
|
|
slaveof => [], |
536
|
|
|
|
|
|
|
slowlog => [], |
537
|
|
|
|
|
|
|
smembers => [ 'first' ], |
538
|
|
|
|
|
|
|
smove => [ 'exclude_last' ], |
539
|
|
|
|
|
|
|
scan => [ 'scan', 'scan' ], |
540
|
|
|
|
|
|
|
sort => [ 'sort' ], |
541
|
|
|
|
|
|
|
spop => [ 'first' ], |
542
|
|
|
|
|
|
|
srandmember => [ 'first' ], |
543
|
|
|
|
|
|
|
srem => [ 'first' ], |
544
|
|
|
|
|
|
|
sscan => [ 'first' ], |
545
|
|
|
|
|
|
|
strlen => [ 'first' ], |
546
|
|
|
|
|
|
|
subscribe => [ 'all' ], |
547
|
|
|
|
|
|
|
sunion => [ 'all' ], |
548
|
|
|
|
|
|
|
sunionstore => [ 'all' ], |
549
|
|
|
|
|
|
|
swapdb => [], |
550
|
|
|
|
|
|
|
sync => [], |
551
|
|
|
|
|
|
|
time => [], |
552
|
|
|
|
|
|
|
touch => [ 'all' ], |
553
|
|
|
|
|
|
|
ttl => [ 'first' ], |
554
|
|
|
|
|
|
|
type => [ 'first' ], |
555
|
|
|
|
|
|
|
unsubscribe => [ 'all' ], |
556
|
|
|
|
|
|
|
unlink => [ 'all' ], |
557
|
|
|
|
|
|
|
unwatch => [], |
558
|
|
|
|
|
|
|
wait => [], |
559
|
|
|
|
|
|
|
watch => [ 'all' ], |
560
|
|
|
|
|
|
|
xack => [ 'first' ], |
561
|
|
|
|
|
|
|
xadd => [ 'first' ], |
562
|
|
|
|
|
|
|
xclaim => [ 'first' ], |
563
|
|
|
|
|
|
|
xdel => [ 'first' ], |
564
|
|
|
|
|
|
|
xgroup => { |
565
|
|
|
|
|
|
|
create => [ 'first' ], |
566
|
|
|
|
|
|
|
setid => [ 'first' ], |
567
|
|
|
|
|
|
|
destroy => [ 'first' ], |
568
|
|
|
|
|
|
|
delconsumer => [ 'first' ], |
569
|
|
|
|
|
|
|
help => [], |
570
|
|
|
|
|
|
|
}, |
571
|
|
|
|
|
|
|
xinfo => { |
572
|
|
|
|
|
|
|
consumers => [ 'first' ], |
573
|
|
|
|
|
|
|
groups => [ 'first' ], |
574
|
|
|
|
|
|
|
stream => [ 'first' ], |
575
|
|
|
|
|
|
|
help => [], |
576
|
|
|
|
|
|
|
}, |
577
|
|
|
|
|
|
|
xlen => [ 'all' ], |
578
|
|
|
|
|
|
|
xpending => [ 'first' ], |
579
|
|
|
|
|
|
|
xrange => [ 'first' ], |
580
|
|
|
|
|
|
|
xread => [ 'xread', 'xread' ], |
581
|
|
|
|
|
|
|
xreadgroup => [ 'xreadgroup', 'xread' ], |
582
|
|
|
|
|
|
|
xrevrange => [ 'first' ], |
583
|
|
|
|
|
|
|
xtrim => [ 'first' ], |
584
|
|
|
|
|
|
|
zadd => [ 'first' ], |
585
|
|
|
|
|
|
|
zcard => [ 'first' ], |
586
|
|
|
|
|
|
|
zcount => [ 'first' ], |
587
|
|
|
|
|
|
|
zincrby => [ 'first' ], |
588
|
|
|
|
|
|
|
zinterstore => [ 'exclude_options' ], |
589
|
|
|
|
|
|
|
zlexcount => [ 'first' ], |
590
|
|
|
|
|
|
|
zpopmax => [ 'first' ], |
591
|
|
|
|
|
|
|
zpopmin => [ 'first' ], |
592
|
|
|
|
|
|
|
zrange => [ 'first' ], |
593
|
|
|
|
|
|
|
zrangebylex => [ 'first' ], |
594
|
|
|
|
|
|
|
zrangebyscore => [ 'first' ], |
595
|
|
|
|
|
|
|
zrank => [ 'first' ], |
596
|
|
|
|
|
|
|
zrem => [ 'first' ], |
597
|
|
|
|
|
|
|
zremrangebylex => [ 'first' ], |
598
|
|
|
|
|
|
|
zremrangebyrank => [ 'first' ], |
599
|
|
|
|
|
|
|
zremrangebyscore => [ 'first' ], |
600
|
|
|
|
|
|
|
zrevrange => [ 'first' ], |
601
|
|
|
|
|
|
|
zrevrangebylex => [ 'first' ], |
602
|
|
|
|
|
|
|
zrevrangebyscore => [ 'first' ], |
603
|
|
|
|
|
|
|
zrevrank => [ 'first' ], |
604
|
|
|
|
|
|
|
zscan => [ 'first' ], |
605
|
|
|
|
|
|
|
zscore => [ 'first' ], |
606
|
|
|
|
|
|
|
zunionstore => [ 'exclude_options' ], |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
multi => [], |
609
|
|
|
|
|
|
|
); |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub new { |
612
|
4
|
|
|
4
|
0
|
8835
|
my $class = shift; |
613
|
4
|
|
|
|
|
17
|
my %args = @_; |
614
|
4
|
|
|
|
|
10
|
my $self = bless {}, $class; |
615
|
|
|
|
|
|
|
|
616
|
4
|
|
33
|
|
|
63
|
$self->{redis} = $args{redis} || Redis->new(%args); |
617
|
4
|
|
|
|
|
11
|
$self->{namespace} = $args{namespace}; |
618
|
4
|
|
|
|
|
9
|
$self->{warning} = $args{warning}; |
619
|
4
|
|
|
|
|
8
|
$self->{strict} = $args{strict}; |
620
|
4
|
|
|
|
|
10
|
$self->{subscribers} = {}; |
621
|
4
|
50
|
|
|
|
13
|
if ($args{guess}) { |
622
|
0
|
|
|
|
|
0
|
my $count = eval { $self->{redis}->command_count }; |
|
0
|
|
|
|
|
0
|
|
623
|
0
|
0
|
|
|
|
0
|
if ($count) { |
|
|
0
|
|
|
|
|
|
624
|
0
|
|
|
|
|
0
|
$self->{guess} = 1; |
625
|
|
|
|
|
|
|
} elsif ($self->{warning}) { |
626
|
0
|
|
|
|
|
0
|
my $version = $self->{redis}->info->{redis_version}; |
627
|
0
|
|
|
|
|
0
|
carp "guess option requires 2.8.13 or later. your redis version is $version"; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
} |
630
|
4
|
|
|
|
|
10
|
$self->{guess_cache} = {}; |
631
|
4
|
|
|
|
|
8
|
$self->{movablekeys} = {}; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
# escape for pattern |
634
|
4
|
|
|
|
|
8
|
my $escaped = $args{namespace}; |
635
|
4
|
|
|
|
|
13
|
$escaped =~ s/([[?*\\])/"\\$1"/ge; |
|
0
|
|
|
|
|
0
|
|
636
|
4
|
|
|
|
|
11
|
$self->{namespace_escaped} = $escaped; |
637
|
|
|
|
|
|
|
|
638
|
4
|
|
|
|
|
15
|
return $self; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub _wrap_method { |
642
|
0
|
|
|
0
|
|
|
my ($class, $command) = @_; |
643
|
0
|
|
|
|
|
|
my ($cmd, @extra) = split /_/, lc($command); |
644
|
0
|
|
|
|
|
|
my $filters = $COMMANDS{$cmd}; |
645
|
0
|
|
|
|
|
|
my ($before, $after); |
646
|
0
|
|
|
|
|
|
my @subcommand = (); |
647
|
|
|
|
|
|
|
|
648
|
0
|
0
|
|
|
|
|
if ($filters) { |
649
|
0
|
0
|
|
|
|
|
if (ref $filters eq 'HASH') { |
650
|
|
|
|
|
|
|
# the target command has sub-commands |
651
|
0
|
0
|
|
|
|
|
if (@extra > 0) { |
652
|
0
|
|
|
|
|
|
my $subcommand = shift @extra; |
653
|
0
|
|
|
|
|
|
@subcommand = ($subcommand); |
654
|
0
|
|
0
|
|
|
|
$before = $BEFORE_FILTERS{$filters->{$subcommand}[0] // 'none'}; |
655
|
0
|
|
0
|
|
|
|
$after = $AFTER_FILTERS{$filters->{$subcommand}[1] // 'none'}; |
656
|
|
|
|
|
|
|
} else { |
657
|
|
|
|
|
|
|
$before = sub { |
658
|
0
|
|
|
0
|
|
|
my ($self, $subcommand, @arg) = @_; |
659
|
0
|
|
0
|
|
|
|
my $before = $BEFORE_FILTERS{$filters->{$subcommand}[0] // 'none'}; |
660
|
0
|
|
0
|
|
|
|
$after = $AFTER_FILTERS{$filters->{$subcommand}[1] // 'none'}; |
661
|
0
|
|
|
|
|
|
return ($subcommand, $before->($self, @arg)); |
662
|
0
|
|
|
|
|
|
}; |
663
|
0
|
|
|
|
|
|
$after = $AFTER_FILTERS{'none'}; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
} else { |
666
|
0
|
|
0
|
|
|
|
$before = $BEFORE_FILTERS{$filters->[0] // 'none'}; |
667
|
0
|
|
0
|
|
|
|
$after = $AFTER_FILTERS{$filters->[1] // 'none'}; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
return sub { |
672
|
0
|
|
|
0
|
|
|
my ($self, @args) = @_; |
673
|
0
|
|
|
|
|
|
my $redis = $self->{redis}; |
674
|
0
|
|
|
|
|
|
my $wantarray = wantarray; |
675
|
0
|
|
|
|
|
|
my ($before, $after) = ($before, $after); |
676
|
|
|
|
|
|
|
|
677
|
0
|
0
|
0
|
|
|
|
if ($self->{strict} && $UNSAFE_COMMANDS{$command}) { |
678
|
0
|
|
|
|
|
|
croak "unsafe command '$command'"; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
0
|
0
|
0
|
|
|
|
if (!$before || !$after) { |
682
|
0
|
0
|
|
|
|
|
if ($self->{strict}) { |
683
|
0
|
|
|
|
|
|
croak "unknown command '$command'"; |
684
|
|
|
|
|
|
|
} |
685
|
0
|
|
|
|
|
|
($before, $after) = $self->_guess($command, @subcommand, @extra, @args); |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
0
|
0
|
0
|
|
|
|
if(@args && ref $args[-1] eq 'CODE') { |
689
|
0
|
|
|
|
|
|
my $cb = pop @args; |
690
|
0
|
|
|
|
|
|
@args = (@subcommand, $before->($self, @extra, @args)); |
691
|
|
|
|
|
|
|
push @args, sub { |
692
|
0
|
|
|
|
|
|
my ($result, $error) = @_; |
693
|
0
|
|
|
|
|
|
$cb->($after->($self, $result), $error); |
694
|
0
|
|
|
|
|
|
}; |
695
|
|
|
|
|
|
|
} else { |
696
|
0
|
|
|
|
|
|
@args = (@subcommand, $before->($self, @extra, @args)); |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
0
|
0
|
|
|
|
|
if(!$wantarray) { |
|
|
0
|
|
|
|
|
|
700
|
0
|
|
|
|
|
|
$redis->$cmd(@args); |
701
|
|
|
|
|
|
|
} elsif($wantarray) { |
702
|
0
|
|
|
|
|
|
my @result = $redis->$cmd(@args); |
703
|
0
|
|
|
|
|
|
return $after->($self, @result); |
704
|
|
|
|
|
|
|
} else { |
705
|
0
|
|
|
|
|
|
my $result = $redis->$cmd(@args); |
706
|
0
|
|
|
|
|
|
return $after->($self, $result); |
707
|
|
|
|
|
|
|
} |
708
|
0
|
|
|
|
|
|
}; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
sub _guess { |
712
|
0
|
|
|
0
|
|
|
my ($self, $command, @args) = @_; |
713
|
0
|
0
|
|
|
|
|
if (!$self->{guess}) { |
714
|
0
|
|
|
|
|
|
carp "unknown command '$command'. passing arguments to the redis server as is."; |
715
|
0
|
|
|
|
|
|
return $BEFORE_FILTERS{none}, $AFTER_FILTERS{none}; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
0
|
0
|
|
|
|
|
if (my $cache = $self->{guess_cache}{$command}) { |
719
|
0
|
|
|
|
|
|
return @$cache; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
0
|
|
|
|
|
|
my $movablekeys = $self->{movablekeys}{$command}; |
723
|
0
|
0
|
|
|
|
|
if ($movablekeys) { |
724
|
0
|
|
|
|
|
|
return $self->_guess_movablekeys($command, @args); |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
0
|
|
|
|
|
|
my $info = $self->{redis}->command_info($command); |
728
|
0
|
0
|
|
|
|
|
my ($name, $num, $flags, $first, $last, $step) = @{$info->[0] || []}; |
|
0
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
|
730
|
0
|
0
|
|
|
|
|
unless ($name) { |
731
|
0
|
0
|
|
|
|
|
if ($self->{warning}) { |
732
|
0
|
|
|
|
|
|
carp "unknown command '$command'. passing arguments to the redis server as is."; |
733
|
|
|
|
|
|
|
} |
734
|
0
|
|
|
|
|
|
my ($before, $after) = ($BEFORE_FILTERS{none}, $AFTER_FILTERS{none}); |
735
|
0
|
|
|
|
|
|
$self->{guess_cache}{$command} = [$before, $after]; |
736
|
0
|
|
|
|
|
|
return $before, $after; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
0
|
0
|
|
|
|
|
($movablekeys) = grep { $_ eq 'movablekeys' } @{$flags || []}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
740
|
0
|
0
|
|
|
|
|
if ($movablekeys) { |
741
|
0
|
|
|
|
|
|
$self->{movablekeys}{$command} = 1; |
742
|
0
|
|
|
|
|
|
return $self->_guess_movablekeys($command, @args); |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
my $before = sub { |
746
|
0
|
|
|
0
|
|
|
my ($self, @args) = @_; |
747
|
0
|
0
|
|
|
|
|
if ($first > 0) { |
748
|
0
|
|
0
|
|
|
|
for (my $i = $first; $i <= @args && ($last < 0 || $i <= $last); $i += $step) { |
|
|
|
0
|
|
|
|
|
749
|
0
|
|
|
|
|
|
($args[$i-1]) = $self->add_namespace($args[$i-1]); |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
} |
752
|
0
|
|
|
|
|
|
return @args; |
753
|
0
|
|
|
|
|
|
}; |
754
|
0
|
|
|
|
|
|
my $after = $AFTER_FILTERS{none}; |
755
|
0
|
|
|
|
|
|
$self->{guess_cache}{$command} = [$before, $after]; |
756
|
0
|
|
|
|
|
|
return $before, $after; |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
sub _guess_movablekeys { |
760
|
0
|
|
|
0
|
|
|
my ($self, $command, @args) = @_; |
761
|
0
|
0
|
0
|
|
|
|
if(@args && ref $args[-1] eq 'CODE') { |
762
|
0
|
|
|
|
|
|
pop @args; # ignore callback function |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
0
|
|
|
|
|
|
my @keys = eval { $self->{redis}->command_getkeys($command, @args) } |
766
|
0
|
0
|
|
|
|
|
or return $BEFORE_FILTERS{none}, $AFTER_FILTERS{none}; |
767
|
0
|
|
|
|
|
|
my @positions = (); |
768
|
0
|
|
|
|
|
|
my @list = (); |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# search the positions of keys. |
771
|
0
|
|
|
|
|
|
my $search; $search = sub { |
772
|
0
|
|
|
0
|
|
|
my ($i, $start) = @_; |
773
|
0
|
|
|
|
|
|
my $key = $keys[$i]; |
774
|
0
|
|
|
|
|
|
for (my $j = $start; $j < @args; $j++) { |
775
|
0
|
0
|
|
|
|
|
next if $args[$j] ne $key; |
776
|
0
|
|
|
|
|
|
push @positions, $j; |
777
|
0
|
0
|
|
|
|
|
if ($i+1 < @keys) { |
778
|
0
|
|
|
|
|
|
$search->($i+1, $j+1); |
779
|
|
|
|
|
|
|
} else { |
780
|
0
|
|
|
|
|
|
push @list, [@positions]; |
781
|
|
|
|
|
|
|
} |
782
|
0
|
|
|
|
|
|
pop @positions; |
783
|
|
|
|
|
|
|
} |
784
|
0
|
|
|
|
|
|
}; |
785
|
0
|
|
|
|
|
|
$search->(0, 0); |
786
|
|
|
|
|
|
|
|
787
|
0
|
0
|
|
|
|
|
if (@list == 0) { |
|
|
0
|
|
|
|
|
|
788
|
0
|
|
|
|
|
|
croak "fail to guess key positions of command '$command'"; |
789
|
|
|
|
|
|
|
} elsif (@list == 1) { |
790
|
|
|
|
|
|
|
# found keys |
791
|
0
|
|
|
|
|
|
my $positions = $list[0]; |
792
|
|
|
|
|
|
|
return sub { |
793
|
0
|
|
|
0
|
|
|
my ($self, @args) = @_; |
794
|
0
|
|
|
|
|
|
@args[@$positions] = $self->add_namespace(@args[@$positions]); |
795
|
0
|
|
|
|
|
|
return @args; |
796
|
|
|
|
|
|
|
}, $AFTER_FILTERS{none} |
797
|
0
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
# found keys, but their positions are ambiguous |
800
|
0
|
|
|
|
|
|
my $prefix = "test-key-$^T-$$-"; |
801
|
0
|
|
|
|
|
|
my @want = map { "$prefix$_" } @keys; |
|
0
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
LOOP: |
803
|
0
|
|
|
|
|
|
for my $positions(@list) { |
804
|
0
|
|
|
|
|
|
my @args = @args; |
805
|
0
|
|
|
|
|
|
for my $i(@$positions) { |
806
|
0
|
|
|
|
|
|
$args[$i] = $prefix . $args[$i]; |
807
|
|
|
|
|
|
|
} |
808
|
0
|
|
|
|
|
|
my @keys = eval { $self->{redis}->command_getkeys($command, @args) }; |
|
0
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
|
810
|
0
|
0
|
|
|
|
|
if (scalar(@keys) != scalar(@want)) { |
811
|
0
|
|
|
|
|
|
next; |
812
|
|
|
|
|
|
|
} |
813
|
0
|
|
|
|
|
|
for my $i(0..scalar(@keys)-1) { |
814
|
0
|
0
|
|
|
|
|
if ($keys[$i] ne $want[$i]) { |
815
|
|
|
|
|
|
|
next LOOP |
816
|
0
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
# found! |
820
|
|
|
|
|
|
|
return sub { |
821
|
0
|
|
|
0
|
|
|
my ($self, @args) = @_; |
822
|
0
|
|
|
|
|
|
@args[@$positions] = $self->add_namespace(@args[@$positions]); |
823
|
0
|
|
|
|
|
|
return @args; |
824
|
|
|
|
|
|
|
}, $AFTER_FILTERS{none} |
825
|
0
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
0
|
|
|
|
|
|
croak "fail to guess key positions of command '$command'"; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
0
|
|
|
sub DESTROY { } |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
our $AUTOLOAD; |
833
|
|
|
|
|
|
|
sub AUTOLOAD { |
834
|
0
|
|
|
0
|
|
|
my $command = $AUTOLOAD; |
835
|
0
|
|
|
|
|
|
$command =~ s/.*://; |
836
|
|
|
|
|
|
|
|
837
|
0
|
|
|
|
|
|
my $method = Redis::Namespace->_wrap_method($command); |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# Save this method for future calls |
840
|
21
|
|
|
21
|
|
197
|
no strict 'refs'; |
|
21
|
|
|
|
|
44
|
|
|
21
|
|
|
|
|
14288
|
|
841
|
0
|
|
|
|
|
|
*$AUTOLOAD = $method; |
842
|
|
|
|
|
|
|
|
843
|
0
|
|
|
|
|
|
goto $method; |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# special commands. they are not redis commands. |
847
|
|
|
|
|
|
|
sub wait_one_response { |
848
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
849
|
0
|
|
|
|
|
|
return $self->{redis}->wait_one_response(@_); |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
sub wait_all_responses { |
852
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
853
|
0
|
|
|
|
|
|
return $self->{redis}->wait_all_responses(@_); |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
sub __wrap_subcb { |
857
|
0
|
|
|
0
|
|
|
my ($self, $cb) = @_; |
858
|
0
|
|
|
|
|
|
my $subscribers = $self->{subscribers}; |
859
|
|
|
|
|
|
|
my $callback = $subscribers->{$cb} // sub { |
860
|
0
|
|
|
0
|
|
|
my ($message, $topic, $subscribed_topic) = @_; |
861
|
0
|
|
|
|
|
|
$cb->($message, $self->rem_namespace($topic), $self->rem_namespace($subscribed_topic)); |
862
|
0
|
|
0
|
|
|
|
}; |
863
|
0
|
|
|
|
|
|
$subscribers->{$cb} = $callback; |
864
|
0
|
|
|
|
|
|
return $callback; |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
sub __subscribe { |
868
|
0
|
|
|
0
|
|
|
my ($self, $command, @args) = @_; |
869
|
0
|
|
|
|
|
|
my $cb = pop @args; |
870
|
0
|
0
|
|
|
|
|
confess("missing required callback in call to $command(), ") |
871
|
|
|
|
|
|
|
unless ref($cb) eq 'CODE'; |
872
|
|
|
|
|
|
|
|
873
|
0
|
|
|
|
|
|
my $redis = $self->{redis}; |
874
|
0
|
|
|
|
|
|
my $callback = $self->__wrap_subcb($cb); |
875
|
0
|
|
|
|
|
|
@args = $BEFORE_FILTERS{all}->($self, @args); |
876
|
0
|
|
|
|
|
|
return $redis->$command(@args, $callback); |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
sub __psubscribe { |
880
|
0
|
|
|
0
|
|
|
my ($self, $command, @args) = @_; |
881
|
0
|
|
|
|
|
|
my $cb = pop @args; |
882
|
0
|
0
|
|
|
|
|
confess("missing required callback in call to $command(), ") |
883
|
|
|
|
|
|
|
unless ref($cb) eq 'CODE'; |
884
|
|
|
|
|
|
|
|
885
|
0
|
|
|
|
|
|
my $redis = $self->{redis}; |
886
|
0
|
|
|
|
|
|
my $callback = $self->__wrap_subcb($cb); |
887
|
0
|
|
|
|
|
|
my $namespace = $self->{namespace_escaped}; |
888
|
0
|
|
|
|
|
|
@args = map { "$namespace:$_" } @args; |
|
0
|
|
|
|
|
|
|
889
|
0
|
|
|
|
|
|
return $redis->$command(@args, $callback); |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
# PubSub commands |
893
|
|
|
|
|
|
|
sub wait_for_messages { |
894
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
895
|
0
|
|
|
|
|
|
return $self->{redis}->wait_for_messages(@_); |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub is_subscriber { |
899
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
900
|
0
|
|
|
|
|
|
return $self->{redis}->is_subscriber(@_); |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub subscribe { |
904
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
905
|
0
|
|
|
|
|
|
return $self->__subscribe('subscribe', @_); |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
sub psubscribe { |
909
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
910
|
0
|
|
|
|
|
|
return $self->__psubscribe('psubscribe', @_); |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
sub unsubscribe { |
914
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
915
|
0
|
|
|
|
|
|
return $self->__subscribe('unsubscribe', @_); |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
sub punsubscribe { |
919
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
920
|
0
|
|
|
|
|
|
return $self->__psubscribe('punsubscribe', @_); |
921
|
|
|
|
|
|
|
} |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
1; |
924
|
|
|
|
|
|
|
__END__ |