--- lib/Redis.pm 2009/03/24 23:43:24 55 +++ lib/Redis.pm 2009/09/12 15:08:59 61 @@ -13,14 +13,14 @@ =cut -our $VERSION = '0.08'; +our $VERSION = '0.0801'; =head1 DESCRIPTION Pure perl bindings for L -This version support git version 0.08 of Redis available at +This version support git version 0.08 or later of Redis available at L @@ -34,27 +34,23 @@ =head2 new - my $r = Redis->new; + my $r = Redis->new; # $ENV{REDIS_SERVER} or 127.0.0.1:6379 -=cut - -our $debug = $ENV{REDIS} || 0; + my $r = Redis->new( server => '192.168.0.1:6379', debug = 0 ); -our $sock; -my $server = '127.0.0.1:6379'; +=cut sub new { my $class = shift; - my $self = {}; - bless($self, $class); + my $self = {@_}; + $self->{debug} ||= $ENV{REDIS_DEBUG}; - warn "# opening socket to $server"; - - $sock ||= IO::Socket::INET->new( - PeerAddr => $server, + $self->{sock} = IO::Socket::INET->new( + PeerAddr => $self->{server} || $ENV{REDIS_SERVER} || '127.0.0.1:6379', Proto => 'tcp', ) || die $!; + bless($self, $class); $self; } @@ -74,10 +70,12 @@ sub AUTOLOAD { my $self = shift; + my $sock = $self->{sock} || die "no server connected"; + my $command = $AUTOLOAD; $command =~ s/.*://; - warn "## $command ",dump(@_) if $debug; + warn "## $command ",dump(@_) if $self->{debug}; my $send; @@ -101,7 +99,7 @@ ; } - warn ">> $send" if $debug; + warn ">> $send" if $self->{debug}; print $sock $send; if ( $command eq 'quit' ) { @@ -110,19 +108,19 @@ } my $result = <$sock> || die "can't read socket: $!"; - warn "<< $result" if $debug; + warn "<< $result" if $self->{debug}; my $type = substr($result,0,1); $result = substr($result,1,-2); if ( $command eq 'info' ) { my $hash; - foreach my $l ( split(/\r\n/, __sock_read_bulk($result) ) ) { + foreach my $l ( split(/\r\n/, $self->__read_bulk($result) ) ) { my ($n,$v) = split(/:/, $l, 2); $hash->{$n} = $v; } return $hash; } elsif ( $command eq 'keys' ) { - my $keys = __sock_read_bulk($result); + my $keys = $self->__read_bulk($result); return split(/\s/, $keys) if $keys; return; } @@ -132,42 +130,43 @@ } elsif ( $type eq '+' ) { return $result; } elsif ( $type eq '$' ) { - return __sock_read_bulk($result); + return $self->__read_bulk($result); } elsif ( $type eq '*' ) { - return __sock_read_multi_bulk($result); + return $self->__read_multi_bulk($result); } elsif ( $type eq ':' ) { return $result; # FIXME check if int? } else { - confess "unknown type: $type", __sock_read_line(); + confess "unknown type: $type", $self->__read_line(); } } -sub __sock_read_bulk { - my $len = shift; +sub __read_bulk { + my ($self,$len) = @_; return undef if $len < 0; my $v; if ( $len > 0 ) { - read($sock, $v, $len) || die $!; - warn "<< ",dump($v),$/ if $debug; + read($self->{sock}, $v, $len) || die $!; + warn "<< ",dump($v),$/ if $self->{debug}; } my $crlf; - read($sock, $crlf, 2); # skip cr/lf + read($self->{sock}, $crlf, 2); # skip cr/lf return $v; } -sub __sock_read_multi_bulk { - my $size = shift; +sub __read_multi_bulk { + my ($self,$size) = @_; return undef if $size < 0; + my $sock = $self->{sock}; $size--; my @list = ( 0 .. $size ); foreach ( 0 .. $size ) { - $list[ $_ ] = __sock_read_bulk( substr(<$sock>,1,-2) ); + $list[ $_ ] = $self->__read_bulk( substr(<$sock>,1,-2) ); } - warn "## list = ", dump( @list ) if $debug; + warn "## list = ", dump( @list ) if $self->{debug}; return @list; }