| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package RPC::Any::Server::JSONRPC; |
|
2
|
1
|
|
|
1
|
|
35415
|
use Moose; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
use Class::MOP; |
|
4
|
|
|
|
|
|
|
use JSON::RPC::Common::Marshal::Text; |
|
5
|
|
|
|
|
|
|
use RPC::XML qw(smart_encode); |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
extends 'RPC::Any::Server'; |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
has parser => (is => 'rw', isa => 'JSON::RPC::Common::Marshal::Text', |
|
10
|
|
|
|
|
|
|
lazy_build => 1); |
|
11
|
|
|
|
|
|
|
has _last_call => (is => 'rw', isa => 'JSON::RPC::Common::Procedure::Call', |
|
12
|
|
|
|
|
|
|
clearer => '_clear_last_call'); |
|
13
|
|
|
|
|
|
|
has default_version => (is => 'rw', isa => 'Str', default => '2.0'); |
|
14
|
|
|
|
|
|
|
has '+package_base' => (default => 'RPC::Any::Package::JSONRPC'); |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
before 'get_input' => sub { |
|
17
|
|
|
|
|
|
|
my $self = shift; |
|
18
|
|
|
|
|
|
|
$self->_clear_last_call(); |
|
19
|
|
|
|
|
|
|
}; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub decode_input_to_object { |
|
22
|
|
|
|
|
|
|
my ($self, $input) = @_; |
|
23
|
|
|
|
|
|
|
if (!defined $input or $input eq '') { |
|
24
|
|
|
|
|
|
|
$self->exception("ParseError", "You did not supply any JSON to parse."); |
|
25
|
|
|
|
|
|
|
} |
|
26
|
|
|
|
|
|
|
$self->parser->json->utf8(utf8::is_utf8($input) ? 0 : 1); |
|
27
|
|
|
|
|
|
|
my $request = eval { $self->parser->json_to_call($input) }; |
|
28
|
|
|
|
|
|
|
if ($@) { |
|
29
|
|
|
|
|
|
|
$self->exception('ParseError', "Error while parsing JSON request: $@"); |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
return $request; |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub input_object_to_data { |
|
35
|
|
|
|
|
|
|
my ($self, $input_object) = @_; |
|
36
|
|
|
|
|
|
|
$self->_last_call($input_object); |
|
37
|
|
|
|
|
|
|
my $params = $input_object->params; |
|
38
|
|
|
|
|
|
|
if (ref $params ne 'ARRAY') { |
|
39
|
|
|
|
|
|
|
$params = [$params]; |
|
40
|
|
|
|
|
|
|
} |
|
41
|
|
|
|
|
|
|
return { method => $input_object->method, |
|
42
|
|
|
|
|
|
|
arguments => $params }; |
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub output_data_to_object { |
|
46
|
|
|
|
|
|
|
my ($self, $method_result) = @_; |
|
47
|
|
|
|
|
|
|
my $json_return = $self->_last_call->return_result($method_result); |
|
48
|
|
|
|
|
|
|
return $json_return; |
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub encode_output_from_object { |
|
52
|
|
|
|
|
|
|
my ($self, $output_object) = @_; |
|
53
|
|
|
|
|
|
|
return $self->parser->return_to_json($output_object); |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub encode_output_from_exception { |
|
57
|
|
|
|
|
|
|
my ($self, $exception) = @_; |
|
58
|
|
|
|
|
|
|
my %error_params = ( |
|
59
|
|
|
|
|
|
|
message => $exception->message, |
|
60
|
|
|
|
|
|
|
code => $exception->code, |
|
61
|
|
|
|
|
|
|
); |
|
62
|
|
|
|
|
|
|
my $json_error; |
|
63
|
|
|
|
|
|
|
if ($self->_last_call) { |
|
64
|
|
|
|
|
|
|
$json_error = $self->_last_call->return_error(%error_params); |
|
65
|
|
|
|
|
|
|
} |
|
66
|
|
|
|
|
|
|
# Default to default_version. This happens when we throw an exception |
|
67
|
|
|
|
|
|
|
# before inbound parsing is complete. |
|
68
|
|
|
|
|
|
|
else { |
|
69
|
|
|
|
|
|
|
$json_error = $self->_default_error(%error_params); |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
return $self->encode_output_from_object($json_error); |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _default_error { |
|
75
|
|
|
|
|
|
|
my ($self, %params) = @_; |
|
76
|
|
|
|
|
|
|
my $version = $self->default_version; |
|
77
|
|
|
|
|
|
|
$version =~ s/\./_/g; |
|
78
|
|
|
|
|
|
|
my $error_class = "JSON::RPC::Common::Procedure::Return::Version_${version}::Error"; |
|
79
|
|
|
|
|
|
|
Class::MOP::load_class($error_class); |
|
80
|
|
|
|
|
|
|
my $error = $error_class->new(%params); |
|
81
|
|
|
|
|
|
|
my $return_class = "JSON::RPC::Common::Procedure::Return::Version_$version"; |
|
82
|
|
|
|
|
|
|
Class::MOP::load_class($return_class); |
|
83
|
|
|
|
|
|
|
return $return_class->new(error => $error); |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _build_parser { |
|
87
|
|
|
|
|
|
|
return JSON::RPC::Common::Marshal::Text->new(); |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
__END__ |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 NAME |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
RPC::Any::Server::JSONRPC - A basic JSON-RPC server |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
use RPC::Any::Server::JSONRPC; |
|
103
|
|
|
|
|
|
|
# Create a server where calling Foo.bar will call My::Module->bar. |
|
104
|
|
|
|
|
|
|
my $server = RPC::Any::Server::JSONRPC->new( |
|
105
|
|
|
|
|
|
|
dispatch => { 'Foo' => 'My::Module' }, |
|
106
|
|
|
|
|
|
|
default_version => '2.0', |
|
107
|
|
|
|
|
|
|
); |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Read JSON from STDIN and print JSON to STDOUT. |
|
110
|
|
|
|
|
|
|
print $server->handle_input(); |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
This is a server that implements the various |
|
115
|
|
|
|
|
|
|
L<JSON-RPC|http://groups.google.com/group/json-rpc/web> specifications. |
|
116
|
|
|
|
|
|
|
It supports JSON-RPC 1.0, 1.1, and 2.0. It uses L<JSON::RPC::Common> |
|
117
|
|
|
|
|
|
|
as its backend for parsing input and producing output, and so |
|
118
|
|
|
|
|
|
|
it supports everything that that module supports. |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
This is a basic server that just takes JSON as input to C<handle_input>, |
|
121
|
|
|
|
|
|
|
and produces JSON as the output from C<handle_input>. It doesn't understand |
|
122
|
|
|
|
|
|
|
HTTP headers or anything like that, and it doesn't produce HTTP headers. For |
|
123
|
|
|
|
|
|
|
that, see L<RPC::Any::Server::JSONRPC::HTTP> or |
|
124
|
|
|
|
|
|
|
L<RPC::Any::Server::JSONRPC::CGI>. |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
See L<RPC::Any::Server> for a basic description of how servers |
|
127
|
|
|
|
|
|
|
work in RPC::Any. |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head1 JSONRPC SERVER ATTRIBUTES |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
These are additional attributes beyond what is specified in |
|
132
|
|
|
|
|
|
|
L<RPC::Any::Server> that are available for a JSON-RPC server. |
|
133
|
|
|
|
|
|
|
These can all be specified during C<new> or set like |
|
134
|
|
|
|
|
|
|
C<< $server->method($value) >>. They are all optional. |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=over |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item C<default_version> |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
This is a string specifying the version to use for error messages |
|
141
|
|
|
|
|
|
|
in situations where the server doesn't know the JSON-RPC version |
|
142
|
|
|
|
|
|
|
of the incoming message. (This happens when there is an error |
|
143
|
|
|
|
|
|
|
parsing the JSON-RPC input--we haven't parsed the input, so we |
|
144
|
|
|
|
|
|
|
don't know what JSON-RPC version is in use.) This defaults to |
|
145
|
|
|
|
|
|
|
C<2.0> if not specified. |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item C<parser> |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
This is a L<JSON::RPC::Common::Marshal::Text> instance that is |
|
150
|
|
|
|
|
|
|
used to parse incoming JSON and produce output JSON. |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=back |