File Coverage

blib/lib/Mojo/Redis/Cursor.pm
Criterion Covered Total %
statement 6 89 6.7
branch 0 44 0.0
condition 0 7 0.0
subroutine 2 28 7.1
pod 8 8 100.0
total 16 176 9.0


line stmt bran cond sub pod time code
1             package Mojo::Redis::Cursor;
2 19     19   279280 use Mojo::Base 'Mojo::EventEmitter';
  19         57  
  19         127  
3              
4 19     19   5315 use Carp qw(confess croak);
  19         51  
  19         39039  
5              
6             has connection => sub { shift->redis->_dequeue };
7 0     0 1   sub command { $_[0]->{command} }
8 0     0 1   sub finished { !!$_[0]->{finished} }
9             has redis => sub { confess 'redis is required in constructor' };
10              
11             sub again {
12 0     0 1   my $self = shift;
13 0           $self->{finished} = 0;
14 0           $self->command->[$self->{cursor_pos_in_command}] = 0;
15 0           return $self;
16             }
17              
18             sub all {
19 0 0   0 1   my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
20 0           my $self = shift->again; # Reset cursor
21 0 0         my $conn = $cb ? $self->connection : $self->redis->_blocking_connection;
22 0           my @res;
23              
24             # Blocking
25 0 0         unless ($cb) {
26 0           my $err;
27 0           while (my $p = $self->_next_p($conn)) {
28 0 0   0     $p->then(sub { push @res, @{$_[0] || []} })->catch(sub { $err = shift })->wait;
  0            
  0            
  0            
29 0 0         croak $err if $err;
30             }
31 0           return $self->{process}->($self, \@res);
32             }
33              
34             # Non-blocking
35             $self->_next_p($conn)->then(sub {
36 0     0     push @res, @{$_[0]};
  0            
37 0 0         return $self->$cb('', $self->{process}->($self, \@res)) if $self->{finished};
38 0           return $self->_next_p($conn)->then(__SUB__);
39 0     0     })->catch(sub { $self->$cb($_[0], []) });
  0            
40              
41 0           return $self;
42             }
43              
44             sub all_p {
45 0     0 1   my $self = shift->again; # Reset cursor
46 0           my $conn = $self->connection;
47 0           my @res;
48              
49             return $self->_next_p($conn)->then(sub {
50 0     0     push @res, @{$_[0]};
  0            
51 0 0         return $self->{process}->($self, \@res) if $self->{finished};
52 0           return $self->_next_p($conn)->then(__SUB__);
53 0           });
54             }
55              
56             sub next {
57 0 0   0 1   my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
58 0           my $self = shift;
59              
60             # Cursor is exhausted
61 0 0         return $cb ? $self->tap($cb, '', undef) : undef
    0          
    0          
62             unless my $p = $self->_next_p($cb ? $self->connection : $self->redis->_blocking_connection);
63              
64             # Blocking
65 0 0         unless ($cb) {
66 0           my ($err, $res);
67 0     0     $p->then(sub { $res = $self->{process}->($self, shift) })->catch(sub { $err = shift })->wait;
  0            
  0            
68 0 0         croak $err if $err;
69 0           return $res;
70             }
71              
72             # Non-blocking
73 0     0     $p->then(sub { $self->$cb('', $self->{process}->($self, shift)) })->catch(sub { $self->$cb(shift, undef) });
  0            
  0            
74 0           return $self;
75             }
76              
77             sub next_p {
78 0     0 1   my $self = shift;
79 0     0     return $self->_next_p($self->connection)->then(sub { $self->{process}->($self, shift) });
  0            
80             }
81              
82             sub new {
83 0     0 1   my $self = shift->SUPER::new(@_);
84 0           my $cmd = $self->command;
85              
86 0   0       $cmd->[0] ||= 'unknown';
87 0 0         $self->{process} = __PACKAGE__->can(lc "_process_$cmd->[0]") or confess "Unknown cursor command: @$cmd";
88              
89 0 0         if ($cmd->[0] eq 'keys') {
    0          
    0          
90 0 0         @$cmd = (scan => 0, $cmd->[1] ? (match => $cmd->[1]) : ());
91             }
92             elsif ($cmd->[0] eq 'smembers') {
93 0           @$cmd = (sscan => $cmd->[1], 0);
94             }
95             elsif ($cmd->[0] =~ /^(hgetall|hkeys)/) {
96 0           @$cmd = (hscan => $cmd->[1], 0);
97             }
98              
99 0 0         $self->{cursor_pos_in_command} = $cmd->[0] =~ /^scan$/i ? 1 : 2;
100 0           return $self;
101             }
102              
103             sub _next_p {
104 0     0     my ($self, $conn) = @_;
105 0 0         return undef if $self->{finished};
106              
107 0           my $cmd = $self->command;
108             return $conn->write_p(@$cmd)->then(sub {
109 0     0     my $res = shift;
110 0   0       $cmd->[$self->{cursor_pos_in_command}] = $res->[0] // 0;
111 0 0         $self->{finished} = 1 unless $res->[0];
112 0           return $res->[1];
113 0           });
114             }
115              
116 0     0     sub _process_hgetall { +{@{$_[1]}} }
  0            
