/[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 35 by dpavlin, Sun Mar 22 17:53:57 2009 UTC
# Line 63  sub _sock_read_bulk { Line 63  sub _sock_read_bulk {
63          warn "## bulk 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 "## bulk 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;
# Line 77  sub _sock_result_bulk { Line 79  sub _sock_result_bulk {
79          _sock_read_bulk();          _sock_read_bulk();
80  }  }
81    
82  sub _sock_ok {  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    
# Line 93  sub _sock_send_ok { Line 113  sub _sock_send_ok {
113          my $self = shift;          my $self = shift;
114          warn "## _sock_send_ok ",dump( @_ );          warn "## _sock_send_ok ",dump( @_ );
115          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
116          _sock_ok();          __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 260  sub dbsize { Line 293  sub dbsize {
293    
294  =head1 Commands operating on lists  =head1 Commands operating on lists
295    
296    See also L<Redis::List> for tie interface.
297    
298  =head2 rpush  =head2 rpush
299    
300    $r->rpush( $key, $value );    $r->rpush( $key, $value );
# Line 301  sub llen { Line 336  sub llen {
336    
337  sub lrange {  sub lrange {
338          my ( $self, $key, $start, $end ) = @_;          my ( $self, $key, $start, $end ) = @_;
339          my $size = $self->_sock_send('LRANGE', $key, $start, $end);          $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
340    }
341    
342          confess $size unless $size > 0;  =head2 ltrim
         $size--;  
343    
344          my @list = ( 0 .. $size );    my $ok = $r->ltrim( $key, $start, $end );
         foreach ( 0 .. $size ) {  
                 $list[ $_ ] = _sock_read_bulk();  
         }  
345    
346          warn "## lrange $key $start $end = [$size] ", dump( @list );  =cut
347          return @list;  
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.21  
changed lines
  Added in v.35
  ViewVC Help
Powered by ViewVC 1.1.26