/[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 32 by dpavlin, Sun Mar 22 17:06:34 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 53  sub new { Line 55  sub new {
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          if ( $len > 0 ) {          if ( $len > 0 ) {
69                  read($sock, $v, $len) || die $!;                  read($sock, $v, $len) || die $!;
70                  warn "## bulk v: ",dump($v);                  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
# Line 74  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_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 {  sub __sock_ok {
102          my $ok = <$sock>;          my $ok = <$sock>;
103          return undef if $ok eq "nil\r\n";          return undef if $ok eq "nil\r\n";
# Line 87  sub __sock_ok { Line 106  sub __sock_ok {
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 {  sub __sock_send_bulk_raw {
122          my $self = shift;          my $self = shift;
123          warn "## _sock_send_bulk ",dump( @_ );          warn "## _sock_send_bulk ",dump( @_ ) if $debug;
124          my $value = pop;          my $value = pop;
125          $value = '' unless defined $value; # FIXME errr? nil?          $value = '' unless defined $value; # FIXME errr? nil?
126          print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"          print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
# Line 276  sub dbsize { Line 295  sub dbsize {
295    
296  =head1 Commands operating on lists  =head1 Commands operating on lists
297    
298    See also L<Redis::List> for tie interface.
299    
300  =head2 rpush  =head2 rpush
301    
302    $r->rpush( $key, $value );    $r->rpush( $key, $value );
# Line 317  sub llen { Line 338  sub llen {
338    
339  sub lrange {  sub lrange {
340          my ( $self, $key, $start, $end ) = @_;          my ( $self, $key, $start, $end ) = @_;
341          my $size = $self->_sock_send('LRANGE', $key, $start, $end);          $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
   
         confess $size unless $size > 0;  
         $size--;  
   
         my @list = ( 0 .. $size );  
         foreach ( 0 .. $size ) {  
                 $list[ $_ ] = _sock_read_bulk();  
         }  
   
         warn "## lrange $key $start $end = [$size] ", dump( @list );  
         return @list;  
342  }  }
343    
344  =head2 ltrim  =head2 ltrim
# Line 443  sub sismember { Line 453  sub sismember {
453          $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );          $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
492    
493  Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
Legend:
Removed from v.32  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26