File Coverage

blib/lib/JSON/RPC/Spec.pm
Criterion Covered Total %
statement 75 77 97.4
branch 20 20 100.0
condition 2 2 100.0
subroutine 18 18 100.0
pod 3 3 100.0
total 118 120 98.3


line stmt bran cond sub pod time code
1             package JSON::RPC::Spec;
2 7     7   97191 use Moo;
  7         64647  
  7         29  
3 7     7   7252 use Carp ();
  7         9  
  7         81  
4 7     7   2529 use version; our $VERSION = version->declare("v1.0.6");
  7         9574  
  7         31  
5 7     7   874 use Try::Tiny;
  7         931  
  7         303  
6 7     7   2679 use Router::Simple;
  7         29223  
  7         156  
7 7     7   2491 use JSON::RPC::Spec::Procedure;
  7         17  
  7         213  
8 7     7   2615 use JSON::RPC::Spec::Client;
  7         11  
  7         312  
9             with qw(
10             JSON::RPC::Spec::Common
11             );
12              
13 7   100 7   32 use constant DEBUG => $ENV{PERL_JSON_RPC_SPEC_DEBUG} || 0;
  7         8  
  7         879  
14              
15             has router => (
16             is => 'lazy',
17             isa => sub {
18             my $self = shift;
19             $self->can('match') or Carp::croak('method match required.');
20             },
21             );
22              
23             has _procedure => (is => 'lazy');
24              
25             has _client => (
26             is => 'lazy',
27             handles => [qw(compose)],
28             );
29              
30             has [qw(_is_batch _content)] => (is => 'rw');
31              
32 7     7   31 use namespace::clean;
  7         24  
  7         23  
33              
34              
35             sub _build_router {
36 5     5   2063 Router::Simple->new;
37             }
38              
39             sub _build__procedure {
40 6     6   1904 JSON::RPC::Spec::Procedure->new(router => shift->router);
41             }
42              
43             sub _build__client {
44 1     1   3783 JSON::RPC::Spec::Client->new;
45             }
46              
47             sub _parse_json {
48 47     47   41 my ($self, $extra_args) = @_;
49 47         31 warn qq{-- start parsing @{[$self->_content]}\n} if DEBUG;
  47         105  
50              
51 2 100       8 unless (length $self->_content) {
52 45         37 return $self->_rpc_invalid_request;
53             }
54              
55             # JSON decode
56             # rpc call with invalid JSON:
57             # rpc call Batch, invalid JSON:
58 45         216 my ($req, $err);
59             try {
60 3     45   143 $req = $self->coder->decode($self->_content);
61             }
62             catch {
63 3     3   7 $err = $_;
64 45         2370 warn qq{-- error : @{[$err]} } if DEBUG;
  3         12  
65 45         847 };
66 42 100       84 if ($err) {
67 19         25 return $self->_rpc_parse_error;
68             }
69              
70             # Batch mode flag
71 23 100       35 if (ref $req eq 'ARRAY') {
72 23         31 $self->_is_batch(1);
73             }
74             else {
75 42         32 $self->_is_batch(0);
76 42         75 $req = [$req];
77             }
78              
79             # rpc call with an empty Array:
80 2 100       7 unless (scalar @{$req}) {
  40         40  
81 40         30 return $self->_rpc_invalid_request;
82             }
83              
84             # procedure call and create response
85 40         51 my @response;
86 48         626 for my $obj (@{$req}) {
  48         633  
87 40         78 my $res = $self->_procedure->parse($obj, $extra_args);
88              
89             # notification is ignore
90 34 100       100 push @response, $res if $res;
91             }
92 21 100       52 return unless @response;
93 0 100       0 return [@response] if $self->_is_batch;
94 0         0 return $response[0];
95             }
96              
97             # parse JSON string to hash
98             sub parse_without_encode {
99 19     19 1 18300 my $self = shift;
100 19         17 my $json_string = shift;
101 19         24 my $extra_args = +[@_];
102 19         49 $self->_content($json_string);
103 19         30 return $self->_parse_json($extra_args);
104             }
105              
106             # parse JSON string to JSON string
107             sub parse {
108 28     28 1 22691 my $self = shift;
109 28         27 my $json_string = shift;
110 28         35 my $extra_args = +[@_];
111 28         106 $self->_content($json_string);
112 28         43 my $result = $self->_parse_json($extra_args);
113 28 100       84 return unless $result;
114 25         52 return $self->coder->encode($result);
115             }
116              
117             # register method
118             sub register {
119 15     15 1 10369 my ($self, $pattern, $cb) = @_;
120 15 100       40 if (!defined $pattern) {
121 1         140 Carp::croak('pattern required');
122             }
123 14 100       38 if (ref $cb ne 'CODE') {
124 1         74 Carp::croak('code required');
125             }
126 13         172 $self->router->connect($pattern, +{$self->_callback_key => $cb}, +{});
127 13         824 return $self;
128             }
129              
130             1;
131             __END__