/[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 7 by dpavlin, Sat Mar 21 22:38:56 2009 UTC revision 38 by dpavlin, Sun Mar 22 18:17:05 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
33    
34  =cut  =cut
35    
36    our $debug = $ENV{REDIS} || 0;
37    
38  our $sock;  our $sock;
39  my $server = '127.0.0.1:6379';  my $server = '127.0.0.1:6379';
40    
# Line 51  sub new { Line 53  sub new {
53          $self;          $self;
54  }  }
55    
56    sub _sock_result {
57            my $result = <$sock>;
58            warn "## result: ",dump( $result ) if $debug;
59            $result =~ s{\r\n$}{} || warn "can't find cr/lf";
60            return $result;
61    }
62    
63    sub _sock_read_bulk {
64            my $len = <$sock>;
65            warn "## bulk len: ",dump($len) if $debug;
66            return undef if $len eq "nil\r\n";
67            my $v;
68            if ( $len > 0 ) {
69                    read($sock, $v, $len) || die $!;
70                    warn "## bulk v: ",dump($v) if $debug;
71            }
72            my $crlf;
73            read($sock, $crlf, 2); # skip cr/lf
74            return $v;
75    }
76    
77    sub _sock_result_bulk {
78            my $self = shift;
79            warn "## _sock_result_bulk ",dump( @_ ) if $debug;
80            print $sock join(' ',@_) . "\r\n";
81            _sock_read_bulk();
82    }
83    
84    sub _sock_result_bulk_list {
85            my $self = shift;
86            warn "## _sock_result_bulk_list ",dump( @_ ) if $debug;
87    
88            my $size = $self->_sock_send( @_ );
89            confess $size unless $size > 0;
90            $size--;
91    
92            my @list = ( 0 .. $size );
93            foreach ( 0 .. $size ) {
94                    $list[ $_ ] = _sock_read_bulk();
95            }
96    
97            warn "## list = ", dump( @list ) if $debug;
98            return @list;
99    }
100    
101    sub __sock_ok {
102            my $ok = <$sock>;
103            return undef if $ok eq "nil\r\n";
104            confess dump($ok) unless $ok eq "+OK\r\n";
105    }
106    
107    sub _sock_send {
108            my $self = shift;
109            warn "## _sock_send ",dump( @_ ) if $debug;
110            print $sock join(' ',@_) . "\r\n";
111            _sock_result();
112    }
113    
114    sub _sock_send_ok {
115            my $self = shift;
116            warn "## _sock_send_ok ",dump( @_ ) if $debug;
117            print $sock join(' ',@_) . "\r\n";
118            __sock_ok();
119    }
120    
121    sub __sock_send_bulk_raw {
122            my $self = shift;
123            warn "## _sock_send_bulk ",dump( @_ ) if $debug;
124            my $value = pop;
125            $value = '' unless defined $value; # FIXME errr? nil?
126            print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
127    }
128    
129    sub _sock_send_bulk {
130            __sock_send_bulk_raw( @_ );
131            __sock_ok();
132    }
133    
134    sub _sock_send_bulk_number {
135            __sock_send_bulk_raw( @_ );
136            my $v = _sock_result();
137            confess $v unless $v =~ m{^\-?\d+$};
138            return $v;
139    }
140    
141  =head1 Connection Handling  =head1 Connection Handling
142    
143  =head2 quit  =head2 quit
# Line 86  sub ping { Line 173  sub ping {
173  =cut  =cut
174    
175  sub set {  sub set {
176          my ( $self, $k, $v, $new ) = @_;          my ( $self, $key, $value, $new ) = @_;
177          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";  
178  }  }
179    
180  =head2 get  =head2 get
# Line 99  sub set { Line 184  sub set {
184  =cut  =cut
185    
186  sub get {  sub get {
187          my ( $self, $k ) = @_;          my $self = shift;
188          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;  
189  }  }
190    
191  =head2 incr  =head2 incr
# Line 119  sub get { Line 195  sub get {
195    
196  =cut  =cut
197    
198            
199    
200  sub incr {  sub incr {
201            my $self = shift;
202            $self->_sock_send( 'INCR' . ( $#_ ? 'BY' : '' ), @_ );
203    }
204    
205    =head2 decr
206    
207      $r->decr('counter');
208      $r->decr('tripplets', 3);
209    
210    =cut
211    
212    sub decr {
213            my $self = shift;
214            $self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ );
215    }
216    
217    =head2 exists
218    
219      $r->exists( 'key' ) && print "got key!";
220    
221    =cut
222    
223    sub exists {
224            my ( $self, $key ) = @_;
225            $self->_sock_send( 'EXISTS', $key );
226    }
227    
228    =head2 del
229    
230      $r->del( 'key' ) || warn "key doesn't exist";
231    
232    =cut
233    
234    sub del {
235            my ( $self, $key ) = @_;
236            $self->_sock_send( 'DEL', $key );
237    }
238    
239    =head2 type
240    
241      $r->type( 'key' ); # = string
242    
243    =cut
244    
245    sub type {
246            my ( $self, $key ) = @_;
247            $self->_sock_send( 'TYPE', $key );
248    }
249    
250    =head1 Commands operating on the key space
251    
252    =head2 keys
253    
254      my @keys = $r->keys( '*glob_pattern*' );
255    
256    =cut
257    
258    sub keys {
259            my ( $self, $glob ) = @_;
260            return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob ));
261    }
262    
263    =head2 randomkey
264    
265      my $key = $r->randomkey;
266    
267    =cut
268    
269    sub randomkey {
270            my ( $self ) = @_;
271            $self->_sock_send( 'RANDOMKEY' );
272    }
273    
274    =head2 rename
275    
276      my $ok = $r->rename( 'old-key', 'new-key', $new );
277    
278    =cut
279    
280    sub rename {
281            my ( $self, $old, $new, $nx ) = @_;
282            $self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new );
283    }
284    
285    =head2 dbsize
286    
287      my $nr_keys = $r->dbsize;
288    
289    =cut
290    
291    sub dbsize {
292            my ( $self ) = @_;
293            $self->_sock_send('DBSIZE');
294    }
295    
296    =head1 Commands operating on lists
297    
298    See also L<Redis::List> for tie interface.
299    
300    =head2 rpush
301    
302      $r->rpush( $key, $value );
303    
304    =cut
305    
306    sub rpush {
307          my ( $self, $key, $value ) = @_;          my ( $self, $key, $value ) = @_;
308          if ( defined $value ) {          $self->_sock_send_bulk('RPUSH', $key, $value);
309                  print $sock "INCRBY $key $value\r\n";  }
310          } else {  
311                  print $sock "INCR $key\r\n";  =head2 lpush
312          }  
313          my $count = <$sock>;    $r->lpush( $key, $value );
314          warn "# $key = $count";  
315          return $count;  =cut
316    
317    sub lpush {
318            my ( $self, $key, $value ) = @_;
319            $self->_sock_send_bulk('LPUSH', $key, $value);
320    }
321    
322    =head2 llen
323    
324      $r->llen( $key );
325    
326    =cut
327    
328    sub llen {
329            my ( $self, $key ) = @_;
330            $self->_sock_send( 'LLEN', $key );
331    }
332    
333    =head2 lrange
334    
335      my @list = $r->lrange( $key, $start, $end );
336    
337    =cut
338    
339    sub lrange {
340            my ( $self, $key, $start, $end ) = @_;
341            $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
342    }
343    
344    =head2 ltrim
345    
346      my $ok = $r->ltrim( $key, $start, $end );
347    
348    =cut
349    
350    sub ltrim {
351            my ( $self, $key, $start, $end ) = @_;
352            $self->_sock_send_ok( 'LTRIM', $key, $start, $end );
353    }
354    
355    =head2 lindex
356    
357      $r->lindex( $key, $index );
358    
359    =cut
360    
361    sub lindex {
362            my ( $self, $key, $index ) = @_;
363            $self->_sock_result_bulk( 'LINDEX', $key, $index );
364    }
365    
366    =head2 lset
367    
368      $r->lset( $key, $index, $value );
369    
370    =cut
371    
372    sub lset {
373            my ( $self, $key, $index, $value ) = @_;
374            $self->_sock_send_bulk( 'LSET', $key, $index, $value );
375    }
376    
377    =head2 lrem
378    
379      my $modified_count = $r->lrem( $key, $count, $value );
380    
381    =cut
382    
383    sub lrem {
384            my ( $self, $key, $count, $value ) = @_;
385            $self->_sock_send_bulk_number( 'LREM', $key, $count, $value );
386    }
387    
388    =head2 lpop
389    
390      my $value = $r->lpop( $key );
391    
392    =cut
393    
394    sub lpop {
395            my ( $self, $key ) = @_;
396            $self->_sock_result_bulk( 'LPOP', $key );
397    }
398    
399    =head2 rpop
400    
401      my $value = $r->rpop( $key );
402    
403    =cut
404    
405    sub rpop {
406            my ( $self, $key ) = @_;
407            $self->_sock_result_bulk( 'RPOP', $key );
408    }
409    
410    =head1 Commands operating on sets
411    
412    =head2 sadd
413    
414      $r->sadd( $key, $member );
415    
416    =cut
417    
418    sub sadd {
419            my ( $self, $key, $member ) = @_;
420            $self->_sock_send_bulk_number( 'SADD', $key, $member );
421    }
422    
423    =head2 srem
424    
425      $r->srem( $key, $member );
426    
427    =cut
428    
429    sub srem {
430            my ( $self, $key, $member ) = @_;
431            $self->_sock_send_bulk_number( 'SREM', $key, $member );
432    }
433    
434    =head2 scard
435    
436      my $elements = $r->scard( $key );
437    
438    =cut
439    
440    sub scard {
441            my ( $self, $key ) = @_;
442            $self->_sock_send( 'SCARD', $key );
443    }
444    
445    =head2 sismember
446    
447      $r->sismember( $key, $member );
448    
449    =cut
450    
451    sub sismember {
452            my ( $self, $key, $member ) = @_;
453            $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );
454    }
455    
456    =head2 sinter
457    
458      $r->sinter( $key1, $key2, ... );
459    
460    =cut
461    
462    sub sinter {
463            my $self = shift;
464            $self->_sock_result_bulk_list( 'SINTER', @_ );
465    }
466    
467    =head2 sinterstore
468    
469      my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
470    
471    =cut
472    
473    sub sinterstore {
474            my $self = shift;
475            $self->_sock_send_ok( 'SINTERSTORE', @_ );
476    }
477    
478    =head1 Multiple databases handling commands
479    
480    =head2 select
481    
482      $r->select( 1 );
483    
484    =cut
485    
486    sub select {
487            my ($self,$index) = @_;
488            $self->_sock_send_ok( 'SELECT', $index );
489  }  }
490    
491  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.7  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26