File Coverage

blib/lib/Jubatus/Common/Client.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 Jubatus::Common::Client;

use strict;
use warnings;
use utf8;
use autodie;

use Try::Lite;
use AnyEvent::MPRPC;

use Jubatus::Common::Types;

sub new {
    my ($class, $host, $port, $name, $timeout) = @_;
    $timeout = 10 unless ((defined $timeout) && ($timeout >= 0));
    my $hash = {
        "host" => $host, # hostname of jubatus server
        "port" => $port, # port number of jubatus server
        "name" => $name, # name of jubatus application
        "client" => AnyEvent::MPRPC::Client->new( # MPRPC client
            'host' => $host,
            'port' => $port,
            "on_error" => sub { # to wrap an error handle
                my ($hdl, $fatal, $msg) = @_;
                $hdl->destroy;
                _error_handler($msg);
            },
            "timeout" => $timeout, # default time out = 10 sec
        ),
    };
    bless $hash, $class;
}

# Replace the naive error message with readable error message
sub _error_handler {
    my ($e) = @_;
    if ($e == 1) {
        Jubatus::Common::Exception->show("Unknown method exception : $e");
    } elsif ($e == 2) {
        Jubatus::Common::Exception->show("API mismatch exception : $e");
    } else {
        Jubatus::Common::Exception->show("Something RPC exception : $e");
    }
    return;
}

# Wrap AnyEvent::MPRPC::Client->call() to reduce $name from argument values
sub _call {
    my ($self, $method, $ret_type, $args, $arg_types) = @_;
    my $res;
    # Chek matching of argument types and the types of argument value
    if (Jubatus::Common::Types::compare_element_num($args, $arg_types, "Array")) {
        my $name = $self->{name} || "";
        my $values = [$name];
        for (my $i = 0; $i <= $#$args; $i++) { # zip()
            my $arg = $args->[$i];
            my $arg_type = $arg_types->[$i];
            push @{$values}, $arg_type->to_msgpack($arg); # to_msgpackがtype checkする
        }
        eval {
            try {
                # {client}->handler->**で諸々設定できる。
                my $retval = $self->{client}->call($method, $values)->recv;
                if ((defined $retval) && (defined $ret_type)) {
                    $res = $ret_type->from_msgpack($retval); # from_msgpackがtype checkする
                }
            } (
                "*" => sub { Jubatus::Common::Exception->show($@); },
            );
        }; if ($@) { Jubatus::Common::Exception->show($@); }
    }
    return $res;
}

# Get AnyEvent::MPRPC::Client instance
sub get_client {
    my ($self) = @_;
    return $self->{client};
}

# Get JSON configure data from Jubatus server
sub get_config {
    my ($self) = @_;
    my $retval = $self->_call("get_config",
                              Jubatus::Common::TString->new(),
                              [],
                              [],);
    return $retval;
}

# Get JSON status data from Jubatus server
sub get_status {
    my ($self) = @_;
    my $retval = $self->_call("get_status",
                              Jubatus::Common::TMap->new(
                                  Jubatus::Common::TString->new(),
                                  Jubatus::Common::TMap->new(
                                      Jubatus::Common::TString->new(),
                                      Jubatus::Common::TString->new(),
                                  ),
                              ),
                              [],
                              [],);
    return $retval;
}

# Dump the model data from current Jubatus server process
sub save {
    my ($self, $id) = @_;
    my $retval = $self->_call("save",
                              Jubatus::Common::TBool->new(),
                              [$id],
                              [Jubatus::Common::TString->new()]);
    return $retval;
}

# Load the model data to current Jubatus server process
sub load {
    my ($self, $id) = @_;
    my $retval = $self->_call("load",
                              Jubatus::Common::TBool->new(),
                              [$id],
                              [Jubatus::Common::TString->new()]);
    return $retval;
}

1;

__END__