File Coverage

blib/lib/Redis/Namespace.pm
Criterion Covered Total %
statement 67 240 27.9
branch 19 82 23.1
condition 5 41 12.2
subroutine 8 31 25.8
pod 0 11 0.0
total 99 405 24.4


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__