File Coverage

blib/lib/AnyEvent/JSONRPC/HTTP/Client.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package AnyEvent::JSONRPC::HTTP::Client;
use Any::Moose;
use Any::Moose '::Util::TypeConstraints';

extends 'AnyEvent::JSONRPC::Client';

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

use AnyEvent;
use AnyEvent::HTTP;

use JSON::RPC::Common::Procedure::Call;
use JSON::RPC::Common::Procedure::Return;

use MIME::Base64;
use JSON::XS;

has url => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

has version => (
    is      => 'rw',
    isa     => enum( [qw( 1.0 1.1 2.0 )] ),
    default => "2.0",
);

has username => (
    is => "rw",
    isa => 'Str',
    predicate => "has_username"
);

has password => (
    is => "rw",
    isa => "Str"
);

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

has _next_id => (
    is      => 'ro',
    isa     => 'CodeRef',
    lazy    => 1,
    default => sub {
        my $id = 0;
        sub { ++$id };
    },
);

no Any::Moose;

sub call {
    my ($self, $method, @params) = @_;

    my $request = JSON::RPC::Common::Procedure::Call->inflate (
        version => $self->version,
        id      => $self->_next_id->(),
        method  => $method,
        params  => $self->_params( @params ),
    );

    my $guard = http_post $self->url,
                          encode_json( $request->deflate ) . "   ",
                          headers => {
                              "Content-Type" => "application/json",
                              $self->_authorization_header,
                          },
                          sub { $self->_handle_response( @_ ) };

    my $cv = AnyEvent->condvar;

    $self->_request_pool->{ $request->id } = [ $guard, $cv ];

    return $cv;
}

sub _authorization_header {
    my $self = shift;

    return unless $self->has_username;

    return Authorization => "Basic " . encode_base64( $self->username . ":" . $self->password );
}

sub _handle_response {
    my ($self, $json, $header) = @_;

    unless ( $header->{Status} =~ /^2/) {
        warn qq/Invalid response from server: $header->{Status} $header->{Reason}/;
        return;
    }

    my $response = JSON::RPC::Common::Procedure::Return->inflate( decode_json $json );
    my $d = delete $self->_request_pool->{ $response->id };
    unless ($d) {
        warn q/Invalid response from server/;
        return;
    }

    if (my $error = $response->error) {
        $d->[1]->croak($error);
    }
    else {
        $d->[1]->send($response->result);
    }
}

sub notify {
    my ($self, $method, @params) = @_;

    my $request = JSON::RPC::Common::Call->inflate (
        version => $self->version,
        method  => $method,
        params  => $self->_params( @params ),
    );

    http_post $self->url,
              encode_json( $request->deflate ),
              headers => {
                  "Content-Type" => "application/json",
                  $self->_authorization_header,
              },
              sub { 1; };
}

sub _params {
    my $self = shift;

    my $param;
    if (scalar( @_ ) == 1) {
        $param = shift;

        $param = [ $param ] if (ref $param eq "HASH" and $self->version eq "1.0")
                            || not ref $param;

    } else {
        $param = [ @_ ];
    }

    return $param;
}

__PACKAGE__->meta->make_immutable;

__END__

=encoding utf-8

=begin stopwords

AnyEvent Coro JSONRPC Hostname Str HTTP HTTP-based
blockingly condvar condvars coroutine unix

=end stopwords

=head1 NAME

AnyEvent::JSONRPC::HTTP::Client - Simple HTTP-based JSONRPC client

=head1 SYNOPSIS

    use AnyEvent::JSONRPC::HTTP::Client;

    my $client = AnyEvent::JSONRPC::HTTP::Client->new(
        url      => 'http://rpc.example.net/issues',
        username => "pmakholm",
        password => "secret",
    );

    # blocking interface
    my $res = $client->call( echo => 'foo bar' )->recv; # => 'foo bar';

    # non-blocking interface
    $client->call( echo => 'foo bar' )->cb(sub {
        my $res = $_[0]->recv;  # => 'foo bar';
    });

=head1 DESCRIPTION

This module is the HTTP client part of L<AnyEvent::JSONRPC>.

=head2 AnyEvent condvars

The main thing you have to remember is that all the data retrieval methods
return an AnyEvent condvar, C<$cv>.  If you want the actual data from the
request, there are a few things you can do.

You may have noticed that many of the examples in the SYNOPSIS call C<recv>
on the condvar.  You're allowed to do this under 2 circumstances:

=over 4

=item Either you're in a main program,

Main programs are "allowed to call C<recv> blockingly", according to the
author of L<AnyEvent>.

=item or you're in a Coro + AnyEvent environment.

When you call C<recv> inside a coroutine, only that coroutine is blocked
while other coroutines remain active.  Thus, the program as a whole is
still responsive.

=back

If you're not using Coro, and you don't want your whole program to block,
what you should do is call C<cb> on the condvar, and give it a coderef to
execute when the results come back.  The coderef will be given a condvar
as a parameter, and it can call C<recv> on it to get the data.  The final
example in the SYNOPSIS gives a brief example of this.

Also note that C<recv> will throw an exception if the request fails, so be
prepared to catch exceptions where appropriate.

Please read the L<AnyEvent> documentation for more information on the proper
use of condvars.

=head1 METHODS

=head2 new (%options)

Create new client object and return it.

    my $client = AnyEvent::JSONRPC::HTTP::Client->new(
        host => '127.0.0.1',
        port => 4423,
        %options,
    );

Available options are:

=over 4

=item url => 'Str'

URL to json-RPC endpoint to connect. (Required)

=item username => 'Str'

Username to use for authorization (Optional).

If this is set an Authorization header containing basic auth credential is
always sent with request.

=item password => 'Str'

Password used for authorization (optional)

=back

=head2 call ($method, @params)

Call remote method named C<$method> with parameters C<@params>. And return condvar object for response.

    my $cv = $client->call( echo => 'Hello!' );
    my $res = $cv->recv;

If server returns an error, C<< $cv->recv >> causes croak by using C<< $cv->croak >>. So you can handle this like following:

    my $res;
    eval { $res = $cv->recv };

    if (my $error = $@) {
        # ...
    }

=head2 notify ($method, @params)

Same as call method, but not handle response. This method just notify to server.

    $client->notify( echo => 'Hello' );

=head1 AUTHOR

Peter Makholm <[e-mail]>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2010 by Peter Makholm.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut