line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lim::RPC::Call; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
40
|
use common::sense; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
48
|
|
4
|
7
|
|
|
7
|
|
346
|
use Carp; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
518
|
|
5
|
|
|
|
|
|
|
|
6
|
7
|
|
|
7
|
|
46
|
use Log::Log4perl (); |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
157
|
|
7
|
7
|
|
|
7
|
|
39
|
use Scalar::Util qw(blessed weaken); |
|
7
|
|
|
|
|
337
|
|
|
7
|
|
|
|
|
367
|
|
8
|
|
|
|
|
|
|
|
9
|
7
|
|
|
7
|
|
38
|
use Lim (); |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
107
|
|
10
|
7
|
|
|
7
|
|
586
|
use Lim::Error (); |
|
7
|
|
|
|
|
19
|
|
|
7
|
|
|
|
|
128
|
|
11
|
7
|
|
|
7
|
|
4295
|
use Lim::Util (); |
|
7
|
|
|
|
|
95
|
|
|
7
|
|
|
|
|
224
|
|
12
|
7
|
|
|
7
|
|
1460
|
use Lim::RPC (); |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
145
|
|
13
|
7
|
|
|
7
|
|
5353
|
use Lim::RPC::Client (); |
|
7
|
|
|
|
|
25
|
|
|
7
|
|
|
|
|
15340
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=encoding utf8 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
... |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 VERSION |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
See L for version. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=over 4 |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=item OK |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=item ERROR |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=back |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=cut |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
our $VERSION = $Lim::VERSION; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub OK (){ 1 } |
38
|
|
|
|
|
|
|
sub ERROR (){ -1 } |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 SYNOPSIS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
... |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head2 new |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub new { |
51
|
0
|
|
|
0
|
1
|
|
my $this = shift; |
52
|
0
|
|
0
|
|
|
|
my $class = ref($this) || $this; |
53
|
0
|
|
|
|
|
|
my $self = { |
54
|
|
|
|
|
|
|
logger => Log::Log4perl->get_logger, |
55
|
|
|
|
|
|
|
status => 0 |
56
|
|
|
|
|
|
|
}; |
57
|
0
|
|
|
|
|
|
bless $self, $class; |
58
|
0
|
|
|
|
|
|
my $real_self = $self; |
59
|
0
|
|
|
|
|
|
weaken($self); |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
$self->{plugin} = shift; |
62
|
0
|
|
|
|
|
|
$self->{call} = shift; |
63
|
0
|
|
|
|
|
|
$self->{call_def} = shift; |
64
|
0
|
|
|
|
|
|
$self->{component} = shift; |
65
|
0
|
|
|
|
|
|
my ($data, $cb, $args, $method, $uri); |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$args = {}; |
68
|
0
|
0
|
|
|
|
|
if (scalar @_ == 1) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
unless (ref($_[0]) eq 'CODE') { |
70
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Given one argument but its not a CODE callback'; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
$cb = $_[0]; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
elsif (scalar @_ == 2) { |
76
|
0
|
0
|
|
|
|
|
if (ref($_[0]) eq 'CODE') { |
|
|
0
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
$cb = $_[0]; |
78
|
0
|
|
|
|
|
|
$args = $_[1]; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
elsif (ref($_[1]) eq 'CODE') { |
81
|
0
|
|
|
|
|
|
$data = $_[0]; |
82
|
0
|
|
|
|
|
|
$cb = $_[1]; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
else { |
85
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Given two arguments but non are CODE callback'; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
elsif (scalar @_ == 3) { |
89
|
0
|
0
|
|
|
|
|
unless (ref($_[1]) eq 'CODE') { |
90
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Given three argument but second its not a CODE callback'; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
$data = $_[0]; |
94
|
0
|
|
|
|
|
|
$cb = $_[1]; |
95
|
0
|
|
|
|
|
|
$args = $_[2]; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
else { |
98
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Too many arguments'; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
0
|
0
|
|
|
|
|
unless (ref($args) eq 'HASH') { |
102
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Given an arguments argument but its not an hash'; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
0
|
0
|
|
|
|
|
unless (defined $self->{call}) { |
106
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': No call specified'; |
107
|
|
|
|
|
|
|
} |
108
|
0
|
0
|
0
|
|
|
|
unless (defined $self->{call_def} and ref($self->{call_def}) eq 'HASH') { |
109
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': No call definition specified or invalid'; |
110
|
|
|
|
|
|
|
} |
111
|
0
|
0
|
0
|
|
|
|
unless (blessed $self->{component} and $self->{component}->isa('Lim::Component::Client')) { |
112
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': No component specified or not a Lim::Component::Client'; |
113
|
|
|
|
|
|
|
} |
114
|
0
|
0
|
|
|
|
|
unless (defined $cb) { |
115
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': No cb specified'; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
|
if (defined $args->{host}) { |
119
|
0
|
|
|
|
|
|
$self->{host} = $args->{host}; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
else { |
122
|
0
|
|
|
|
|
|
$self->{host} = Lim::Config->{host}; |
123
|
|
|
|
|
|
|
} |
124
|
0
|
0
|
|
|
|
|
if (defined $args->{port}) { |
125
|
0
|
|
|
|
|
|
$self->{port} = $args->{port}; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
else { |
128
|
0
|
|
|
|
|
|
$self->{port} = Lim::Config->{port}; |
129
|
|
|
|
|
|
|
} |
130
|
0
|
|
|
|
|
|
$self->{cb} = $cb; |
131
|
|
|
|
|
|
|
|
132
|
0
|
0
|
|
|
|
|
unless (defined $self->{host}) { |
133
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': No host specified'; |
134
|
|
|
|
|
|
|
} |
135
|
0
|
0
|
|
|
|
|
unless (defined $self->{port}) { |
136
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': No port specified'; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
0
|
0
|
0
|
|
|
|
if (defined $data and ref($data) ne 'HASH') { |
140
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Data is not a hash'; |
141
|
|
|
|
|
|
|
} |
142
|
0
|
0
|
0
|
|
|
|
if (exists $self->{call_def}->{in}) { |
|
|
0
|
|
|
|
|
|
143
|
0
|
0
|
|
|
|
|
Lim::RPC::V(defined $data ? $data : {}, $self->{call_def}->{in}); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
elsif (defined $data and %$data) { |
146
|
0
|
|
|
|
|
|
confess __PACKAGE__, ': Data given without in parameter definition'; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
($method, $uri) = Lim::Util::URIize($self->{call}); |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
$uri = '/'.lc($self->{plugin}).$uri; |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
$self->{component}->_addCall($real_self); |
154
|
|
|
|
|
|
|
$self->{client} = Lim::RPC::Client->new( |
155
|
|
|
|
|
|
|
host => $self->{host}, |
156
|
|
|
|
|
|
|
port => $self->{port}, |
157
|
|
|
|
|
|
|
method => $method, |
158
|
|
|
|
|
|
|
uri => $uri, |
159
|
|
|
|
|
|
|
data => $data, |
160
|
|
|
|
|
|
|
cb => sub { |
161
|
0
|
|
|
0
|
|
|
my (undef, $data) = @_; |
162
|
|
|
|
|
|
|
|
163
|
0
|
0
|
|
|
|
|
if ($self->{client}->status == Lim::RPC::Client::OK) { |
164
|
0
|
|
|
|
|
|
$self->{status} = OK; |
165
|
0
|
0
|
|
|
|
|
if (exists $self->{call_def}->{out}) { |
|
|
0
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
eval { |
167
|
0
|
|
|
|
|
|
Lim::RPC::V($data, $self->{call_def}->{out}); |
168
|
|
|
|
|
|
|
}; |
169
|
0
|
0
|
|
|
|
|
if ($@) { |
170
|
0
|
|
|
|
|
|
$self->{error} = Lim::Error->new( |
171
|
|
|
|
|
|
|
message => $@, |
172
|
|
|
|
|
|
|
module => $self |
173
|
|
|
|
|
|
|
); |
174
|
0
|
|
|
|
|
|
$self->{status} = ERROR; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
elsif (%$data) { |
178
|
0
|
|
|
|
|
|
$self->{error} = Lim::Error->new( |
179
|
|
|
|
|
|
|
message => 'Invalid data return, does not match definition', |
180
|
|
|
|
|
|
|
module => $self |
181
|
|
|
|
|
|
|
); |
182
|
0
|
|
|
|
|
|
$self->{status} = ERROR; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
else { |
186
|
0
|
|
|
|
|
|
$self->{status} = ERROR; |
187
|
0
|
0
|
0
|
|
|
|
if (blessed $data and $data->isa('Lim::Error')) { |
188
|
0
|
|
|
|
|
|
$self->{error} = $data; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
else { |
191
|
0
|
|
|
|
|
|
$self->{error} = Lim::Error->new( |
192
|
|
|
|
|
|
|
message => $data, |
193
|
|
|
|
|
|
|
module => $self |
194
|
|
|
|
|
|
|
); |
195
|
|
|
|
|
|
|
} |
196
|
0
|
|
|
|
|
|
undef($data); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
delete $self->{client}; |
200
|
0
|
|
|
|
|
|
$self->{cb}->($self, $data); |
201
|
0
|
|
|
|
|
|
$self->{component}->_deleteCall($self); |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
0
|
0
|
|
|
|
|
Lim::OBJ_DEBUG and $self->{logger}->debug('new ', __PACKAGE__, ' ', $self); |
206
|
0
|
|
|
|
|
|
$real_self; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub DESTROY { |
210
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
211
|
0
|
0
|
|
|
|
|
Lim::OBJ_DEBUG and $self->{logger}->debug('destroy ', __PACKAGE__, ' ', $self); |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head2 Successful |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=cut |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub Successful { |
219
|
0
|
|
|
0
|
1
|
|
$_[0]->{status} == OK; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 Error |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub Error { |
227
|
0
|
|
|
0
|
1
|
|
$_[0]->{error}; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head2 ResetTimeout |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub ResetTimeout { |
235
|
0
|
0
|
|
0
|
1
|
|
if (exists $_[0]->{client}) { |
236
|
0
|
|
|
|
|
|
$_[0]->{client}->reset_timeout; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 AUTHOR |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Jerry Lundström, C<< >> |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head1 BUGS |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
Please report any bugs or feature requests to L. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head1 SUPPORT |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
perldoc Lim |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
You can also look for information at: |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=over 4 |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=item * Lim issue tracker (report bugs here) |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
L |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=back |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Copyright 2012-2013 Jerry Lundström. |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
271
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
272
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=cut |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
1; # End of Lim::RPC::Call |