File Coverage

blib/lib/App/Memcached/Tool/DataSource.pm

Criterion	Covered	Total	%
statement	17	60	28.3
branch	0	14	0.0
condition	0	2	0.0
subroutine	6	13	46.1
pod	0	5	0.0
total	23	94	24.4

package App::Memcached::Tool::DataSource;

use strict;
use warnings;
use 5.008_001;

use Carp;
use IO::Socket;

use App::Memcached::Tool::Util qw(is_unixsocket debug);

sub new {
    my $class = shift;
    my %args  = @_;
    bless \%args, $class;
}

sub connect {
    my $class = shift;
    my $addr  = shift;
    my %opts  = @_;

    my $socket = sub {
        return IO::Socket::UNIX->new(Peer => $addr) if is_unixsocket($addr);
        return IO::Socket::INET->new(
            PeerAddr => $addr,
            Proto    => 'tcp',
            Timeout  => $opts{timeout} || 5,
        );
    }->();
    confess "Can't connect to $addr" unless $socket;

    return $class->new(socket => $socket);
}

sub disconnect {
    my $self = shift;
    $self->{socket}->close or confess "Failed to close connection!";
    undef $self->{socket};
}

sub get {
    my $self = shift;
    my $key  = shift;

    my $socket = $self->{socket};
    print $socket "get $key\r\n";

    my %data = (key => $key);
    my $response = <$socket>;
    if ($response =~ m/VALUE \S+ (\d+) (\d+)/) {
        $data{flags}  = $1;
        $data{length} = $2;
        read $socket, $response, $data{length};
        $data{value} = $response;

        while ($response !~ m/^END/) { $response = <$socket>; }
    } else {
        warn "KEY $key not found in $response";
    }

    return \%data;
}

sub query {
    my $self  = shift;
    my $query = shift;

    my $socket = $self->{socket};
    print $socket "$query\r\n";

    my @response;
    while (<$socket>) {
        last if m/^END/;
        confess $_ if m/^SERVER_ERROR/;
        $_ =~ s/[\r\n]+$//;
        push @response, $_;
    }

    return \@response;
}

sub DESTROY {
    my $self = shift;
    if ($self->{socket}) { $self->{socket}->close; }
}

1;
__END__