117 0     0     sub _process_hkeys { my %h = @{$_[1]}; return [keys %h]; }
  0            
  0            
118 0     0     sub _process_hscan { $_[1] }
119 0     0     sub _process_keys { $_[1] }
120 0     0     sub _process_scan { $_[1] }
121 0     0     sub _process_smembers { $_[1] }
122 0     0     sub _process_sscan { $_[1] }
123 0     0     sub _process_zscan { $_[1] }
124              
125             sub DESTROY {
126 0     0     my $self = shift;
127 0 0 0       return unless (my $redis = $self->{redis}) && (my $conn = $self->{connection});
128 0           $redis->_enqueue($conn);
129             }
130              
131             1;
132              
133             =encoding utf8
134              
135             =head1 NAME
136              
137             Mojo::Redis::Cursor - Iterate the results from SCAN, SSCAN, HSCAN and ZSCAN
138              
139             =head1 SYNOPSIS
140              
141             use Mojo::Redis;
142             my $redis = Mojo::Redis->new;
143             my $cursor = $redis->cursor(hkeys => 'redis:scan_test:hash');
144             my $keys = $cursor->all;
145              
146             =head1 DESCRIPTION
147              
148             L provides methods for iterating over the result from
149             the Redis commands SCAN, SSCAN, HSCAN and ZSCAN.
150              
151             See L for more information.
152              
153             =head1 ATTRIBUTES
154              
155             =head2 command
156              
157             $array_ref = $cursor->command;
158              
159             The current command used to get data from Redis. This need to be set in the
160             constructor, but reading it out might not reflect the value put in. Examples:
161              
162             $r->new(command => [hgetall => "foo*"]);
163             # $r->command == [hscan => "foo*", 0]
164              
165             $r->new(command => [SSCAN => "foo*"])
166             # $r->command == [SSCAN => "foo*", 0]
167              
168             Also, calling L will change the value of L. Example:
169              
170             $r->new(command => ["keys"]);
171             # $r->command == [scan => 0]
172             $r->next;
173             # $r->command == [scan => 42]
174              
175             =head2 connection
176              
177             $conn = $cursor->connection;
178             $cursor = $cursor->connection(Mojo::Redis::Connection->new);
179              
180             Holds a L object.
181              
182             =head2 finished
183              
184             $bool = $cursor->finished;
185              
186             True after calling L or if L has iterated the whole list of members.
187              
188             =head2 redis
189              
190             $conn = $cursor->connection;
191             $cursor = $cursor->connection(Mojo::Redis::Connection->new);
192              
193             Holds a L object used to create the connections to talk with Redis.
194              
195             =head1 METHODS
196              
197             =head2 again
198              
199             $cursor->again;
200              
201             Used to reset the cursor and make L start over.
202              
203             =head2 all
204              
205             $res = $cursor->all;
206             $cursor = $cursor->all(sub { my ($cursor, $res) = @_ });
207              
208             Used to return all members. C<$res> is an array ref of strings, except when
209             using the command "hgetall".
210              
211             =head2 all_p
212              
213             $promise = $cursor->all_p->then(sub { my $res = shift });
214              
215             Same as L but returns a L.
216              
217             =head2 new
218              
219             $cursor = Mojo::Redis::Cursor->new(command => [...], redis => Mojo::Redis->new);
220              
221             Used to construct a new object. L and L is required as input.
222              
223             Here are some examples of the differnet commands that are supported:
224              
225             # Custom cursor commands
226             $cursor = $cursor->cursor(hscan => 0, match => '*', count => 100);
227             $cursor = $cursor->cursor(scan => 0, match => '*', count => 100);
228             $cursor = $cursor->cursor(sscan => 0, match => '*', count => 100);
229             $cursor = $cursor->cursor(zscan => 0, match => '*', count => 100);
230              
231             # Convenient cursor commands
232             $cursor = $cursor->cursor(hgetall => "some:hash:key");
233             $cursor = $cursor->cursor(hkeys => "some:hash:key");
234             $cursor = $cursor->cursor(keys => "some:key:pattern*");
235             $cursor = $cursor->cursor(smembers => "some:set:key");
236              
237             The convenient commands are alternatives to L,
238             L, L and
239             L.
240              
241             =head2 next
242              
243             $res = $cursor->next;
244             $cursor = $cursor->next(sub { my ($cursor, $err, $res) = @_ });
245              
246             Used to return a chunk of members. C<$res> is an array ref of strings, except
247             when using the command "hgetall". C<$res> will also be C when the
248             cursor is exhausted and L will be true.
249              
250             =head2 next_p
251              
252             $promise = $cursor->next_p;
253              
254             Same as L but returns a L.
255              
256             =head1 SEE ALSO
257              
258             L.
259              
260             =cut