/[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 8 by dpavlin, Sat Mar 21 22:48:46 2009 UTC revision 36 by dpavlin, Sun Mar 22 18:05:12 2009 UTC
# Line 9  use Carp qw/confess/; Line 9  use Carp qw/confess/;
9    
10  =head1 NAME  =head1 NAME
11    
12  Redis - The great new Redis!  Redis - perl binding for Redis database
13    
14  =cut  =cut
15    
# Line 20  our $VERSION = '0.01'; Line 20  our $VERSION = '0.01';
20    
21  Pure perl bindings for L<http://code.google.com/p/redis/>  Pure perl bindings for L<http://code.google.com/p/redis/>
22    
23    This version support git version of Redis available at
24    L<git://github.com/antirez/redis>
25    
26      use Redis;      use Redis;
27    
28      my $r = Redis->new();      my $r = Redis->new();
29    
   
   
   
30  =head1 FUNCTIONS  =head1 FUNCTIONS
31    
32  =head2 new  =head2 new
# Line 51  sub new { Line 51  sub new {
51          $self;          $self;
52  }  }
53    
54    sub _sock_result {
55            my $result = <$sock>;
56            warn "# result: ",dump( $result );
57            $result =~ s{\r\n$}{} || warn "can't find cr/lf";
58            return $result;
59    }
60    
61    sub _sock_read_bulk {
62            my $len = <$sock>;
63            warn "## bulk len: ",dump($len);
64            return undef if $len eq "nil\r\n";
65            my $v;
66            if ( $len > 0 ) {
67                    read($sock, $v, $len) || die $!;
68                    warn "## bulk v: ",dump($v);
69            }
70            my $crlf;
71            read($sock, $crlf, 2); # skip cr/lf
72            return $v;
73    }
74    
75    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>;
101            return undef if $ok eq "nil\r\n";
102            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 {
128            __sock_send_bulk_raw( @_ );
129            __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    
141  =head2 quit  =head2 quit
# Line 86  sub ping { Line 171  sub ping {
171  =cut  =cut
172    
173  sub set {  sub set {
174          my ( $self, $k, $v, $new ) = @_;          my ( $self, $key, $value, $new ) = @_;
175          print $sock ( $new ? "SETNX" : "SET" ) . " $k " . length($v) . "\r\n$v\r\n";          $self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value );
         my $ok = <$sock>;  
         confess dump($ok) unless $ok eq "+OK\r\n";  
176  }  }
177    
178  =head2 get  =head2 get
# Line 99  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', @_);
         my $len = <$sock>;  
 #       warn "# len: ",dump($len);  
         return undef if $len eq "nil\r\n";  
         my $v;  
         read($sock, $v, $len) || die $!;  
 #       warn "# v: ",dump($v);  
         my $crlf;  
         read($sock, $crlf, 2); # skip cr/lf  
         return $v;  
187  }  }
188    
189  =head2 incr  =head2 incr
# Line 119  sub get { Line 193  sub get {
193    
194  =cut  =cut
195    
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";  
         }  
         my $count = <$sock>;  
         warn "# $key = $count";  
         return $count;  
