File Coverage

blib/lib/JSON/RPC2/AnyEvent/Client.pm

Criterion	Covered	Total	%
statement	76	102	74.5
branch	15	28	53.5
condition	0	11	0.0
subroutine	18	26	69.2
pod	1	1	100.0
total	110	168	65.4

package JSON::RPC2::AnyEvent::Client;
use 5.008005;
use strict;
use warnings;

use utf8;
use AnyEvent::Handle;
use AnyEvent::HTTP;
use JSON::RPC2::Client;
use Scalar::Util qw(weaken);

our $VERSION = "0.04";

our $AUTOLOAD;  # it's a package global

my @remappable = qw( service named listed destroy );

sub new {
   my $class = shift;
   my $self = bless {
      client => JSON::RPC2::Client->new(),
      call => 'call',
      @_,
      remappable => {},
      cb => {},
      on_error => sub{ warn shift . ' at ' . join(' ',caller) }
   }, $class;
   $self->{call} = 'call'       if 'listed' eq $self->{call};
   $self->{call} = 'call_named' if 'named'  eq $self->{call};
   for( @remappable ) {
      if( exists $self->{$_} ) {
          $self->{remappable}->{ $self->{$_} } = '__'.$_
      } else {
          $self->{remappable}->{ $_ } = '__'.$_
      }
   }
   if ( $self->{url} ) {
      $self->{request_fn} = \&JSON::RPC2::AnyEvent::Client::__request_http;
   } else {
      $self->__connect_tcp;
      $self->{request_fn} = \&JSON::RPC2::AnyEvent::Client::__request_tcp;
   }
   $self;
}

sub __connect_tcp {
   my $self = shift;
   weaken($self);
   return if $self->{http};
   $self->{handle} = new AnyEvent::Handle
      connect  => [ $self->{host}, $self->{port} ],
      on_error => sub {
         my $url = 'url '.($self->{host}||'').':'.($self->{port}||'').' ';
         $self->__fail_error($url . $!);
         $self->{handle}->destroy if $self->{handle}; # explicitly destroy
      },
      on_eof   => sub {
         my $url = 'url '.($self->{host}||'').':'.($self->{port}||'').' ';
         $self->__fail_error("$url CONNECTION CLOSED $!");
         $self->{handle}->destroy if $self->{handle}; # explicitly destroy
      };
}

sub __named {
   my $self = shift;
   $self->{call} = 'call_named';
   $self;
}

sub __listed {
   my $self = shift;
   $self->{call} = 'call';
   $self;
}

sub __service {
   my $self = shift;
   $self->{service} = shift;
   $self;
}

sub __fail_error {
   my ( $self, $error ) = @_;
   $self->{on_error}->( $error . ' at ' . join(' ', caller) );
   foreach my $call_id ( keys %{$self->{cb}} ) {
      my $cb = delete $self->{cb}->{$call_id};
      $cb->( $error );
   }
}

sub AUTOLOAD {
   my $self = shift;

   my $method = $AUTOLOAD;
   $method =~ s/(.*):://g;

   if( exists $self->{remappable}->{$method} ) {
      $method = $self->{remappable}->{$method};
      return $self->$method( @_ );
   }

   my $cb = pop;

   $method = $self->{service} ? $self->{service} . '.' . $method : $method;

   my $call = $self->{call};

   my ( $json_request, $call_id ) = $self->{client}->$call( $method, @_ );

   $self->{cb}->{$call_id} = $cb;

   $self->{request_fn}->( $self, $json_request );

   return $call_id;
}

sub __request_tcp {
   my ( $self, $json_request ) = @_;

   $self->{handle}->push_write( $json_request );

   $self->{handle}->push_read( json => sub{
      my ( $handle, $hash ) = @_;
      my ( $failed, $result, $error, $call_id ) = $self->{client}->response( $hash );
      return $self->__fail_error( $failed ) if $failed;
      $self->__do_callback( $call_id, $failed, $result, $error );
   } );
}

sub __request_http {
   my ( $self, $json_request ) = @_;

   http_post $self->{url}, $json_request, sub {
      my ( $resp, $hdr ) = @_;

      unless ( $hdr->{Status} =~ /^2/ ) {
         return $self->__fail_error( "$hdr->{Status} $hdr->{Reason}" );
      }

      my ( $failed, $result, $error, $call_id ) =
         $self->{client}->response( $resp );

      return $self->__fail_error( $failed ) if $failed;

      $self->__do_callback( $call_id, $failed, $result, $error );
   };
}

sub __do_callback {
   my ( $self, $call_id, $failed, $result, $error ) = @_;
   my $cb = delete $self->{cb}->{$call_id};
   if( $self->{simplify_errors} ) {
      my $err = $failed || $error && $error->{message};
      $cb->( $err, $result );
   } else {
      $cb->( $failed, $result, $error );
   }
}

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

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

sub JSON::RPC2::AnyEvent::Client::destroyed::AUTOLOAD {
   #nop
}

1;
__END__