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   100522 use Moo;
  7         61485  
  7         33  
3 7     7   11819 use Carp ();
  7         14  
  7         104  
4 7     7   2308 use version; our $VERSION = version->declare("v1.0.7");
  7         9947  
  7         34  
5 7     7   902 use Try::Tiny;
  7         904  
  7         318  
6 7     7   2561 use Router::Simple;
  7         25133  
  7         177  
7 7     7   2484 use JSON::RPC::Spec::Procedure;
  7         25  
  7         210  
8 7     7   2289 use JSON::RPC::Spec::Client;
  7         20  
  7         336  
9             with qw(
10             JSON::RPC::Spec::Common
11             );
12              
13 7   100 7   51 use constant DEBUG => $ENV{PERL_JSON_RPC_SPEC_DEBUG} || 0;
  7         24  
  7         975  
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   45 use namespace::clean;
  7         20  
  7         28  
33              
34              
35             sub _build_router {
36 5     5   762 Router::Simple->new;
37             }
38              
39             sub _build__procedure {
40 6     6   717 JSON::RPC::Spec::Procedure->new(router => shift->router);
41             }
42              
43             sub _build__client {
44 1     1   3396 JSON::RPC::Spec::Client->new;
45             }
46              
47             sub _parse_json {
48 47     47   90 my ($self, $extra_args) = @_;
49 47         62 warn qq{-- start parsing @{[$self->_content]}\n} if DEBUG;
  47         147  
50              
51 2 100       11 unless (length $self->_content) {
52 45         71 return $self->_rpc_invalid_request;
53             }
54              
55             # JSON decode
56             # rpc call with invalid JSON:
57             # rpc call Batch, invalid JSON:
58 45         275 my ($req, $err);
59             try {
60 3     45   130 $req = $self->coder->decode($self->_content);
61             }
62             catch {
63 3     3   11 $err = $_;
64 45         1175 warn qq{-- error : @{[$err]} } if DEBUG;
  3         16  
65 45         2512 };
66 42 100       124 if ($err) {
67 19         48 return $self->_rpc_parse_error;
68             }
69              
70             # Batch mode flag
71 23 100       59 if (ref $req eq 'ARRAY') {
72 23         50 $self->_is_batch(1);
73             }
74             else {
75 42         62 $self->_is_batch(0);
76 42         113 $req = [$req];
77             }
78              
79             # rpc call with an empty Array:
80 2 100       10 unless (scalar @{$req}) {
  40         60  
81 40         65 return $self->_rpc_invalid_request;
82             }
83              
84             # procedure call and create response
85 40         79 my @response;
86 48         743 for my $obj (@{$req}) {
  48         379  
87 40         120 my $res = $self->_procedure->parse($obj, $extra_args);
88              
89             # notification is ignore
90 34 100       138 push @response, $res if $res;
91             }
92 21 100       69 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 22771 my $self = shift;
100 19         35 my $json_string = shift;
101 19         43 my $extra_args = +[@_];
102 19         75 $self->_content($json_string);
103 19         43 return $self->_parse_json($extra_args);
104             }
105              
106             # parse JSON string to JSON string
107             sub parse {
108 28     28 1 38552 my $self = shift;
109 28         52 my $json_string = shift;
110 28         59 my $extra_args = +[@_];
111 28         125 $self->_content($json_string);
112 28         70 my $result = $self->_parse_json($extra_args);
113 28 100       89 return unless $result;
114 25         352 return $self->coder->encode($result);
115             }
116              
117             # register method
118             sub register {
119 15     15 1 14937 my ($self, $pattern, $cb) = @_;
120 15 100       56 if (!defined $pattern) {
121 1         161 Carp::croak('pattern required');
122             }
123 14 100       46 if (ref $cb ne 'CODE') {
124 1         70 Carp::croak('code required');
125             }
126 13         274 $self->router->connect($pattern, +{$self->_callback_key => $cb}, +{});
127 13         1111 return $self;
128             }
129              
130             1;
131             __END__