File Coverage

blib/lib/Cache/KyotoTycoon.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Cache::KyotoTycoon;
use strict;
use warnings;
use 5.008001;
our $VERSION = '0.15';
use Cache::KyotoTycoon::Cursor;
use TSVRPC::Client;
use Carp ();

sub _errmsg {
    my ($code, $msg) = @_;
    return "Cache::KyotoTycoon unexpected response code: $code $msg";
}

sub new {
    my $class = shift;
    my %args = @_==1 ? %{$_[0]} : @_;

    my $host = $args{host} || '127.0.0.1';
    my $port = $args{port} || 1978;
    my $db   = $args{db}   || 0;
    my $base = "http://${host}:${port}/rpc/";
    my $client = TSVRPC::Client->new(
        timeout    => exists( $args{timeout} ) ? $args{timeout} : 1,
        base       => $base,
    );
    my $self = bless {
        db        => $db,
        client    => $client,
    }, $class;
    return $self;
}

sub db {
    my $self = shift;
    $self->{db} = shift if @_;
    $self->{db};
}

sub make_cursor {
    my ($self, $cursor_id) = @_;
    return Cache::KyotoTycoon::Cursor->new($cursor_id, $self->{db}, $self->{client});
}

sub echo {
    my ($self, $args) = @_;
    my ($code, $body, $msg) = $self->{client}->call('echo', $args);
    Carp::croak _errmsg($code, $msg) if $code ne 200;
    return $body;
}

sub report {
    my ($self, ) = @_;
    my ($code, $body, $msg) = $self->{client}->call('report');
    Carp::croak _errmsg($code, $msg) if $code ne 200;
    return $body;
}

sub play_script {
    my ($self, $name, $input) = @_;
    my %args = (name => $name);
    while (my ($k, $v) = each %$input) {
        $args{"_$k"} = $v;
    }
    my ($code, $body, $msg) = $self->{client}->call('play_script', \%args);
    Carp::croak _errmsg($code, $msg) if $code ne 200;
    my %res;
    while (my ($k, $v) = each %$body) {
        $k =~ s!^_!!;
        $res{$k} = $v;
    }
    return \%res;
}

sub status {
    my ($self, ) = @_;
    my ($code, $body, $msg) = $self->{client}->call('status', {DB => $self->db});
    Carp::croak _errmsg($code, $msg) unless $code eq 200;
    return $body;
}

