File Coverage

blib/lib/Eixo/Rest/Client.pm
Criterion Covered Total %
statement 122 169 72.1
branch 28 40 70.0
condition 4 16 25.0
subroutine 26 35 74.2
pod 0 13 0.0
total 180 273 65.9


line stmt bran cond sub pod time code
1             package Eixo::Rest::Client;
2 3     3   1007636 use strict;
  3         13  
  3         140  
3              
4 3     3   789 use Eixo::Base::Clase;
  3         14209  
  3         23  
5              
6 3     3   3189 use URI;
  3         18812  
  3         172  
7 3     3   3523 use LWP::UserAgent;
  3         149899  
  3         147  
8 3     3   2177 use LWP::Protocol::https;
  3         711424  
  3         172  
9 3     3   1324 use JSON -convert_blessed_universally;
  3         16228  
  3         51  
10 3     3   1414 use Carp;
  3         9  
  3         334  
11 3     3   20 use Data::Dumper;
  3         8  
  3         222  
12              
13 3     3   20 use Config;
  3         5  
  3         154  
14 3     3   2122 use Eixo::Rest::RequestSync;
  3         15  
  3         46  
15              
16              
17              
18             my $REQ_PARSER = qr/\:\:([a-z]+)([A-Z]\w+?)$/;
19              
20             my $USER_AGENT_VERSION = 'EixoAgent/0.1';
21              
22             has(
23              
24             ua=>undef,
25             endpoint=>undef,
26             format=>'json',
27             error_callback => undef,
28             current_method => undef,
29             );
30              
31             sub initialize{
32 3     3 0 2481 my ($self, $endpoint, %opts) = @_;
33              
34 3         25 $self->endpoint($endpoint);
35              
36 3 50       31 die("API ENDPOINT NEEDED") unless($self->endpoint);
37              
38 3         107 $self->ua($USER_AGENT_VERSION, %opts);
39              
40 3         8 $self;
41             }
42              
43             sub ua {
44 10     10 0 1197 my ($self, $ua_str, %opts) = @_;
45              
46 10 100       75 if($ua_str){
47 3         134 my $ua = LWP::UserAgent->new(%opts);
48 3         10185 $ua->agent($ua_str);
49 3         166 $self->{ua} = $ua;
50             }
51              
52 10         51 return $self->{ua};
53             }
54              
55              
56              
57             sub AUTOLOAD{
58 8     8   3068 my ($self, %args) = @_;
59              
60 8         136 my ($method, $entity) = our $AUTOLOAD =~ $REQ_PARSER;
61            
62             # store current method for tracing
63 8         63 $self->current_method($method.$entity);
64              
65 8         77 $entity = lc($entity);
66              
67 8 100       26 unless(grep { $method eq $_ } qw(put get post delete patch)){
  40         112  
68 1         464 confess(ref($self) . ': UNKNOW METHOD: ' . $method);
69             }
70              
71 7         25 my ($id, $action);
72              
73 7 100       34 if(exists($args{id})){
74 1         3 $id = $args{id};
75 1         3 delete($args{id});
76             }
77              
78 7 100       39 if(exists($args{action})){
79 2         3 $action = $args{action};
80 2         4 delete($args{action});
81             }
82              
83 7 50       28 if($args{__job_id}){
84 0         0 $args{'__client_send_method'} = '__sendAsync';
85             }
86             else{
87 7         37 $args{'__client_send_method'} = '__send';
88             }
89              
90 7 100       55 if(!$args{__format}){
91 5         43 $args{__format} = $self->format;
92             }
93              
94             # set error_callback unless already established
95 7 50       75 unless(defined($args{PROCESS_DATA}->{onError})){
96            
97             $args{PROCESS_DATA}->{onError} = sub {
98            
99 0     0   0 $self->remote_error(@_);
100            
101 7         65 };
102             }
103              
104 7         14 my $uri;
105              
106 7 100       40 if($uri = $args{uri}) {
107 2         12 $uri = $self->build_predefined_uri($uri);
108             }
109             else{
110 5         54 $uri = $self->build_uri($entity, $id, $action, $args{__implicit_format});
111             }
112              
113 7         434820 $self->$method($uri, %args);
114              
115             }
116              
117       0     sub DESTROY {}
118              
119             sub head: Log {
120 0     0 0 0 my ($self, $uri, %args) = @_;
121              
122 0         0 $uri->query_form($args{GET_DATA});
123              
124 0         0 my $req = HTTP::Request->new(GET => $uri);
125              
126 0   0     0 $self->set_headers($req, $args{HEADER_DATA} || {});
127              
128 0         0 my $send_method = $args{__client_send_method};
129              
130 0         0 $self->$send_method($req, %args);
131 3     3   2341 }
  3         8  
  3         76  
