--- lib/Redis.pm 2009/03/21 23:05:02 10 +++ 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,12 +140,6 @@ =cut -sub sock_result { - my $result = <$sock>; - warn "# result: ",dump( $result ); - $result =~ s{\r\n$}{} || warn "can't find cr/lf"; - return $result; -} sub incr { @@ -134,7 +149,7 @@ } else { print $sock "INCR $key\r\n"; } - sock_result(); + _sock_result(); } =head2 decr @@ -151,7 +166,7 @@ } else { print $sock "DECR $key\r\n"; } - sock_result(); + _sock_result(); } =head2 exists @@ -163,7 +178,7 @@ sub exists { my ( $self, $key ) = @_; print $sock "EXISTS $key\r\n"; - sock_result(); + _sock_result(); } =head2 del @@ -175,7 +190,82 @@ sub del { my ( $self, $key ) = @_; print $sock "DEL $key\r\n"; - sock_result(); + _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