File Coverage

blib/lib/XAS/Lib/RPC/JSON/Server.pm

Criterion	Covered	Total	%
statement	15	94	15.9
branch	0	20	0.0
condition			n/a
subroutine	5	17	29.4
pod	4	4	100.0
total	24	135	17.7

package XAS::Lib::RPC::JSON::Server;

our $VERSION = '0.04';

use POE;
use Try::Tiny;
use Set::Light;

use XAS::Class
  debug     => 0,
  version   => $VERSION,
  base      => 'XAS::Lib::Net::Server',
  utils     => ':validation dotid',
  accessors => 'methods',
  codec     => 'JSON',
  constants => 'HASH ARRAY :jsonrpc ARRAYREF HASHREF',
;

my $ERRORS = {
    '-32700' => 'Parse Error',
    '-32600' => 'Invalid Request',
    '-32601' => 'Method not Found',
    '-32602' => 'Invalid Params',
    '-32603' => 'Internal Error',
    '-32099' => 'Server Error',
    '-32001' => 'App Error',
};

use Data::Dumper;

# ----------------------------------------------------------------------
# Public Methods
# ----------------------------------------------------------------------

sub process_request {
    my $self = shift;
    my ($input, $ctx) = validate_params(\@_, [
        1,
        { type => HASHREF }
    ]);

    my $request;
    my $alias = $self->alias;

    $self->log->debug("$alias: entering process_request");
    $self->log->debug(Dumper($input));

    try {

        $request = decode($input);

        if (ref($request) eq ARRAY) {

            foreach my $r (@$request) {

                $self->_rpc_request($r, $ctx);

            }

        } else {

            $self->_rpc_request($request, $ctx);

        }

    } catch {

        my $ex = $_;

        $self->log->error(Dumper($input));
        $self->exception_handler($ex);

    };

}

sub process_response {
    my $self = shift;
    my ($output, $ctx) = validate_params(\@_, [
        1,
        { type => HASHREF }
    ]);

    my $json;
    my $alias = $self->alias;

    $self->log->debug("$alias: entering process_response");

    $json = $self->_rpc_result($ctx->{'id'}, $output);

    $poe_kernel->post($alias, 'client_output', encode($json), $ctx);

}

sub process_errors {
    my $self = shift;
    my ($error, $ctx) = validate_params(\@_, [
        { type => HASHREF },
        { type => HASHREF }
    ]);

    my $json;
    my $alias = $self->alias;

    $self->log->debug("$alias: entering process_errors");

    $json = $self->_rpc_error($ctx->{'id'}, $error->{'code'}, $error->{'message'});

    $poe_kernel->post($alias, 'client_output', encode($json), $ctx);

}

# ----------------------------------------------------------------------
# Private Methods
# ----------------------------------------------------------------------

sub _rpc_exception_handler {
    my $self = shift;
    my ($ex, $id) = validate_params(\@_, [1,1]);

    my $packet;
    my $ref = ref($ex);

    if ($ref) {

        if ($ex->isa('XAS::Exception')) {

            my $type = $ex->type;
            my $info = $ex->info;

            if ($type =~ /server\.rpc_method$/) {

                $packet = $self->_rpc_error($id, RPC_ERR_METHOD, $info);

            } elsif ($type =~ /server\.rpc_version$/) {

                $packet = $self->_rpc_error($id, RPC_ERR_REQ, $info);

            } elsif ($type =~ /server\.rpc_format$/) {

                $packet = $self->_rpc_error($id, RPC_ERR_PARSE, $info);

            } elsif ($type =~ /server\.rpc_notify$/) {

                $packet = $self->_rpc_error($id, RPC_ERR_INTERNAL, $info);

            } else {

                my $msg = $type . ' - ' . $info;
                $packet = $self->_rpc_error($id, RPC_ERR_APP, $msg);

            }

            $self->log->error_msg('exception', $type, $info);

        } else {

            my $msg = sprintf("%s", $ex);

            $packet = $self->_rpc_error($id, RPC_ERR_SERVER, $msg);
            $self->log->error_msg('unexpected', $msg);

        }

    } else {

        my $msg = sprintf("%s", $ex);

        $packet = $self->_rpc_error($id, RPC_ERR_APP, $msg);
        $self->log->error_msg('unexpected', $msg);

    }

    return $packet;

}

sub _rpc_request {
    my $self = shift;
    my ($request, $ctx) = validate_params(\@_, [
        { type => HASHREF },
        { type => HASHREF },
    ]);

    my $method;
    my $alias = $self->alias;

    try {

        if ($request->{'jsonrpc'} ne RPC_JSON) {

            $self->throw_msg(
                dotid($self->class) . '.server.rpc_version',
                'json_rpc_version'
            );

        }

        unless (defined($request->{'id'})) {

            $self->throw_msg(
                dotid($self->class) . '.server.rpc_notify',
                'json_rpc_notify'
            );

        }

        if ($self->methods->has($request->{'method'})) {

            $ctx->{'id'} = $request->{'id'};
            $self->log->debug("$alias: performing \"" . $request->{'method'} . '"');

            $poe_kernel->post($alias, $request->{'method'}, $request->{'params'}, $ctx);

        } else {

            $self->throw_msg(
                dotid($self->class) . '.server.rpc_method',
                'json_rpc_method',
                $request->{'method'}
            );

        }

    } catch {

        my $ex = $_;

        my $output = $self->_rpc_exception_handler($ex, $request->{'id'});
        $poe_kernel->post($alias, 'client_output', encode($output), $ctx);

    };

}

sub _rpc_error {
    my $self = shift;
    my ($id, $code, $message) = validate_params(\@_, [1,1,1]);

    return {
        jsonrpc => RPC_JSON,
        id      => $id,
        error   => {
            code    => $code,
            message => $ERRORS->{$code},
            data    => $message
        }
    };

}

sub _rpc_result {
    my $self = shift;
    my ($id, $result) = validate_params(\@_, [1,1]);

    return {
        jsonrpc => RPC_JSON,
        id      => $id,
        result  => $result
    };

}

sub init {
    my $class = shift;

    my $self = $class->SUPER::init(@_);

    $self->{'methods'} = Set::Light->new();

    return $self;

}

1;

__END__