File Coverage

blib/lib/RPC/ExtDirect/Serializer.pm
Criterion Covered Total %
statement 93 93 100.0
branch 17 18 94.4
condition 6 8 75.0
subroutine 18 18 100.0
pod 0 4 0.0
total 134 141 95.0


line stmt bran cond sub pod time code
1             package RPC::ExtDirect::Serializer;
2              
3 28     28   470 use strict;
  28         27  
  28         614  
4 28     28   81 use warnings;
  28         28  
  28         527  
5 28     28   75 no warnings 'uninitialized'; ## no critic
  28         28  
  28         592  
6              
7 28     28   80 use Carp;
  28         32  
  28         1182  
8 28     28   93 use JSON ();
  28         22  
  28         369  
9              
10 28     28   85 use RPC::ExtDirect::Config;
  28         27  
  28         433  
11              
12 28     28   81 use RPC::ExtDirect::Util::Accessor;
  28         26  
  28         590  
13 28         20222 use RPC::ExtDirect::Util qw/
14             clean_error_message get_caller_info parse_global_flags
15 28     28   80 /;
  28         26  
16              
17             ### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
18             #
19             # Instantiate a new Serializer
20             #
21              
22             sub new {
23 94     94 0 646 my ($class, %arg) = @_;
24            
25 94         258 my $self = bless { %arg }, $class;
26            
27 94         225 return $self;
28             }
29              
30             ### PUBLIC INSTANCE METHOD ###
31             #
32             # Serialize the data passed to it in JSON
33             #
34              
35             sub serialize {
36 57     57 0 143 my ($self, %arg) = @_;
37            
38 57   50     144 my $data = delete $arg{data} || [];
39              
40             # Try to serialize each response separately;
41             # if one fails it's better to return an exception
42             # for one response than fail all of them
43 57         83 my @serialized = map { $self->_encode_response($_, %arg) }
  59         148  
44             @$data;
45              
46 57 100       135 my $text = @serialized == 1 ? shift @serialized
47             : '[' . join(',', @serialized) . ']'
48             ;
49              
50 57         144 return $text;
51             }
52              
53             ### PUBLIC INSTANCE METHOD ###
54             #
55             # Turns JSONified POST request(s) into array of instantiated
56             # RPC::ExtDirect::Request (Exception) objects. Returns arrayref.
57             #
58              
59             sub decode_post {
60 28     28 0 69 my ($self, %arg) = @_;
61            
62 28         39 my $post_text = delete $arg{data};
63              
64             # Try to decode data, return Exception upon failure
65 28         29 local $@;
66 28         29 my $data = eval { $self->_decode_json($post_text) };
  28         54  
67              
68 28 100       624 if ( $@ ) {
69 3         8 my $error = $self->_clean_msg($@);
70              
71 3         7 my $msg = "ExtDirect error decoding POST data: '$error'";
72 3         13 my $xcpt = $self->_exception({
73             direction => 'deserialize',
74             message => $msg,
75             %arg,
76             });
77            
78 3         13 return [ $xcpt ];
79             };
80              
81 25 100       67 $data = [ $data ] unless ref $data eq 'ARRAY';
82              
83 25         43 my @requests = map { $self->_request({ %$_, %arg }) } @$data;
  31         153  
84              
85 25         93 return \@requests;
86             }
87              
88             ### PUBLIC INSTANCE METHOD ###
89             #
90             # Instantiates Request based on form submitted to ExtDirect handler
91             # Returns arrayref with single Request.
92             #
93              
94             sub decode_form {
95 10     10 0 37 my ($self, %arg) = @_;
96            
97 10         20 my $form_href = delete $arg{data};
98              
99             # Create the Request (or Exception)
100 10         89 my $request = $self->_request({ %$form_href, %arg });
101              
102 10         61 return [ $request ];
103             }
104              
105             RPC::ExtDirect::Util::Accessor::mk_accessors(
106             simple => [qw/ config api /],
107             );
108              
109             ############## PRIVATE METHODS BELOW ##############
110              
111             ### PRIVATE INSTANCE METHOD ###
112             #
113             # Clean error message
114             #
115              
116             sub _clean_msg {
117 6     6   10 my ($self, $msg) = @_;
118            
119 6         17 return clean_error_message($msg);
120             }
121              
122             ### PRIVATE INSTANCE METHOD ###
123             #
124             # Try encoding one response into JSON
125             #
126              
127             sub _encode_response {
128 59     59   106 my ($self, $response, %arg) = @_;
129            
130 59         61 my $mute_exceptions = $arg{mute_exceptions};
131            
132 59         54 local $@;
133 59         63 my $text = eval { $self->_encode_json($response, %arg) };
  59         116  
134              
135 59 100 100     1914 if ( $@ and not $mute_exceptions ) {
136 3         9 my $msg = $self->_clean_msg($@);
137              
138             # It's not a given that response/exception hashrefs
139             # will be actual blessed objects, so we have to peek
140             # into them instead of using accessors
141             my $exception = $self->_exception({
142             direction => 'serialize',
143             action => $response->{action},
144             method => $response->{method},
145             tid => $response->{tid},
146 3         19 where => __PACKAGE__,
147             message => $msg,
148             %arg,
149             });
150            
151 3         8 local $@;
152 3         4 $text = eval {
153 3         8 $self->_encode_json( $exception->result(), %arg )
154             };
155             };
156            
157 59         308 return $text;
158             }
159              
160             ### PRIVATE INSTANCE METHOD ###
161             #
162             # Actually encode JSON
163             #
164              
165             sub _encode_json {
166 62     62   101 my ($self, $data, %arg) = @_;
167            
168 62   66     1387 my $config = $arg{config} || $self->config;
169             my $options = defined $arg{json_options} ? $arg{json_options}
170 62 50       1292 : $config->json_options_serialize
171             ;
172             my $debug = defined $arg{debug} ? $arg{debug}
173 61 100       237 : $config->debug_serialize
174             ;
175            
176             # We force UTF-8 as per Ext.Direct spec
177 61         101 $options->{utf8} = 1;
178             $options->{canonical} = $debug
179 61 100       164 unless defined $options->{canonical};
180            
181 61         164 return JSON::to_json($data, $options);
182             }
183              
184             ### PRIVATE INSTANCE METHOD ###
185             #
186             # Actually decode JSON
187             #
188              
189             sub _decode_json {
190 28     28   27 my ($self, $text) = @_;
191            
192 28         557 my $options = $self->config->json_options_deserialize;
193            
194 28         74 return JSON::from_json($text, $options);
195             }
196              
197             ### PRIVATE INSTANCE METHOD ###
198             #
199             # Return a new Request object
200             #
201              
202             sub _request {
203 42     42   50 my ($self, $arg) = @_;
204            
205 42         869 my $api = $self->api;
206 42         793 my $config = $self->config;
207 42         771 my $request_class = $config->request_class_deserialize;
208            
209 42         1764 eval "require $request_class";
210            
211 42         364 return $request_class->new({
212             config => $config,
213             api => $api,
214             %$arg
215             });
216             }
217              
218             ### PRIVATE INSTANCE METHOD ###
219             #
220             # Return a new Exception object
221             #
222              
223             sub _exception {
224 10     10   357 my ($self, $arg) = @_;
225            
226 10         14 my $direction = $arg->{direction};
227              
228 10         213 my $config = $self->config;
229 10         18 my $getter_class = "exception_class_$direction";
230 10         12 my $getter_debug = "debug_$direction";
231            
232 10         197 my $exception_class = $config->$getter_class();
233 10         186 my $debug = $config->$getter_debug();
234            
235 10         458 eval "require $exception_class";
236            
237 10 100       71 $arg->{debug} = !!$debug unless defined $arg->{debug};
238 10 100       37 $arg->{where} = get_caller_info(2) unless defined $arg->{where};
239            
240 10         214 $arg->{verbose} = $config->verbose_exceptions();
241            
242 10         28 return $exception_class->new($arg);
243             }
244              
245             1;