132              
133             sub get: Log {
134              
135 5     3 0 92 my ($self, $uri, %args) = @_;
136              
137 5         61 $uri->query_form($args{GET_DATA});
138              
139 5         5071 my $req = HTTP::Request->new(GET => $uri);
140              
141 5   50     751 $self->set_headers($req, $args{HEADER_DATA} || {});
142              
143 5         17 my $send_method = $args{__client_send_method};
144              
145 5         61 $self->__encode_request_body($req,%args);
146              
147 5         107 $self->$send_method($req, %args);
148 3     3   1410 }
  3         9  
  3         15  
149              
150             sub post: Log {
151 2     2 0 10 my ($self,$uri,%args) = @_;
152              
153             # Is possible to add query string args to post requests
154 2         10 $uri->query_form($args{GET_DATA});
155              
156 2         99 my $req = HTTP::Request->new(POST => $uri);
157            
158 2   50     140 $self->set_headers($req, $args{HEADER_DATA} || {});
159              
160 2         17 my $send_method = $args{__client_send_method};
161              
162 2         16 $self->__encode_request_body($req,%args);
163              
164 2         44 $self->$send_method($req, %args);
165 3     3   989 }
  3         6  
  3         20  
166              
167             sub delete: Log {
168              
169 0     0 0 0 my ($self, $uri, %args) = @_;
170              
171 0         0 $uri->query_form($args{GET_DATA});
172              
173 0         0 my $req = HTTP::Request->new(DELETE => $uri);
174              
175 0   0     0 $self->set_headers($req, $args{HEADER_DATA} || {});
176              
177 0         0 my $send_method = $args{__client_send_method};
178              
179 0         0 $self->__encode_request_body($req,%args);
180              
181 0         0 $self->$send_method($req, %args);
182 3     3   967 }
  3         6  
  3         16  
183              
184             sub patch: Log {
185 0     0 0 0 my ($self, $uri, %args) = @_;
186              
187 0         0 $uri->query_form($args{GET_DATA});
188              
189 0         0 my $req = HTTP::Request->new(PATCH => $uri);
190              
191 0   0     0 $self->set_headers($req, $args{HEADER_DATA} || {});
192              
193 0         0 my $send_method = $args{__client_send_method};
194              
195 0         0 $self->__encode_request_body($req,%args);
196              
197 0         0 $self->$send_method($req, %args);
198              
199 3     3   1041 }
  3         7  
  3         19  
200              
201             sub put: Log {
202 0     0 0 0 my ($self, $uri, %args) = @_;
203              
204 0         0 $uri->query_form($args{GET_DATA});
205              
206 0         0 my $req = HTTP::Request->new(PUT=> $uri);
207              
208 0   0     0 $self->set_headers($req, $args{HEADER_DATA} || {});
209              
210 0         0 my $send_method = $args{__client_send_method};
211              
212 0         0 $self->__encode_request_body($req,%args);
213              
214 0         0 $self->$send_method($req, %args);
215 3     3   972 }
  3         6  
  3         16  
