--- lib/Redis.pm 2009/03/21 22:38:56 7 +++ lib/Redis.pm 2009/03/22 09:44:30 18 @@ -51,6 +51,37 @@ $self; } +sub _sock_result { + my $result = <$sock>; + warn "# result: ",dump( $result ); + $result =~ s{\r\n$}{} || warn "can't find cr/lf"; + return $result; +} + +sub _sock_result_bulk { + 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; +} + +sub _sock_ok { + my $ok = <$sock>; + confess dump($ok) unless $ok eq "+OK\r\n"; +} + +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 @@ -86,10 +117,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 @@ -101,15 +130,7 @@ 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; + _sock_result_bulk(); } =head2 incr @@ -119,6 +140,8 @@ =cut + + sub incr { my ( $self, $key, $value ) = @_; if ( defined $value ) { @@ -126,9 +149,123 @@ } else { print $sock "INCR $key\r\n"; } - my $count = <$sock>; - warn "# $key = $count"; - return $count; + _sock_result(); +} + +=head2 decr + + $r->decr('counter'); + $r->decr('tripplets', 3); + +=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(); +} + +=head2 exists + + $r->exists( 'key' ) && print "got key!"; + +=cut + +sub exists { + my ( $self, $key ) = @_; + print $sock "EXISTS $key\r\n"; + _sock_result(); +} + +=head2 del + + $r->del( 'key' ) || warn "key doesn't exist"; + +=cut + +sub del { + my ( $self, $key ) = @_; + print $sock "DEL $key\r\n"; + _sock_result(); +} + +=head2 type + + $r->type( 'key' ); # = string + +=cut + +sub type { + my ( $self, $key ) = @_; + print $sock "TYPE $key\r\n"; + _sock_result(); +} + +=head1 Commands operating on the key space + +=head2 keys + + my @keys = $r->keys( '*glob_pattern*' ); + +=cut + +sub keys { + my ( $self, $glob ) = @_; + print $sock "KEYS $glob\r\n"; + return split(/\s/, _sock_result_bulk()); +} + +=head2 randomkey + + my $key = $r->randomkey; + +=cut + +sub randomkey { + my ( $self ) = @_; + print $sock "RANDOMKEY\r\n"; + _sock_result(); +} + +=head2 rename + + my $ok = $r->rename( 'old-key', 'new-key', $new ); + +=cut + +sub rename { + my ( $self, $old, $new, $nx ) = @_; + print $sock "RENAME" . ( $nx ? 'NX' : '' ) . " $old $new\r\n"; + _sock_ok(); +} + +=head2 dbsize + + my $nr_keys = $r->dbsize; + +=cut + +sub dbsize { + my ( $self ) = @_; + print $sock "DBSIZE\r\n"; + _sock_result(); +} + +=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); } =head1 AUTHOR