File Coverage

blib/lib/AnyEvent/JSONRPC/Lite/Server.pm

Criterion	Covered	Total	%
statement	53	64	82.8
branch	9	16	56.2
condition	2	7	28.5
subroutine	13	15	86.6
pod	2	2	100.0
total	79	104	75.9

package AnyEvent::JSONRPC::Lite::Server;
use Any::Moose;

use Carp;
use Scalar::Util 'weaken';

use AnyEvent::Handle;
use AnyEvent::Socket;

use AnyEvent::JSONRPC::Lite::CondVar;

has address => (
    is      => 'ro',
    isa     => 'Maybe[Str]',
    default => undef,
);

has port => (
    is      => 'ro',
    isa     => 'Int|Str',
    default => 4423,
);

has server => (
    is => 'rw',
    isa => 'Object',
);

has on_error => (
    is      => 'rw',
    isa     => 'CodeRef',
    lazy    => 1,
    default => sub {
        return sub {
            my ($handle, $fatal, $message) = @_;
            carp sprintf "Server got error: %s", $message;
        };
    },
);

has on_eof => (
    is      => 'rw',
    isa     => 'CodeRef',
    lazy    => 1,
    default => sub {
        return sub { };
    },
);

has handler_options => (
    is      => 'ro',
    isa     => 'HashRef',
    default => sub { {} },
);

has _handlers => (
    is      => 'ro',
    isa     => 'ArrayRef',
    default => sub { [] },
);

has _callbacks => (
    is      => 'ro',
    isa     => 'HashRef',
    lazy    => 1,
    default => sub { {} },
);

no Any::Moose;

sub BUILD {
    my $self = shift;

    my $server = tcp_server $self->address, $self->port, sub {
        my ($fh, $host, $port) = @_;
        my $indicator = "$host:$port";

        my $handle = AnyEvent::Handle->new(
            on_error => sub {
                my ($h, $fatal, $msg) = @_;
                $self->on_error->(@_);
                $h->destroy;
            },
            on_eof => sub {
                my ($h) = @_;
                # client disconnected
                $self->on_eof->(@_);
                $h->destroy;
            },
            %{ $self->handler_options },
            fh => $fh,
        );
        $handle->on_read(sub {
            shift->unshift_read( json => sub {
                $self->_dispatch($indicator, @_);
            }),
        });

        $self->_handlers->[ fileno($fh) ] = $handle;
    };
    $self->server($server);
    weaken $self;

    $self;
}

sub reg_cb {
    my ($self, %callbacks) = @_;

    while (my ($method, $callback) = each %callbacks) {
        $self->_callbacks->{ $method } = $callback;
    }
}

sub _dispatch {
    my ($self, $indicator, $handle, $request) = @_;
    return unless $request and ref $request eq 'HASH';

    my $target = $self->_callbacks->{ $request->{method} };

    # must response if id is exists
    if (my $id = $request->{id}) {
        $indicator = "$indicator:$id";

        my $res_cb = sub {
            my $type   = shift;
            my $result = @_ > 1 ? \@_ : $_[0];

            $handle->push_write( json => {
                id     => $id,
                result => $type eq 'result' ? $result : undef,
                error  => $type eq 'error'  ? $result : undef,
            }) if $handle;
        };
        weaken $handle;

        my $cv = AnyEvent::JSONRPC::Lite::CondVar->new;
        $cv->_cb(sub { $res_cb->( $_[0]->recv ) });

        $target ||= sub { shift->error(qq/No such method "$request->{method}" found/) };
        $target->( $cv, @{ $request->{params} || [] } );
    }
    else {
        # without id parameter, this is notification.
        # dispatch to method without cv object.
        $target ||= sub { warn qq/No such method "$request->{method}" found/ };
        $target->(undef, @{ $request->{params} || [] });
    }
}

__PACKAGE__->meta->make_immutable;

__END__