| 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>. |