--- lib/Redis.pm 2009/03/21 23:09:48 11 +++ lib/Redis.pm 2009/03/22 10:36:22 21 @@ -58,6 +58,51 @@ return $result; } +sub _sock_read_bulk { + my $len = <$sock>; + warn "## bulk len: ",dump($len); + return undef if $len eq "nil\r\n"; + my $v; + read($sock, $v, $len) || die $!; + 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 @@ -93,10 +138,8 @@ =cut sub set { - my ( $self, $k, $v, $new ) = @_; - print $sock ( $new ? "SETNX" : "SET" ) . " $k " . length($v) . "\r\n$v\r\n"; - my $ok = <$sock>; - confess dump($ok) unless $ok eq "+OK\r\n"; + my ( $self, $key, $value, $new ) = @_; + $self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value ); } =head2 get @@ -106,17 +149,8 @@ =cut sub get { - my ( $self, $k ) = @_; - print $sock "GET $k\r\n"; - my $len = <$sock>; -# warn "# len: ",dump($len); - return undef if $len eq "nil\r\n"; - my $v; - read($sock, $v, $len) || die $!; -# warn "# v: ",dump($v); - my $crlf; - read($sock, $crlf, 2); # skip cr/lf - return $v; + my $self = shift; + $self->_sock_result_bulk('GET', @_); } =head2 incr @@ -129,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 @@ -146,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 @@ -163,8 +187,7 @@ sub exists { my ( $self, $key ) = @_; - print $sock "EXISTS $key\r\n"; - _sock_result(); + $self->_sock_send( 'EXISTS', $key ); } =head2 del @@ -175,8 +198,7 @@ sub del { my ( $self, $key ) = @_; - print $sock "DEL $key\r\n"; - _sock_result(); + $self->_sock_send( 'DEL', $key ); } =head2 type @@ -187,8 +209,110 @@ 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 + +=head2 keys + + my @keys = $r->keys( '*glob_pattern*' ); + +=cut + +sub keys { + my ( $self, $glob ) = @_; + return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob )); +} + +=head2 randomkey + + my $key = $r->randomkey; + +=cut + +sub randomkey { + my ( $self ) = @_; + $self->_sock_send( 'RANDOMKEY' ); +} + +=head2 rename + + my $ok = $r->rename( 'old-key', 'new-key', $new ); + +=cut + +sub rename { + my ( $self, $old, $new, $nx ) = @_; + $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; } =head1 AUTHOR