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