--- lib/Redis.pm 2009/03/22 09:46:14 19 +++ lib/Redis.pm 2009/03/22 15:02:42 28 @@ -58,29 +58,66 @@ return $result; } -sub _sock_result_bulk { +sub _sock_read_bulk { my $len = <$sock>; - warn "# len: ",dump($len); + warn "## bulk len: ",dump($len); return undef if $len eq "nil\r\n"; my $v; - read($sock, $v, $len) || die $!; - warn "# v: ",dump($v); + if ( $len > 0 ) { + read($sock, $v, $len) || die $!; + warn "## bulk v: ",dump($v); + } my $crlf; read($sock, $crlf, 2); # skip cr/lf return $v; } -sub _sock_ok { +sub _sock_result_bulk { + my $self = shift; + warn "## _sock_result_bulk ",dump( @_ ); + print $sock join(' ',@_) . "\r\n"; + _sock_read_bulk(); +} + +sub __sock_ok { my $ok = <$sock>; + return undef if $ok eq "nil\r\n"; confess dump($ok) unless $ok eq "+OK\r\n"; } +sub _sock_send { + my $self = shift; + warn "## _sock_send ",dump( @_ ); + print $sock join(' ',@_) . "\r\n"; + _sock_result(); +} + +sub _sock_send_ok { + my $self = shift; + warn "## _sock_send_ok ",dump( @_ ); + print $sock join(' ',@_) . "\r\n"; + __sock_ok(); +} + +sub __sock_send_bulk_raw { + my $self = shift; + warn "## _sock_send_bulk ",dump( @_ ); + my $value = pop; + $value = '' unless defined $value; # FIXME errr? nil? + print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n" +} + sub _sock_send_bulk { - my ( $self, $command, $key, $value ) = @_; - print $sock "$command $key " . length($value) . "\r\n$value\r\n"; - _sock_ok(); + __sock_send_bulk_raw( @_ ); + __sock_ok(); } +sub _sock_send_bulk_number { + __sock_send_bulk_raw( @_ ); + my $v = _sock_result(); + confess $v unless $v =~ m{^\-?\d+$}; + return $v; +} =head1 Connection Handling @@ -128,9 +165,8 @@ =cut sub get { - my ( $self, $k ) = @_; - print $sock "GET $k\r\n"; - _sock_result_bulk(); + my $self = shift; + $self->_sock_result_bulk('GET', @_); } =head2 incr @@ -143,13 +179,8 @@ sub incr { - my ( $self, $key, $value ) = @_; - if ( defined $value ) { - print $sock "INCRBY $key $value\r\n"; - } else { - print $sock "INCR $key\r\n"; - } - _sock_result(); + my $self = shift; + $self->_sock_send( 'INCR' . ( $#_ ? 'BY' : '' ), @_ ); } =head2 decr @@ -160,13 +191,8 @@ =cut sub decr { - my ( $self, $key, $value ) = @_; - if ( defined $value ) { - print $sock "DECRBY $key $value\r\n"; - } else { - print $sock "DECR $key\r\n"; - } - _sock_result(); + my $self = shift; + $self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ ); } =head2 exists @@ -177,8 +203,7 @@ sub exists { my ( $self, $key ) = @_; - print $sock "EXISTS $key\r\n"; - _sock_result(); + $self->_sock_send( 'EXISTS', $key ); } =head2 del @@ -189,8 +214,7 @@ sub del { my ( $self, $key ) = @_; - print $sock "DEL $key\r\n"; - _sock_result(); + $self->_sock_send( 'DEL', $key ); } =head2 type @@ -201,8 +225,7 @@ sub type { my ( $self, $key ) = @_; - print $sock "TYPE $key\r\n"; - _sock_result(); + $self->_sock_send( 'TYPE', $key ); } =head1 Commands operating on the key space @@ -215,8 +238,7 @@ sub keys { my ( $self, $glob ) = @_; - print $sock "KEYS $glob\r\n"; - return split(/\s/, _sock_result_bulk()); + return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob )); } =head2 randomkey @@ -227,8 +249,7 @@ sub randomkey { my ( $self ) = @_; - print $sock "RANDOMKEY\r\n"; - _sock_result(); + $self->_sock_send( 'RANDOMKEY' ); } =head2 rename @@ -239,8 +260,7 @@ sub rename { my ( $self, $old, $new, $nx ) = @_; - print $sock "RENAME" . ( $nx ? 'NX' : '' ) . " $old $new\r\n"; - _sock_ok(); + $self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new ); } =head2 dbsize @@ -251,8 +271,7 @@ sub dbsize { my ( $self ) = @_; - print $sock "DBSIZE\r\n"; - _sock_result(); + $self->_sock_send('DBSIZE'); } =head1 Commands operating on lists @@ -279,6 +298,105 @@ $self->_sock_send_bulk('LPUSH', $key, $value); } +=head2 llen + + $r->llen( $key ); + +=cut + +sub llen { + my ( $self, $key ) = @_; + $self->_sock_send( 'LLEN', $key ); +} + +=head2 lrange + + my @list = $r->lrange( $key, $start, $end ); + +=cut + +sub lrange { + my ( $self, $key, $start, $end ) = @_; + my $size = $self->_sock_send('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; +} + +=head2 ltrim + + my $ok = $r->ltrim( $key, $start, $end ); + +=cut + +sub ltrim { + my ( $self, $key, $start, $end ) = @_; + $self->_sock_send_ok( 'LTRIM', $key, $start, $end ); +} + +=head2 lindex + + $r->lindex( $key, $index ); + +=cut + +sub lindex { + my ( $self, $key, $index ) = @_; + $self->_sock_result_bulk( 'LINDEX', $key, $index ); +} + +=head2 lset + + $r->lset( $key, $index, $value ); + +=cut + +sub lset { + my ( $self, $key, $index, $value ) = @_; + $self->_sock_send_bulk( 'LSET', $key, $index, $value ); +} + +=head2 lrem + + my $modified_count = $r->lrem( $key, $count, $value ); + +=cut + +sub lrem { + my ( $self, $key, $count, $value ) = @_; + $self->_sock_send_bulk_number( 'LREM', $key, $count, $value ); +} + +=head2 lpop + + my $value = $r->lpop( $key ); + +=cut + +sub lpop { + my ( $self, $key ) = @_; + $self->_sock_result_bulk( 'lpop', $key ); +} + +=head2 rpop + + my $value = $r->rpop( $key ); + +=cut + +sub rpop { + my ( $self, $key ) = @_; + $self->_sock_result_bulk( 'rpop', $key ); +} + =head1 AUTHOR Dobrica Pavlinusic, C<< >>