Tie-Redis
view release on metacpan or search on metacpan
lib/Tie/Redis/Connection.pm view on Meta::CPAN
package Tie::Redis::Connection;
{
$Tie::Redis::Connection::VERSION = '0.26';
}
# ABSTRACT: Connection to Redis
use strict;
use warnings;
use IO::Socket::IP;
use Protocol::Redis;
use Carp ();
use constant DEBUG => $ENV{TIE_REDIS_DEBUG};
use constant PR_CLASS => eval { require Protocol::Redis::XS; 1 }
? "Protocol::Redis::XS" : "Protocol::Redis";
our $AUTOLOAD;
sub new {
my($class, %args) = @_;
my $host = delete $args{host} || 'localhost';
my $port = delete $args{port} || 6379;
if (my $encoding = $args{encoding}) {
$args{encoding} = Encode::find_encoding($encoding);
Carp::croak qq{Encoding "$encoding" not found} unless ref $args{encoding};
}
bless {
_sock => (IO::Socket::IP->new("$host:$port") || return),
_pr => PR_CLASS->new(api => 1),
host => $host,
port => $port,
%args,
}, $class;
}
sub DESTROY {
close shift->{_sock};
}
sub AUTOLOAD {
my $self = shift;
(my $method = $AUTOLOAD) =~ s/.*:://;
$self->_cmd($method, @_);
}
sub _cmd {
my($self, $cmd, @args) = @_;
warn "TR>> $cmd @args\n" if DEBUG;
$self->{_sock}->syswrite(
$self->{_pr}->encode({type => "*", data => [
map +{ type => '$', data => $_ }, $cmd, @args
]})
) or return;
my $message;
do {
$self->{_sock}->sysread(my $buf, 8192) or return;
$self->{_pr}->parse($buf);
$message = $self->{_pr}->get_message;
} while not $message;
if($message->{type} eq '*') {
warn "TR<< ", (join " ", map $_->{data}, @{$message->{data}}), "\n" if DEBUG;
my @data = map $_->{data}, @{$message->{data}};
wantarray ? @data : \@data;
} elsif($message->{type} eq '-') {
Carp::croak "$cmd: " . $message->{data};
} else {
warn "TR<< $message->{data}\n" if DEBUG;
$message->{data};
}
}
1;
__END__
=pod
=head1 NAME
Tie::Redis::Connection - Connection to Redis
=head1 VERSION
version 0.26
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
( run in 0.317 second using v1.01-cache-2.11-cpan-3989ada0592 )