sub clear {
    my ($self, ) = @_;
    my %args = (DB => $self->db);
    my ($code, $body, $msg) = $self->{client}->call('clear', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq 200;
    return;
}

sub synchronize {
    my ($self, $hard, $command) = @_;
    my %args = (DB => $self->db);
    $args{hard} = $hard if $hard;
    $args{command} = $command if defined $command;
    my ($code, $body, $msg) = $self->{client}->call('synchronize', \%args);
    return 1 if $code eq 200;
    return 0 if $code eq 450;
    Carp::croak _errmsg($code, $msg);
}

sub set {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('set', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq 200;
    return;
}

sub add {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('add', \%args);
    return 1 if $code eq '200';
    return 0 if $code eq '450';
    Carp::croak _errmsg($code, $msg);
}

sub replace {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('replace', \%args);
    return 1 if $code eq '200';
    return 0 if $code eq '450';
    Carp::croak _errmsg($code, $msg);
}

sub append {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('append', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return;
}

sub increment {
    my ($self, $key, $num, $xt) = @_;
    my %args = (DB => $self->db, key => $key, num => $num);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('increment', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return $body->{num};
}

sub increment_double {
    my ($self, $key, $num, $xt) = @_;
    my %args = (DB => $self->db, key => $key, num => $num);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('increment_double', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return $body->{num};
}

sub cas {
    my ($self, $key, $oval, $nval, $xt) = @_;
    my %args = (DB => $self->db, key => $key);
    $args{oval} = $oval if defined $oval;
    $args{nval} = $nval if defined $nval;
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('cas', \%args);
    return 1 if $code eq '200';
    return 0 if $code eq '450';
    Carp::croak _errmsg($code, $msg);
}

sub remove {
    my ($self, $key) = @_;
    my %args = (DB => $self->db, key => $key);
    my ($code, $body, $msg) = $self->{client}->call('remove', \%args);
    return 1 if $code eq '200';
    return 0 if $code eq '450';
    Carp::croak _errmsg($code, $msg);
}

sub get {
    my ($self, $key) = @_;
    my %args = (DB => $self->db, key => $key);
    my ($code, $body, $msg) = $self->{client}->call('get', \%args);
    if ($code eq 450) {
        return; # no value for key
    } elsif ($code eq 200) {
        return wantarray ? ($body->{value}, $body->{xt}) : $body->{value};
    } else {
        Carp::croak _errmsg($code, $msg);
    }
}

sub set_bulk {
    my ($self, $vals, $xt) = @_;
    my %args = (DB => $self->db);
    while (my ($k, $v) = each %$vals) {
        $args{"_$k"} = $v;
    }
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('set_bulk', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return $body->{num};
}

sub remove_bulk {
    my ($self, $keys) = @_;
    my %args = (DB => $self->db);
    for my $k (@$keys) {
        $args{"_$k"} = '';
    }
    my ($code, $body, $msg) = $self->{client}->call('remove_bulk', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return $body->{num};
}

sub get_bulk {
    my ($self, $keys) = @_;
    my %args = (DB => $self->db);
    for my $k (@$keys) {
        $args{"_$k"} = '';
    }
    my ($code, $body, $msg) = $self->{client}->call('get_bulk', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    my %ret;
    while (my ($k, $v) = each %$body) {
        if ($k =~ /^_(.+)$/) {
            $ret{$1} = $v;
        }
    }
    die "fatal error" unless keys(%ret) == $body->{num};
    return wantarray ? %ret : \%ret;
}

sub vacuum {
    my ($self, $step) = @_;
    my %args = (DB => $self->db);
    if (defined $step) {
        $args{step} = $step;
    }
    my ($code, $body, $msg) = $self->{client}->call('vacuum', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return;
}

sub match_prefix {
    my ($self, $prefix, $max) = @_;
    my %args = (DB => $self->db, prefix => $prefix);
    $args{max} = $max if defined $max;
    my ($code, $body, $msg) = $self->{client}->call('match_prefix', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    my %ret;
    while (my ($k, $v) = each %$body) {
        if ($k =~ /^_(.+)$/) {
            $ret{$1} = $v;
        }
    }
    die "fatal error" unless keys(%ret) == $body->{num};
    return wantarray ? %ret : \%ret;
}

sub match_regex {
    my ($self, $regex, $max) = @_;
    my %args = (DB => $self->db, regex => $regex);
    $args{max} = $max if defined $max;
    my ($code, $body, $msg) = $self->{client}->call('match_regex', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    my %ret;
    while (my ($k, $v) = each %$body) {
        if ($k =~ /^_(.+)$/) {
            $ret{$1} = $v;
        }
    }
    die "fatal error" unless keys(%ret) == $body->{num};
    return wantarray ? %ret : \%ret;
}

sub match_similar {
    my ($self, $origin, $range, $utf8, $max) = @_;
    my %args = (DB => $self->db, origin => $origin);
    $args{range} = $max if defined $range;
    $args{utf}   = 1    if $utf8;
    $args{max}   = $max if defined $max;
    my ($code, $body, $msg) = $self->{client}->call('match_regex', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    my %ret;

    while (my ($k, $v) = each %$body) {
        if ($k =~ /^_(.+)$/) {
            $ret{$1} = $v;
        }
    }
    die "fatal error" unless keys(%ret) == $body->{num};
    return wantarray ? %ret : \%ret;
}

1;
__END__