File Coverage

blib/lib/JSON/RPC2/AnyEvent/Server/Handle.pm

Criterion	Covered	Total	%
statement	61	69	88.4
branch	6	20	30.0
condition	2	6	33.3
subroutine	19	20	95.0
pod	2	3	66.6
total	90	118	76.2

package JSON::RPC2::AnyEvent::Server::Handle;
use 5.010;
use strict;
use warnings;

our $VERSION = "0.03";

use AnyEvent::Handle;
use Carp qw(croak);
use Errno ();
use JSON;
use Scalar::Util qw(blessed reftype openhandle);

use JSON::RPC2::AnyEvent::Server;
use JSON::RPC2::AnyEvent::Constants qw(ERR_PARSE_ERROR);


sub new {
    my ($class, $srv, $hdl) = @_;

    croak "Not an JSON::RPC2::AnyEvent::Server object: $srv"  unless blessed $srv && $srv->isa('JSON::RPC2::AnyEvent::Server');

    unless ( blessed $hdl && $hdl->isa('AnyEvent::Handle') ) {
        $hdl = openhandle $hdl  or croak "Neither AnyEvent::Handle nor open filehandle: $hdl";
        $hdl = AnyEvent::Handle->new(fh => $hdl);
    }

    my $self = bless {
        hdl => $hdl,
        srv => $srv,
    }, $class;

    $hdl->on_read(sub{
        shift->push_read(json => sub{
            my ($h, $json) = @_;
            $self->{srv}->dispatch($json)->cb(sub{
                my $res = shift->recv;
                $h->push_write(json => $res)  if defined $res;
            });
        });
    });

    $hdl->on_eof(sub{
        my $on_end = $self->{on_end};
        $self->destroy;
        $on_end->($self)  if $on_end;
    });

    $hdl->on_error(sub{
        my ($h, $fatal, $msg) = @_;
        if ( $! == Errno::EBADMSG ) {  # JSON Parse error
            my $res = JSON::RPC2::AnyEvent::Server::_make_error_response(undef, ERR_PARSE_ERROR, 'Parse error');
            $h->push_write(json => $res);
        } elsif ( $self->{on_error} ){
            $self->{on_error}->($self, $fatal, $msg);
            $self->destroy if $fatal;
        } else {
            $self->destroy if $fatal;
            croak "JSON::RPC2::AnyEvent::Handle uncaught error: $msg";
        }
    });

    $self;
}


sub JSON::RPC2::AnyEvent::Server::dispatch_fh{
    my ($self, $fh) = @_;
    __PACKAGE__->new($self, $fh);
}


# Create on_xxx methods
for my $name ( qw/ on_end on_error / ) {
    no strict 'refs';
    *$name = sub {
        my ($self, $code) = @_;
        reftype $code eq 'CODE'  or croak "coderef must be specified";
        $self->{$name} = $code;
    };
}


# This DESTROY-pattern originates from AnyEvent::Handle code.
sub DESTROY {
    my ($self) = @_;
    $self->{hdl}->destroy;
}

sub destroy {
    my ($self) = @_;
    $self->DESTROY;
    %$self = ();
    bless $self, "JSON::RPC2::AnyEvent::Server::Handle::destroyed";
}

sub JSON::RPC2::AnyEvent::Server::Handle::destroyed::AUTOLOAD {
   #nop
}


1;
__END__