X-Git-Url: http://git.rot13.org/?p=perl-Redis.git;a=blobdiff_plain;f=lib%2FRedis.pm;h=f0b21a28b0496ccf200e2a82bcbe1b0b3dd0f5a1;hp=d25a225d32f4d93dbfad30bfa314dfea519ea6cb;hb=889c043608d6efadbd7363e3e7fb3571ec8e15c6;hpb=233f624c856cc0828a100493ccc18f093e455412 diff --git a/lib/Redis.pm b/lib/Redis.pm index d25a225..f0b21a2 100644 --- a/lib/Redis.pm +++ b/lib/Redis.pm @@ -51,6 +51,25 @@ sub new { $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; +} + =head1 Connection Handling =head2 quit @@ -101,15 +120,7 @@ sub set { 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 +130,8 @@ sub get { =cut + + sub incr { my ( $self, $key, $value ) = @_; if ( defined $value ) { @@ -126,9 +139,7 @@ sub incr { } else { print $sock "INCR $key\r\n"; } - my $count = <$sock>; - warn "# $key = $count"; - return $count; + _sock_result(); } =head2 decr @@ -145,9 +156,57 @@ sub decr { } else { print $sock "DECR $key\r\n"; } - my $count = <$sock>; - warn "# $key = $count"; - return $count; + _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()); } =head1 AUTHOR