/[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 21 by dpavlin, Sun Mar 22 10:36:22 2009 UTC revision 47 by dpavlin, Mon Mar 23 11:30:40 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 {  sub __sock_result {
57          my $result = <$sock>;          my $result = <$sock>;
58          warn "# result: ",dump( $result );          warn "## result: ",dump( $result ) if $debug;
59          $result =~ s{\r\n$}{} || warn "can't find cr/lf";          $result =~ s{\r\n$}{} || warn "can't find cr/lf";
60          return $result;          return $result;
61  }  }
62    
63  sub _sock_read_bulk {  sub __sock_read_bulk {
64          my $len = <$sock>;          my $len = <$sock>;
65          warn "## bulk len: ",dump($len);          warn "## bulk len: ",dump($len) if $debug;
66          return undef if $len eq "nil\r\n";          return undef if $len eq "nil\r\n";
67          my $v;          my $v;
68          read($sock, $v, $len) || die $!;          if ( $len > 0 ) {
69          warn "## bulk v: ",dump($v);                  read($sock, $v, $len) || die $!;
70                    warn "## bulk v: ",dump($v) if $debug;
71            }
72          my $crlf;          my $crlf;
73          read($sock, $crlf, 2); # skip cr/lf          read($sock, $crlf, 2); # skip cr/lf
74          return $v;          return $v;
# Line 72  sub _sock_read_bulk { Line 76  sub _sock_read_bulk {
76    
77  sub _sock_result_bulk {  sub _sock_result_bulk {
78          my $self = shift;          my $self = shift;
79          warn "## _sock_result_bulk ",dump( @_ );          warn "## _sock_result_bulk ",dump( @_ ) if $debug;
80          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
81          _sock_read_bulk();          __sock_read_bulk();
82  }  }
83    
84  sub _sock_ok {  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>;          my $ok = <$sock>;
103            return undef if $ok eq "nil\r\n";
104          confess dump($ok) unless $ok eq "+OK\r\n";          confess dump($ok) unless $ok eq "+OK\r\n";
105  }  }
106    
107  sub _sock_send {  sub _sock_send {
108          my $self = shift;          my $self = shift;
109          warn "## _sock_send ",dump( @_ );          warn "## _sock_send ",dump( @_ ) if $debug;
110          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
111          _sock_result();          __sock_result();
112  }  }
113    
114  sub _sock_send_ok {  sub _sock_send_ok {
115          my $self = shift;          my $self = shift;
116          warn "## _sock_send_ok ",dump( @_ );          warn "## _sock_send_ok ",dump( @_ ) if $debug;
117          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
118          _sock_ok();          __sock_ok();
119    }
120    
121    sub __sock_send_bulk_raw {
122            warn "## _sock_send_bulk ",dump( @_ ) if $debug;
123            my $value = pop;
124            $value = '' unless defined $value; # FIXME errr? nil?
125            print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
126  }  }
127    
128  sub _sock_send_bulk {  sub _sock_send_bulk {
129          my ( $self, $command, $key, $value ) = @_;          my $self = shift;
130          print $sock "$command $key " . length($value) . "\r\n$value\r\n";          __sock_send_bulk_raw( @_ );
131          _sock_ok();          __sock_ok();
132  }  }
133    
134    sub _sock_send_bulk_number {
135            my $self = shift;
136            __sock_send_bulk_raw( @_ );
137            my $v = __sock_result();
138            confess $v unless $v =~ m{^\-?\d+$};
139            return $v;
140    }
141    
142  =head1 Connection Handling  =head1 Connection Handling
143    
# Line 150  sub set { Line 186  sub set {
186    
187  sub get {  sub get {
188          my $self = shift;          my $self = shift;
189          $self->_sock_result_bulk('GET', @_);          $self->_sock_result_bulk('GET',@_);
190    }
191    
192    =head2 mget
193    
194      my @values = $r->get( 'foo', 'bar', 'baz' );
195    
196    =cut
197    
198    sub mget {
199            my $self = shift;
200            $self->_sock_result_bulk_list('MGET',@_);
201  }  }
202    
203  =head2 incr  =head2 incr
# Line 222  sub type { Line 269  sub type {
269    
270  sub keys {  sub keys {
271          my ( $self, $glob ) = @_;          my ( $self, $glob ) = @_;
272          return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob ));          my $keys = $self->_sock_result_bulk( 'KEYS', $glob );
273            return split(/\s/, $keys) if $keys;
274            return () if wantarray;
275  }  }
276    
277  =head2 randomkey  =head2 randomkey
# Line 260  sub dbsize { Line 309  sub dbsize {
309    
310  =head1 Commands operating on lists  =head1 Commands operating on lists
311    
312    See also L<Redis::List> for tie interface.
313    
314  =head2 rpush  =head2 rpush
315    
316    $r->rpush( $key, $value );    $r->rpush( $key, $value );
# Line 301  sub llen { Line 352  sub llen {
352    
353  sub lrange {  sub lrange {
354          my ( $self, $key, $start, $end ) = @_;          my ( $self, $key, $start, $end ) = @_;
355          my $size = $self->_sock_send('LRANGE', $key, $start, $end);          $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
356    }
357    
358          confess $size unless $size > 0;  =head2 ltrim
         $size--;  
359    
360          my @list = ( 0 .. $size );    my $ok = $r->ltrim( $key, $start, $end );
         foreach ( 0 .. $size ) {  
                 $list[ $_ ] = _sock_read_bulk();  
         }  
361    
362          warn "## lrange $key $start $end = [$size] ", dump( @list );  =cut
363          return @list;  
364    sub ltrim {
365            my ( $self, $key, $start, $end ) = @_;
366            $self->_sock_send_ok( 'LTRIM', $key, $start, $end );
367    }
368    
369    =head2 lindex
370    
371      $r->lindex( $key, $index );
372    
373    =cut
374    
375    sub lindex {
376            my ( $self, $key, $index ) = @_;
377            $self->_sock_result_bulk( 'LINDEX', $key, $index );
378    }
379    
380    =head2 lset
381    
382      $r->lset( $key, $index, $value );
383    
384    =cut
385    
386    sub lset {
387            my ( $self, $key, $index, $value ) = @_;
388            $self->_sock_send_bulk( 'LSET', $key, $index, $value );
389    }
390    
391    =head2 lrem
392    
393      my $modified_count = $r->lrem( $key, $count, $value );
394    
395    =cut
396    
397    sub lrem {
398            my ( $self, $key, $count, $value ) = @_;
399            $self->_sock_send_bulk_number( 'LREM', $key, $count, $value );
400    }
401    
402    =head2 lpop
403    
404      my $value = $r->lpop( $key );
405    
406    =cut
407    
408    sub lpop {
409            my ( $self, $key ) = @_;
410            $self->_sock_result_bulk( 'LPOP', $key );
411    }
412    
413    =head2 rpop
414    
415      my $value = $r->rpop( $key );
416    
417    =cut
418    
419    sub rpop {
420            my ( $self, $key ) = @_;
421            $self->_sock_result_bulk( 'RPOP', $key );
422    }
423    
424    =head1 Commands operating on sets
425    
426    =head2 sadd
427    
428      $r->sadd( $key, $member );
429    
430    =cut
431    
432    sub sadd {
433            my ( $self, $key, $member ) = @_;
434            $self->_sock_send_bulk_number( 'SADD', $key, $member );
435    }
436    
437    =head2 srem
438    
439      $r->srem( $key, $member );
440    
441    =cut
442    
443    sub srem {
444            my ( $self, $key, $member ) = @_;
445            $self->_sock_send_bulk_number( 'SREM', $key, $member );
446    }
447    
448    =head2 scard
449    
450      my $elements = $r->scard( $key );
451    
452    =cut
453    
454    sub scard {
455            my ( $self, $key ) = @_;
456            $self->_sock_send( 'SCARD', $key );
457    }
458    
459    =head2 sismember
460    
461      $r->sismember( $key, $member );
462    
463    =cut
464    
465    sub sismember {
466            my ( $self, $key, $member ) = @_;
467            $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );
468    }
469    
470    =head2 sinter
471    
472      $r->sinter( $key1, $key2, ... );
473    
474    =cut
475    
476    sub sinter {
477            my $self = shift;
478            $self->_sock_result_bulk_list( 'SINTER', @_ );
479    }
480    
481    =head2 sinterstore
482    
483      my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
484    
485    =cut
486    
487    sub sinterstore {
488            my $self = shift;
489            $self->_sock_send_ok( 'SINTERSTORE', @_ );
490    }
491    
492    =head1 Multiple databases handling commands
493    
494    =head2 select
495    
496      $r->select( $dbindex ); # 0 for new clients
497    
498    =cut
499    
500    sub select {
501            my ($self,$dbindex) = @_;
502            confess dump($dbindex) . 'not number' unless $dbindex =~ m{^\d+$};
503            $self->_sock_send_ok( 'SELECT', $dbindex );
504    }
505    
506    =head2 move
507    
508      $r->move( $key, $dbindex );
509    
510    =cut
511    
512    sub move {
513            my ( $self, $key, $dbindex ) = @_;
514            $self->_sock_send( 'MOVE', $key, $dbindex );
515    }
516    
517    =head2 flushdb
518    
519      $r->flushdb;
520    
521    =cut
522    
523    sub flushdb {
524            my $self = shift;
525            $self->_sock_send_ok('FLUSHDB');
526    }
527    
528    =head2 flushall
529    
530      $r->flushall;
531    
532    =cut
533    
534    sub flushall {
535            my $self = shift;
536            $self->_sock_send_ok('flushall');
537    }
538    
539    =head1 Sorting
540    
541      $r->sort("key BY pattern LIMIT start end GET pattern ASC|DESC ALPHA');
542    
543    =cut
544    
545    sub sort {
546            my ( $self, $sort ) = @_;
547            $self->_sock_result_bulk_list( "SORT $sort" );
548  }  }
549    
550  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.21  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26