201  }  }
202    
203  =head2 decr  =head2 decr
# Line 139  sub incr { Line 208  sub incr {
208  =cut  =cut
209    
210  sub decr {  sub decr {
211            my $self = shift;
212            $self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ );
213    }
214    
215    =head2 exists
216    
217      $r->exists( 'key' ) && print "got key!";
218    
219    =cut
220    
221    sub exists {
222            my ( $self, $key ) = @_;
223            $self->_sock_send( 'EXISTS', $key );
224    }
225    
226    =head2 del
227    
228      $r->del( 'key' ) || warn "key doesn't exist";
229    
230    =cut
231    
232    sub del {
233            my ( $self, $key ) = @_;
234            $self->_sock_send( 'DEL', $key );
235    }
236    
237    =head2 type
238    
239      $r->type( 'key' ); # = string
240    
241    =cut
242    
243    sub type {
244            my ( $self, $key ) = @_;
245            $self->_sock_send( 'TYPE', $key );
246    }
247    
248    =head1 Commands operating on the key space
249    
250    =head2 keys
251    
252      my @keys = $r->keys( '*glob_pattern*' );
253    
254    =cut
255    
256    sub keys {
257            my ( $self, $glob ) = @_;
258            return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob ));
259    }
260    
261    =head2 randomkey
262    
263      my $key = $r->randomkey;
264    
265    =cut
266    
267    sub randomkey {
268            my ( $self ) = @_;
269            $self->_sock_send( 'RANDOMKEY' );
270    }
271    
272    =head2 rename
273    
274      my $ok = $r->rename( 'old-key', 'new-key', $new );
275    
276    =cut
277    
278    sub rename {
279            my ( $self, $old, $new, $nx ) = @_;
280            $self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new );
281    }
282    
283    =head2 dbsize
284    
285      my $nr_keys = $r->dbsize;
286    
287    =cut
288    
289    sub dbsize {
290            my ( $self ) = @_;
291            $self->_sock_send('DBSIZE');
292    }
293    
294    =head1 Commands operating on lists
295    
296    See also L<Redis::List> for tie interface.
297    
298    =head2 rpush
299    
300      $r->rpush( $key, $value );
301    
302    =cut
303    
304    sub rpush {
305          my ( $self, $key, $value ) = @_;          my ( $self, $key, $value ) = @_;
306          if ( defined $value ) {          $self->_sock_send_bulk('RPUSH', $key, $value);
307                  print $sock "DECRBY $key $value\r\n";  }
308          } else {  
309                  print $sock "DECR $key\r\n";  =head2 lpush
310          }  
311          my $count = <$sock>;    $r->lpush( $key, $value );
312          warn "# $key = $count";  
313          return $count;  =cut
314    
315    sub lpush {
316            my ( $self, $key, $value ) = @_;
317            $self->_sock_send_bulk('LPUSH', $key, $value);
318    }
319    
320    =head2 llen
321    
322      $r->llen( $key );
323    
324    =cut
325    
326    sub llen {
327            my ( $self, $key ) = @_;
328            $self->_sock_send( 'LLEN', $key );
329    }
330    
331    =head2 lrange
332    
333      my @list = $r->lrange( $key, $start, $end );
334    
335    =cut
336    
337    sub lrange {
338            my ( $self, $key, $start, $end ) = @_;
339            $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
340    }
341    
342    =head2 ltrim
343    
344      my $ok = $r->ltrim( $key, $start, $end );
345    
346    =cut
347    
348    sub ltrim {
349            my ( $self, $key, $start, $end ) = @_;
350            $self->_sock_send_ok( 'LTRIM', $key, $start, $end );
351    }
352    
353    =head2 lindex
354    
355      $r->lindex( $key, $index );
356    
357    =cut
358    
359    sub lindex {
360            my ( $self, $key, $index ) = @_;
361            $self->_sock_result_bulk( 'LINDEX', $key, $index );
362    }
363    
364    =head2 lset
365    
366      $r->lset( $key, $index, $value );
367    
368    =cut
369    
370    sub lset {
371            my ( $self, $key, $index, $value ) = @_;
372            $self->_sock_send_bulk( 'LSET', $key, $index, $value );
373    }
374    
375    =head2 lrem
376    
377      my $modified_count = $r->lrem( $key, $count, $value );
378    
379    =cut
380    
381    sub lrem {
382            my ( $self, $key, $count, $value ) = @_;
383            $self->_sock_send_bulk_number( 'LREM', $key, $count, $value );
384    }
385    
386    =head2 lpop
387    
388      my $value = $r->lpop( $key );
389    
390    =cut
391    
392    sub lpop {
393            my ( $self, $key ) = @_;
394            $self->_sock_result_bulk( 'LPOP', $key );
395    }
396    
397    =head2 rpop
398    
399      my $value = $r->rpop( $key );
400    
401    =cut
402    
403    sub rpop {
404            my ( $self, $key ) = @_;
405            $self->_sock_result_bulk( 'RPOP', $key );
406    }
407    
408    =head1 Commands operating on sets
409    
410    =head2 sadd
411    
412      $r->sadd( $key, $member );
413    
414    =cut
415    
416    sub sadd {
417            my ( $self, $key, $member ) = @_;
418            $self->_sock_send_bulk_number( 'SADD', $key, $member );
419    }
420    
421    =head2 srem
422    
423      $r->srem( $key, $member );
424    
425    =cut
426    
427    sub srem {
428            my ( $self, $key, $member ) = @_;
429            $self->_sock_send_bulk_number( 'SREM', $key, $member );
430    }
431    
432    =head2 scard
433    
434      my $elements = $r->scard( $key );
435    
436    =cut
437    
438    sub scard {
439            my ( $self, $key ) = @_;
440            $self->_sock_send( 'SCARD', $key );
441    }
442    
443    =head2 sismember
444    
445      $r->sismember( $key, $member );
446    
447    =cut
448    
449    sub sismember {
450            my ( $self, $key, $member ) = @_;
451            $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );
452    }
453    
454    =head2 sinter
455    
456      $r->sinter( $key1, $key2, ... );
457    
458    =cut
459    
460    sub sinter {
461            my $self = shift;
462            $self->_sock_result_bulk_list( 'SINTER', @_ );
463    }
464    
465    =head2 sinterstore
466    
467      my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
468    
469    =cut
470    
471    sub sinterstore {
472            my $self = shift;
473            $self->_sock_send_ok( 'SINTERSTORE', @_ );
474  }  }
475    
476  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.8  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26