--- lib/Redis.pm 2009/03/21 23:39:20 15 +++ lib/Redis.pm 2009/03/22 13:09:15 23 @@ -58,23 +58,51 @@ 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"; + _sock_ok(); +} + + =head1 Connection Handling =head2 quit @@ -110,9 +138,8 @@ =cut sub set { - my ( $self, $k, $v, $new ) = @_; - print $sock "SET" . ( $new ? 'NX' : '' ) . " $k " . length($v) . "\r\n$v\r\n"; - _sock_ok(); + my ( $self, $key, $value, $new ) = @_; + $self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value ); } =head2 get @@ -122,9 +149,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 @@ -137,13 +163,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 @@ -154,13 +175,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 @@ -171,8 +187,7 @@ sub exists { my ( $self, $key ) = @_; - print $sock "EXISTS $key\r\n"; - _sock_result(); + $self->_sock_send( 'EXISTS', $key ); } =head2 del @@ -183,8 +198,7 @@ sub del { my ( $self, $key ) = @_; - print $sock "DEL $key\r\n"; - _sock_result(); + $self->_sock_send( 'DEL', $key ); } =head2 type @@ -195,8 +209,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 @@ -209,8 +222,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 @@ -221,8 +233,7 @@ sub randomkey { my ( $self ) = @_; - print $sock "RANDOMKEY\r\n"; - _sock_result(); + $self->_sock_send( 'RANDOMKEY' ); } =head2 rename @@ -233,10 +244,100 @@ 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 + + my $nr_keys = $r->dbsize; + +=cut + +sub dbsize { + my ( $self ) = @_; + $self->_sock_send('DBSIZE'); +} + +=head1 Commands operating on lists + +=head2 rpush + + $r->rpush( $key, $value ); + +=cut + +sub rpush { + my ( $self, $key, $value ) = @_; + $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 ); +} + + =head1 AUTHOR Dobrica Pavlinusic, C<< >>