diff --git a/lib/Redis.pm b/lib/Redis.pm index 62bcb21..f09fa79 100644 --- a/lib/Redis.pm +++ b/lib/Redis.pm @@ -470,20 +470,15 @@ sub keys { sub scan_callback { my $self = shift; my $cb = pop; - my ($pattern) = @_; - # TODO how do we pass TYPE and COUNT arguments? - croak("[scan_callback] The last argument must be a function") + croak "[scan_callback] The last argument must be a function" unless ref($cb) eq 'CODE'; + croak "[scan_callback] Optional arguments must be a hash, not an odd-sized list" + if @_ % 2; - $pattern = "*" - unless defined $pattern; - - # TODO how do we implement HSCAN/ZSCAN? Can't use $_ there - # because they iterate over _pairs_, not just keys. my $cursor = 0; do { - ($cursor, my $list) = $self->scan( $cursor, MATCH => $pattern ); + ($cursor, my $list) = $self->scan( $cursor, @_ ); foreach my $key (@$list) { $cb->($key); }; @@ -492,54 +487,65 @@ sub scan_callback { return 1; } -sub hscan_callback { +sub sscan_callback { my $self = shift; my $cb = pop; - my ($key, $pattern) = @_; - croak("[hscan_callback] The last argument must be a function") + croak "[sscan_callback] The last argument must be a function" unless ref($cb) eq 'CODE'; - croak("[hscan_callback] key is required") + my $key = shift; + croak("[sscan_callback] key is required") unless defined $key; - $pattern = "*" unless defined $pattern; + croak "[sscan_callback] Optional arguments must be a hash, not an odd-sized list" + if @_ % 2; my $cursor = 0; do { - ($cursor, my $list) = $self->hscan( $key, $cursor, MATCH => $pattern ); - while (@$list) { - my $k = shift @$list; - my $v = shift @$list; - $cb->($k, $v); + ($cursor, my $list) = $self->sscan( $key, $cursor, @_ ); + foreach my $key (@$list) { + $cb->($key); }; } while $cursor; return 1; } -sub sscan_callback { - my $self = shift; - my $cb = pop; - my ($key, $pattern) = @_; - - croak("[sscan_callback] The last argument must be a function") - unless ref($cb) eq 'CODE'; - - croak("[sscan_callback] key is required") - unless defined $key; - - $pattern = "*" unless defined $pattern; +# Now do the same as above but under different names +# and with an extra parameter +foreach (qw(hscan zscan)) { + my $backend = $_; + my $method = $_ . "_callback"; + my $impl = sub { + my $self = shift; + my $cb = pop; + + croak("[$method] The last argument must be a function") + unless ref($cb) eq 'CODE'; + + my $key = shift; + croak("[$method] key is required") + unless defined $key; + + croak "[scan_callback] Optional arguments must be a hash, not an odd-sized list" + if @_ % 2; + + my $cursor = 0; + do { + ($cursor, my $list) = $self->$backend( $key, $cursor, @_ ); + while (@$list) { + my $k = shift @$list; + my $v = shift @$list; + $cb->($k, $v); + }; + } while $cursor; - my $cursor = 0; - do { - ($cursor, my $list) = $self->sscan( $key, $cursor, MATCH => $pattern ); - while (@$list) { - $cb->(shift @$list); - }; - } while $cursor; + return 1; + }; - return 1; + no strict 'refs'; ## no critic + *$method = $impl; } ### PubSub @@ -1757,16 +1763,22 @@ Incrementally iterate the keys space (see L) $r->scan_callback( sub { print "$_[0]\n" } ); - $r->scan_callback( "prefix:*", sub { + $r->scan_callback( MATCH => "prefix:*", TYPE => 'string', sub { my ($key) = @_; ... }); -Execute callback exactly once for every key matching a pattern -(of "*" if none given). L is used internally. +Execute callback exactly once for every key matching the criteria, +or all keys if none given. +L is used internally. The key in question will be the only argument of the callback. +=head3 Note on *_callback methods. + +The callback is always the last argument: +this makes calling code more readable. + =head2 sort $r->sort(key, [BY pattern], [LIMIT offset count], [GET pattern [GET pattern ...]], [ASC|DESC], [ALPHA], [STORE destination]) @@ -2017,13 +2029,14 @@ Incrementally iterate hash fields and associated values (see Lhscan_callback( $hashkey, sub { print "$_[0]\n" } ); - $r->hscan_callback( $hashkey, "prefix:*", sub { + $r->hscan_callback( $hashkey, MATCH => "prefix:*", sub { my ($key, $value) = @_; ... }); -Execute callback exactly once for every key matching a pattern -(of "*" if none given). L is used internally. +Execute callback exactly once for every key matching the pattern +(or all if none given). +L is used internally. A (key, value) pair will be passed to the callback as arguments. @@ -2129,13 +2142,13 @@ Incrementally iterate Set elements (see L) $r->sscan_callback( $key, sub { print "$_[0]\n" } ); - $r->sscan_callback( $key, "prefix:*", sub { + $r->sscan_callback( $key, MATCH => "prefix:*", sub { my ($key) = @_; ... }); Execute callback exactly once for every member of a set matching a pattern -(of "*" if none given). L is used internally. +(of all if none given). L is used internally. The member in question will be the only argument of the callback. @@ -2267,6 +2280,18 @@ Determine the index of a member in a sorted set, with scores ordered from high t Incrementally iterate sorted sets elements and associated scores (see L) +=head2 zscan_callback + + $r->zscan(key, [MATCH pattern], [COUNT count], sub { + my ($key, $score) = @_; + ... + }); + +Execute callback exactly once for every matching key in the sorted set. +The scan order is incremental (as redis documentation suggests). + +L is used internally. + =head2 zscore $r->zscore(key, member) diff --git a/t/12-scan-callback.t b/t/12-scan-callback.t index d5da6e7..3e742e9 100644 --- a/t/12-scan-callback.t +++ b/t/12-scan-callback.t @@ -37,17 +37,17 @@ my %vals = ( $o->set($_, $vals{$_}) for keys %vals; subtest 'shotgun scan' => sub { - my @trace; - $o->scan_callback(sub { push @trace, $_[0] }); + my %trace; + $o->scan_callback(sub { $trace{$_[0]}++ }); - is_deeply( [sort @trace], [sort keys %vals], 'all keys scanned once' ); + is_deeply( \%trace, { map { $_ => 1 } keys %vals}, 'all keys scanned exactly once' ); }; subtest 'scan with pattern' => sub { - my @trace; - $o->scan_callback('ba*', sub { push @trace, $_[0] }); + my %trace; + $o->scan_callback(MATCH => 'ba*', sub { $trace{$_[0]}++ }); - is_deeply( [sort @trace], [sort qw[bar baz]], 'only selected keys scanned once' ); + is_deeply( \%trace, { bar => 1, baz => 1 }, 'only selected keys scanned once' ); }; $o->hset( "hash", "foo", 42 ); @@ -67,7 +67,7 @@ subtest 'shotgun hscan' => sub { subtest 'hscan with pattern' => sub { my %copy; - $o->hscan_callback( "hash", "ba*", sub { + $o->hscan_callback( "hash", MATCH => "ba*", sub { my ($key, $value) = @_; $copy{$key} += $value; }); @@ -75,7 +75,6 @@ subtest 'hscan with pattern' => sub { is_deeply \%copy, { bar => 137 }, 'only matching keys processed exactly once'; }; - subtest 'sscan (iteration over set)' => sub { my @keys = qw( foo bar quux x:1 x:2 x:3 ); my %set = map { $_ => 1 } @keys; @@ -94,7 +93,7 @@ subtest 'sscan (iteration over set)' => sub { { my %copy; - $o->sscan_callback( "zfc", "x:*", sub { + $o->sscan_callback( "zfc", MATCH => "x:*", sub { my $entry = shift; $copy{$entry}++; }); @@ -102,4 +101,18 @@ subtest 'sscan (iteration over set)' => sub { }; }; +subtest 'zscan' => sub { + $o->zadd( "sorted", 1, "first", 2, "second", 3, "x", 3, "y", 3, "z" ); + my @trace; + $o->zscan_callback( "sorted", sub { push @trace, \@_ } ); + is_deeply( + \@trace, + [[ first => 1 ], [ second => 2 ], [ x => 3 ], [ y => 3 ], [ z => 3 ]], + "sorted set iterated in order" + ); +}; + +# TODO add a scan(TYPE => 'set') call +# but we need to ensure version >= 6.0.0 first... + done_testing;