216              
217              
218             sub __encode_request_body{
219 7     7   38 my ($self,$req, %args) = @_;
220              
221 7 100       35 return unless($args{POST_DATA});
222              
223 4         6 my $content;
224 4   50     29 my $content_type = $req->header('Content-Type')
225             || 'application/json';
226             #|| 'application/x-www-form-urlencoded';
227              
228 4 50       267 if($content_type eq "application/json"){
229              
230             $content = JSON->new->allow_blessed(1)
231             ->convert_blessed(1)#->utf8
232 4   50     152 ->encode($args{POST_DATA} || {});
233             }
234             else{
235            
236             # application/x-www-form-urlencoded
237             # raw stream
238 0 0       0 while(my ($key, $value) = each (%{$args{POST_DATA} || {}})){
  0         0  
239 0         0 $content .= "$key=$value&";
240             }
241              
242             }
243              
244 4         35 $req->header("Content-Type", "$content_type; charset=utf-8");
245 4 50       186 $req->add_content_utf8($content) if($content);
246              
247             }
248              
249              
250             sub build_uri {
251 5     5 0 20 my ($self, $entity, $id,$action, $implicit_format) = @_;
252              
253 5         22 my $uri = $self->{endpoint}.'/'.$entity;
254            
255 5 100       20 $uri .= '/'.$id if(defined($id));
256 5 100       20 $uri .= '/'.$action if(defined($action));
257              
258 5 100       40 return URI->new($uri) if($implicit_format);
259              
260             ($self->current_method =~ /^get/)?
261              
262 3 100       23 URI->new($uri.'/'.$self->{format}) :
263              
264             URI->new($uri);
265             }
266              
267             sub build_predefined_uri{
268 2     2 0 5 my ($self, $uri) = @_;
269              
270 2         5 my $endpoint = $self->{endpoint};
271            
272 2 50       20 $endpoint .= "/" unless($endpoint =~ /\/$/);
273              
274 2         12 $uri =~ s/^\///;
275              
276 2         23 return URI->new($endpoint . $uri)
277             }
278              
279              
280             sub generate_query_str {
281 0     0 0 0 my ($self, %args) = @_;
282              
283 0         0 join '&', map {"$_=$args{$_}"} keys(%args);
  0         0  
284             }
285              
286              
287             sub __send{
288 7     7   31 my ($self, $req, %args) = @_;
289              
290             Eixo::Rest::RequestSync->new(
291              
292             callback=>$args{__callback},
293              
294 7         140 %{$args{PROCESS_DATA}},
295              
296             __format=>$args{__format}
297              
298 7         18 )->send(
299              
300             $self->ua(),
301              
302             $req
303              
304             );
305              
306             }
307              
308             sub __sendAsync{
309 0     0   0 my ($self, $req, %args) = @_;
310              
311 0 0       0 die("unsupported: ERROR: This Perl not built to support threads\n") if (! $Config{'useithreads'});
312              
313 0         0 eval 'use Eixo::Rest::RequestAsync';
314              
315             Eixo::Rest::RequestAsync->new(
316              
317             job_id=>$args{__job_id},
318              
319             api=>$args{api},
320              
321             callback=>$args{__callback},
322              
323 0         0 %{$args{PROCESS_DATA}},
324              
325             __format=>$args{__format}
326              
327 0         0 )->send(
328              
329             $self->ua(),
330              
331             $req
332              
333             );
334              
335             }
336              
337             sub remote_error {
338 0     0 0 0 my ($self,$response) = @_;
339              
340 0         0 my $status = $response->code;
341 0         0 my $extra = $response->content;
342              
343 0 0       0 if(defined($self->error_callback)){
344              
345 0         0 &{$self->error_callback}(
  0         0  
346              
347             $self->current_method,
348              
349             'ERROR_CODE',
350              
351             $status,
352              
353             $extra,
354             #@extra_args
355            
356             );
357             }
358             else{
359 0         0 die "Remote Api error: ($status). Details: $extra\n";
360             }
361             }
362              
363             sub set_headers{
364 7     7 0 17 my ($self, $req, $headers) = @_;
365              
366 7         37 $req->header($_, $headers->{$_}) foreach(keys %$headers);
367             }
368              
369             1;