/[Redis.pre-github]/lib/Redis.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/Redis.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 19 by dpavlin, Sun Mar 22 09:46:14 2009 UTC revision 33 by dpavlin, Sun Mar 22 17:31:40 2009 UTC
# Line 58  sub _sock_result { Line 58  sub _sock_result {
58          return $result;          return $result;
59  }  }
60    
61  sub _sock_result_bulk {  sub _sock_read_bulk {
62          my $len = <$sock>;          my $len = <$sock>;
63          warn "# len: ",dump($len);          warn "## bulk len: ",dump($len);
64          return undef if $len eq "nil\r\n";          return undef if $len eq "nil\r\n";
65          my $v;          my $v;
66          read($sock, $v, $len) || die $!;          if ( $len > 0 ) {
67          warn "# v: ",dump($v);                  read($sock, $v, $len) || die $!;
68                    warn "## bulk v: ",dump($v);
69            }
70          my $crlf;          my $crlf;
71          read($sock, $crlf, 2); # skip cr/lf          read($sock, $crlf, 2); # skip cr/lf
72          return $v;          return $v;
73  }  }
74    
75  sub _sock_ok {  sub _sock_result_bulk {
76            my $self = shift;
77            warn "## _sock_result_bulk ",dump( @_ );
78            print $sock join(' ',@_) . "\r\n";
79            _sock_read_bulk();
80    }
81    
82    sub _sock_result_bulk_list {
83            my $self = shift;
84            warn "## _sock_result_bulk_list ",dump( @_ );
85    
86            my $size = $self->_sock_send( @_ );
87            confess $size unless $size > 0;
88            $size--;
89    
90            my @list = ( 0 .. $size );
91            foreach ( 0 .. $size ) {
92                    $list[ $_ ] = _sock_read_bulk();
93            }
94    
95            warn "## list = ", dump( @list );
96            return @list;
97    }
98    
99    sub __sock_ok {
100          my $ok = <$sock>;          my $ok = <$sock>;
101            return undef if $ok eq "nil\r\n";
102          confess dump($ok) unless $ok eq "+OK\r\n";          confess dump($ok) unless $ok eq "+OK\r\n";
103  }  }
104    
105    sub _sock_send {
106            my $self = shift;
107            warn "## _sock_send ",dump( @_ );
108            print $sock join(' ',@_) . "\r\n";
109            _sock_result();
110    }
111    
112    sub _sock_send_ok {
113            my $self = shift;
114            warn "## _sock_send_ok ",dump( @_ );
115            print $sock join(' ',@_) . "\r\n";
116            __sock_ok();
117    }
118    
119    sub __sock_send_bulk_raw {
120            my $self = shift;
121            warn "## _sock_send_bulk ",dump( @_ );
122            my $value = pop;
123            $value = '' unless defined $value; # FIXME errr? nil?
124            print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
125    }
126    
127  sub _sock_send_bulk {  sub _sock_send_bulk {
128          my ( $self, $command, $key, $value ) = @_;          __sock_send_bulk_raw( @_ );
129          print $sock "$command $key " . length($value) . "\r\n$value\r\n";          __sock_ok();
         _sock_ok();  
130  }  }
131    
132    sub _sock_send_bulk_number {
133            __sock_send_bulk_raw( @_ );
134            my $v = _sock_result();
135            confess $v unless $v =~ m{^\-?\d+$};
136            return $v;
137    }
138    
139  =head1 Connection Handling  =head1 Connection Handling
140    
# Line 128  sub set { Line 182  sub set {
182  =cut  =cut
183    
184  sub get {  sub get {
185          my ( $self, $k ) = @_;          my $self = shift;
186          print $sock "GET $k\r\n";          $self->_sock_result_bulk('GET', @_);
         _sock_result_bulk();  
187  }  }
188    
189  =head2 incr  =head2 incr
# Line 143  sub get { Line 196  sub get {
196                    
197    
198  sub incr {  sub incr {
199          my ( $self, $key, $value ) = @_;          my $self = shift;
200          if ( defined $value ) {          $self->_sock_send( 'INCR' . ( $#_ ? 'BY' : '' ), @_ );
                 print $sock "INCRBY $key $value\r\n";  
         } else {  
                 print $sock "INCR $key\r\n";  
         }  
         _sock_result();  
201  }  }
202    
203  =head2 decr  =head2 decr
# Line 160  sub incr { Line 208  sub incr {
208  =cut  =cut
209    
210  sub decr {  sub decr {
211          my ( $self, $key, $value ) = @_;          my $self = shift;
212          if ( defined $value ) {          $self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ );
                 print $sock "DECRBY $key $value\r\n";  
         } else {  
                 print $sock "DECR $key\r\n";  
         }  
         _sock_result();  
213  }  }
214    
215  =head2 exists  =head2 exists
# Line 177  sub decr { Line 220  sub decr {
220    
221  sub exists {  sub exists {
222          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
223          print $sock "EXISTS $key\r\n";          $self->_sock_send( 'EXISTS', $key );
         _sock_result();  
224  }  }
225    
226  =head2 del  =head2 del
# Line 189  sub exists { Line 231  sub exists {
231    
232  sub del {  sub del {
233          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
234          print $sock "DEL $key\r\n";          $self->_sock_send( 'DEL', $key );
         _sock_result();  
235  }  }
236    
237  =head2 type  =head2 type
# Line 201  sub del { Line 242  sub del {
242    
243  sub type {  sub type {
244          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
245          print $sock "TYPE $key\r\n";          $self->_sock_send( 'TYPE', $key );
         _sock_result();  
246  }  }
247    
248  =head1 Commands operating on the key space  =head1 Commands operating on the key space
# Line 215  sub type { Line 255  sub type {
255    
256  sub keys {  sub keys {
257          my ( $self, $glob ) = @_;          my ( $self, $glob ) = @_;
258          print $sock "KEYS $glob\r\n";          return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob ));
         return split(/\s/, _sock_result_bulk());  
259  }  }
260    
261  =head2 randomkey  =head2 randomkey
# Line 227  sub keys { Line 266  sub keys {
266    
267  sub randomkey {  sub randomkey {
268          my ( $self ) = @_;          my ( $self ) = @_;
269          print $sock "RANDOMKEY\r\n";          $self->_sock_send( 'RANDOMKEY' );
         _sock_result();  
270  }  }
271    
272  =head2 rename  =head2 rename
# Line 239  sub randomkey { Line 277  sub randomkey {
277    
278  sub rename {  sub rename {
279          my ( $self, $old, $new, $nx ) = @_;          my ( $self, $old, $new, $nx ) = @_;
280          print $sock "RENAME" . ( $nx ? 'NX' : '' ) . " $old $new\r\n";          $self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new );
         _sock_ok();  
281  }  }
282    
283  =head2 dbsize  =head2 dbsize
# Line 251  sub rename { Line 288  sub rename {
288    
289  sub dbsize {  sub dbsize {
290          my ( $self ) = @_;          my ( $self ) = @_;
291          print $sock "DBSIZE\r\n";          $self->_sock_send('DBSIZE');
         _sock_result();  
292  }  }
293    
294  =head1 Commands operating on lists  =head1 Commands operating on lists
# Line 279  sub lpush { Line 315  sub lpush {
315          $self->_sock_send_bulk('LPUSH', $key, $value);          $self->_sock_send_bulk('LPUSH', $key, $value);
316  }  }
317    
318    =head2 llen
319    
320      $r->llen( $key );
321    
322    =cut
323    
324    sub llen {
325            my ( $self, $key ) = @_;
326            $self->_sock_send( 'LLEN', $key );
327    }
328    
329    =head2 lrange
330    
331      my @list = $r->lrange( $key, $start, $end );
332    
333    =cut
334    
335    sub lrange {
336            my ( $self, $key, $start, $end ) = @_;
337            $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
338    }
339    
340    =head2 ltrim
341    
342      my $ok = $r->ltrim( $key, $start, $end );
343    
344    =cut
345    
346    sub ltrim {
347            my ( $self, $key, $start, $end ) = @_;
348            $self->_sock_send_ok( 'LTRIM', $key, $start, $end );
349    }
350    
351    =head2 lindex
352    
353      $r->lindex( $key, $index );
354    
355    =cut
356    
357    sub lindex {
358            my ( $self, $key, $index ) = @_;
359            $self->_sock_result_bulk( 'LINDEX', $key, $index );
360    }
361    
362    =head2 lset
363    
364      $r->lset( $key, $index, $value );
365    
366    =cut
367    
368    sub lset {
369            my ( $self, $key, $index, $value ) = @_;
370            $self->_sock_send_bulk( 'LSET', $key, $index, $value );
371    }
372    
373    =head2 lrem
374    
375      my $modified_count = $r->lrem( $key, $count, $value );
376    
377    =cut
378    
379    sub lrem {
380            my ( $self, $key, $count, $value ) = @_;
381            $self->_sock_send_bulk_number( 'LREM', $key, $count, $value );
382    }
383    
384    =head2 lpop
385    
386      my $value = $r->lpop( $key );
387    
388    =cut
389    
390    sub lpop {
391            my ( $self, $key ) = @_;
392            $self->_sock_result_bulk( 'LPOP', $key );
393    }
394    
395    =head2 rpop
396    
397      my $value = $r->rpop( $key );
398    
399    =cut
400    
401    sub rpop {
402            my ( $self, $key ) = @_;
403            $self->_sock_result_bulk( 'RPOP', $key );
404    }
405    
406    =head1 Commands operating on sets
407    
408    =head2 sadd
409    
410      $r->sadd( $key, $member );
411    
412    =cut
413    
414    sub sadd {
415            my ( $self, $key, $member ) = @_;
416            $self->_sock_send_bulk_number( 'SADD', $key, $member );
417    }
418    
419    =head2 srem
420    
421      $r->srem( $key, $member );
422    
423    =cut
424    
425    sub srem {
426            my ( $self, $key, $member ) = @_;
427            $self->_sock_send_bulk_number( 'SREM', $key, $member );
428    }
429    
430    =head2 scard
431    
432      my $elements = $r->scard( $key );
433    
434    =cut
435    
436    sub scard {
437            my ( $self, $key ) = @_;
438            $self->_sock_send( 'SCARD', $key );
439    }
440    
441    =head2 sismember
442    
443      $r->sismember( $key, $member );
444    
445    =cut
446    
447    sub sismember {
448            my ( $self, $key, $member ) = @_;
449            $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );
450    }
451    
452    =head2 sinter
453    
454      $r->sinter( $key1, $key2, ... );
455    
456    =cut
457    
458    sub sinter {
459            my $self = shift;
460            $self->_sock_result_bulk_list( 'SINTER', @_ );
461    }
462    
463  =head1 AUTHOR  =head1 AUTHOR
464    
465  Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>

Legend:
Removed from v.19  
changed lines
  Added in v.33

  ViewVC Help
Powered by ViewVC 1.1.26