--- lib/Redis.pm 2009/03/22 09:44:30 18 +++ lib/Redis.pm 2009/03/22 13:18:11 24 @@ -58,26 +58,48 @@ 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); + warn "## bulk v: ",dump($v); my $crlf; read($sock, $crlf, 2); # skip cr/lf return $v; } +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>; 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 { - my ( $self, $command, $key, $value ) = @_; - print $sock "$command $key " . length($value) . "\r\n$value\r\n"; + my $self = shift; + my $value = pop; + print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"; _sock_ok(); } @@ -128,9 +150,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 +164,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 +176,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 +188,7 @@ sub exists { my ( $self, $key ) = @_; - print $sock "EXISTS $key\r\n"; - _sock_result(); + $self->_sock_send( 'EXISTS', $key ); } =head2 del @@ -189,8 +199,7 @@ sub del { my ( $self, $key ) = @_; - print $sock "DEL $key\r\n"; - _sock_result(); + $self->_sock_send( 'DEL', $key ); } =head2 type @@ -201,8 +210,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 +223,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 +234,7 @@ sub randomkey { my ( $self ) = @_; - print $sock "RANDOMKEY\r\n"; - _sock_result(); + $self->_sock_send( 'RANDOMKEY' ); } =head2 rename @@ -239,8 +245,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 +256,7 @@ sub dbsize { my ( $self ) = @_; - print $sock "DBSIZE\r\n"; - _sock_result(); + $self->_sock_send('DBSIZE'); } =head1 Commands operating on lists @@ -268,6 +272,83 @@ $self->_sock_send_bulk('RPUSH', $key, $value); } +=head2 lpush + + $r->lpush( $key, $value ); + +=cut + +sub lpush { + my ( $self, $key, $value ) = @_; + $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 ); +} + =head1 AUTHOR Dobrica Pavlinusic, C<< >>