line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package RPC::Any::Server::JSONRPC::HTTP; |
2
|
1
|
|
|
1
|
|
34519
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
use JSON::RPC::Common::Marshal::HTTP; |
4
|
|
|
|
|
|
|
use HTTP::Response; # Needed because Marshal::HTTP doesn't load it. |
5
|
|
|
|
|
|
|
extends 'RPC::Any::Server::JSONRPC'; |
6
|
|
|
|
|
|
|
with 'RPC::Any::Interface::HTTP'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
has '+parser' => (isa => 'JSON::RPC::Common::Marshal::HTTP'); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub decode_input_to_object { |
11
|
|
|
|
|
|
|
my ($self, $request) = @_; |
12
|
|
|
|
|
|
|
if (uc($request->method) eq 'POST' and $request->content eq '') { |
13
|
|
|
|
|
|
|
$self->exception("ParseError", |
14
|
|
|
|
|
|
|
"You did not supply any JSON to parse in the POST body."); |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
elsif (uc($request->method) eq 'GET' and !$request->uri->query) { |
17
|
|
|
|
|
|
|
$self->exception("ParseError", |
18
|
|
|
|
|
|
|
"You did not supply any JSON to parse in the query string."); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
my $call = eval { $self->parser->request_to_call($request) }; |
21
|
|
|
|
|
|
|
if ($@) { |
22
|
|
|
|
|
|
|
$self->exception('ParseError', |
23
|
|
|
|
|
|
|
"Error while parsing JSON HTTP request: $@"); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
return $call; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _build_parser { |
29
|
|
|
|
|
|
|
return JSON::RPC::Common::Marshal::HTTP->new(); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub encode_output_from_object { |
33
|
|
|
|
|
|
|
my ($self, $output_object) = @_; |
34
|
|
|
|
|
|
|
my $response = $self->parser->result_to_response($output_object); |
35
|
|
|
|
|
|
|
return $response; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
1; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
__END__ |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head1 NAME |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
RPC::Any::Server::JSONRPC::HTTP - A JSON-RPC server that understands HTTP |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 SYNOPSIS |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
use RPC::Any::Server::JSONRPC::HTTP; |
51
|
|
|
|
|
|
|
# Create a server where calling Foo.bar will call My::Module->bar. |
52
|
|
|
|
|
|
|
my $server = RPC::Any::Server::JSONRPC::HTTP->new( |
53
|
|
|
|
|
|
|
dispatch => { 'Foo' => 'My::Module' }, |
54
|
|
|
|
|
|
|
allow_get => 0, |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
# Read HTTP headers and JSON from STDIN and print result, |
57
|
|
|
|
|
|
|
# including HTTP headers, to STDOUT. |
58
|
|
|
|
|
|
|
print $server->handle_input(); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# HTTP servers also take HTTP::Request objects, if you want. |
61
|
|
|
|
|
|
|
my $request = HTTP::Request->new(POST => '/'); |
62
|
|
|
|
|
|
|
$request->content('<?xml ... '); |
63
|
|
|
|
|
|
|
print $server->handle_input($request); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 DESCRIPTION |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
This is a type of L<RPC::Any::Server::JSONRPC> that understands HTTP. |
68
|
|
|
|
|
|
|
It has all of the features of L<RPC::Any::Server>, L<RPC::Any::Server::JSONRPC>, |
69
|
|
|
|
|
|
|
and L<RPC::Any::Interface::HTTP>. You should see those modules for |
70
|
|
|
|
|
|
|
information on configuring this server and the way it works. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
The C<parser> attribute (which you usually don't need to care about) in |
73
|
|
|
|
|
|
|
a JSONRPC::HTTP server is a L<JSON::RPC::Common::Marshal::HTTP> (as opposed |
74
|
|
|
|
|
|
|
to the basic JSONRPC server, where it's a Marshal::Text instead of |
75
|
|
|
|
|
|
|
Marshal::HTTP). |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head1 HTTP GET SUPPORT |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Since this is based on L<JSON::RPC::Common>, it supports all the various |
80
|
|
|
|
|
|
|
HTTP GET specifications in the various "JSON-RPC over HTTP" specs, |
81
|
|
|
|
|
|
|
if you turn on C<allow_get>. |