File Coverage

blib/lib/HTTP/MultiGet/Role.pm
Criterion Covered Total %
statement 102 119 85.7
branch 21 34 61.7
condition 4 6 66.6
subroutine 25 27 92.5
pod 8 11 72.7
total 160 197 81.2


line stmt bran cond sub pod time code
1             package HTTP::MultiGet::Role;
2              
3 2     2   1148335 use Modern::Perl;
  2         11  
  2         11  
4 2     2   304 use Moo::Role;
  2         4  
  2         12  
5 2     2   1852 use MooX::Types::MooseLike::Base qw(:all);
  2         14181  
  2         741  
6 2     2   1060 use AnyEvent::HTTP::MultiGet;
  2         7  
  2         63  
7 2     2   14 use AnyEvent;
  2         4  
  2         40  
8 2     2   1507 use JSON qw();
  2         16356  
  2         57  
9 2     2   15 use Data::Dumper;
  2         4  
  2         105  
10 2     2   12 use Carp qw(croak);
  2         4  
  2         85  
11 2     2   13 use namespace::clean;
  2         5  
  2         15  
12 2     2   1479 use AnyEvent;
  2         5  
  2         47  
13 2     2   11 use Ref::Util qw(is_plain_arrayref);
  2         3  
  2         115  
14              
15             BEGIN {
16 2     2   14 with 'Log::LogMethods','Data::Result::Moo';
17             }
18              
19             our $AUTOLOAD;
20              
21             =head1 NAME
22              
23             HTTP::MultiGet::Role - Role for building blocking/non-blocking AnyEvent friendly REST Clients
24              
25             =head1 SYNOPSIS
26              
27             package My::Rest::Class;
28              
29             use Modern::Perl;
30             use Moo;
31             BEGIN { with 'HTTP::MultiGet::Role' }
32              
33             sub que_some_request {
34             my ($self,$cb)=@_;
35             my $request=HTTP::Request->new(GET=>'https://some_json_endpoint');
36             return $self->queue_request($request,$cb);
37             }
38              
39              
40             Blocking Example
41              
42             # blocking context
43             use My::Rest::Class;
44              
45             my $self=new My::Rest::Class;
46             my $result=$self->some_request;
47             die $result unless $result;
48              
49              
50             NonBlocking Example
51              
52             # non blocking
53             use AnyEvent::Loop;
54             use My::Rest::Class;
55              
56             my $self=new My::Rest::Class;
57             my $id=$self->some_request(sub {
58             my ($self,$id,$result,$request,$response)=@_;
59             });
60              
61             $obj->agent->run_next;
62             AnyEvent::Loop::run;
63              
64             =head1 DESCRIPTION
65              
66             In the real world we are often confronted with a situation of needing and or wanting blocking and non-blocking code, but we normally only have time to develop one or the other. This class provided an AnyEvent friendly framework that solves some of the issues involved in creating both with 1 code base.
67              
68             The solution presented by this module is to simply develop the non blocking interface and dynamically AUTOLOAD the blocking interface as needed. One of the major advantages of this model of coding is it becomes possible to create asyncronous calls in what looks like syncronous code.
69              
70             More documentation comming soon.. time permitting.
71              
72             =cut
73              
74             our %MULTIGET_ARRGS=(
75             timeout=>300,
76             max_que_count=>20,
77             );
78              
79             our $VERSION=$HTTP::MultiGet::VERSION;
80              
81             =head1 OO Declarations
82              
83             This section documents the Object Declarations. ALl of these arguments are optional and autogenerated on demand if not passed into the constructor.
84              
85             agnet: AnyEvent::HTTP::MultiGet object
86             json: JSON object
87              
88             Run Time State Settings ( modify at your own risk!! )
89              
90             is_blocking: Boolean ( denotes if we are in a blocking context or not )
91             block_for_more: array ref of additoinal ids to block for in a blocking context
92             pending: hash ref that outbound request objects
93             result_map: hash ref that contains the inbound result objects
94             jobs: anonymous hash, used to keep our results that never hit IO
95              
96             Success Range for parsing json
97              
98             As of version 1.017 a range of codes can now be set to validate if the response should be parsed as json
99              
100             code_parse_start: 199 # if the response code is greater than
101             code_parse_end: 300 # if the response code is less than
102              
103             =cut
104              
105             has agent=>(
106             is=>'ro',
107             isa=>Object,
108             required=>1,
109             default=>sub {
110             new AnyEvent::HTTP::MultiGet(%MULTIGET_ARRGS)
111             },
112             lazy=>1,
113             );
114              
115              
116             has jobs=>(
117             is=>'ro',
118             default=>sub { {} },
119             lazy=>1,
120             );
121              
122             has is_blocking=>(
123             is=>'rw',
124             isa=>Bool,
125             default=>0,
126             lazy=>1,
127             );
128              
129             has block_for_more=>(
130             is=>'rw',
131             isa=>ArrayRef,
132             default=>sub { [] },
133             lazy=>1,
134             );
135              
136             has json =>(
137             is=>'ro',
138             isa=>Object,
139             required=>1,
140             lazy=>1,
141             default=>sub {
142             my $json=JSON->new->allow_nonref(&JSON::true)->utf8->relaxed(&JSON::true);
143             return $json;
144             },
145             );
146              
147             has pending=>(
148             is=>'ro',
149             isa=>HashRef,
150             required=>1,
151             default=>sub { {} },
152             lazy=>1,
153             );
154              
155             has result_map=>(
156             is=>'ro',
157             isa=>HashRef,
158             required=>1,
159             default=>sub { {} },
160             lazy=>1,
161             );
162              
163             has code_parse_start=>(
164             is=>'rw',
165             isa=>Int,
166             default=>199
167             );
168              
169             has code_parse_end=>(
170             is=>'rw',
171             isa=>Int,
172             default=>300
173             );
174              
175             =head1 OO Methods
176              
177             =over 4
178              
179             =item * my $result=$self->new_true({qw( some data )});
180              
181             Returns a new true Data::Result object.
182              
183             =item * my $result=$self->new_false("why this failed")
184              
185             Returns a new false Data::Result object
186              
187             =item * my $code=$self->cb;
188              
189             Internal object used to construct the global callback used for all http responses. You may need to overload this method in your own class.
190              
191             =cut
192              
193             sub cb {
194 2     2 1 21 my ($self)=@_;
195 2 100       9 return $self->{cb} if exists $self->{cb};
196             my $code=sub {
197 2     2   6 my ($mg,$ref,$response)=@_;
198 2 50       6 my $request=is_plain_arrayref($ref) ? $ref->[0] : $ref;
199 2 50       36 unless(exists $self->pending->{$request}) {
200              
201 0         0 $self->log_error("Request wasn't found!");
202 0         0 croak "Request Object wasn't found!";
203             }
204 2         20 my ($id,$cb)=@{delete $self->pending->{$request}};
  2         43  
205 2         24 my $result=$self->parse_response($request,$response);
206 2         432 $cb->($self,$id,$result,$request,$response);
207 1         7 };
208 1         3 $self->{cb}=$code;
209 1         7 return $code;
210             }
211              
212             =item * my $result=$self->parse_response($request,$response);
213              
214             Returns a Data::Result object, if true it contains the parsed result object, if false it contains why it failed. If you are doing anything other than parsing json on a 200 to 299 response you will need to overload this method.
215              
216             =cut
217              
218             sub parse_response {
219 309     309 1 383671 my ($self,$request,$response)=@_;
220              
221 309         825 my $content=$response->decoded_content;
222 309 50       34537 $content='' unless defined($content);
223 309 100 100     809 if($response->code >$self->code_parse_start && $response->code <$self->code_parse_end) {
224 301 50 33     19664 if(length($content)!=0 and $content=~ /^\s*[\[\{\"]/s) {
225 301         496 my $data=eval {$self->json->decode($content)};
  301         4987  
226 301 50       3664 if($@) {
227 0         0 return $self->new_false("Code: [".$response->code."] JSON Decode error [$@] Content: $content");
228             } else {
229 301         857 return $self->new_true($data);
230             }
231             } else {
232 0         0 return $self->new_true($content,$response);
233             }
234             } else {
235 8         468 return $self->new_false("Code: [".$response->code."] http error [".$response->status_line."] Content: $content");
236             }
237             }
238              
239             =item * my $id=$self->queue_request($request,$cb|undef);
240              
241             Returns an Id for the qued request. If $cb is undef then the default internal blocking callback is used.
242              
243             =cut
244              
245             sub queue_request {
246 2     2 1 7687 my ($self,$request,$cb)=@_;
247 2 50       7 $cb=$self->get_block_cb unless defined($cb);
248 2         43 my $id=$self->agent->add_cb($request,$self->cb);
249 2 50       6 my $req=is_plain_arrayref($request) ? $request->[0] : $request;
250 2         42 $self->pending->{$req}=[$id,$cb];
251 2         56 return $id;
252             }
253              
254             =item * my $id=$self->queue_result($cb,$result);
255              
256             Alows for result objects to look like they were placed in the the job que but wern't.
257              
258             Call back example
259              
260             sub {
261             my ($self,$id,$result,undef,undef)=@_;
262             # 0 Current object class
263             # 1 fake_id
264             # 2 Data::Result Object ( passed into $self->queue_result )
265             # 3 undef
266             # 4 undef
267             };
268              
269             =cut
270              
271             sub queue_result {
272 4     4 1 5185 my ($self,$cb,$result)=@_;
273 4 100       12 $cb=\&block_cb unless $cb;
274 4 50       11 $result=$self->new_false("unknown error") unless defined($result);
275 4         7 my $id;
276             $id=$self->agent->add_result(sub {
277 4     4   11 $cb->($self,$id,$result,undef,undef);
278 4         69 });
279             }
280              
281             sub has_fake_jobs {
282 0     0 0 0 return $_[0]->agent->has_fake_jobs;
283             }
284              
285             =item * my $results=$self->block_on_ids(@ids);
286              
287             Scalar context returns an array ref.
288              
289             =item * my @results=$self->block_on_ids(@ids);
290              
291             Returns a list of array refrences.
292              
293             Each List refrence contains the follwing
294              
295             0: Data::Result
296             1: HTTP::Request
297             2: HTTP::Result
298              
299             Example
300              
301             my @results=$self->block_on_ids(@ids);
302             foreach my $set (@results) {
303             my ($result,$request,$response)=@{$set};
304             if($result)
305             ...
306             } else {
307             ...
308             }
309             }
310              
311             =cut
312              
313             sub block_on_ids {
314 6     6 1 21 my ($self,@ids)=@_;
315 6         23 my @init=@ids;
316              
317 6         181 $self->agent->block_for_results_by_id(@ids);
318 6         761 my $ref={};
319              
320 6         11 while($#{$self->block_for_more}!=-1) {
  6         102  
321 0         0 @ids=@{$self->block_for_more};
  0         0  
322 0         0 @{$self->block_for_more}=();
  0         0  
323 0         0 $self->agent->run_next;
324 0         0 $self->agent->block_for_results_by_id(@ids);
325             }
326              
327 6         132 my $results=[delete @{$self->result_map}{@init}];
  6         149  
328 6 50       71 return wantarray ? @{$results} : $results;
  0         0  
329             }
330              
331             =item * $self->add_ids_for_blocking(@ids);
332              
333             This method solves the chicken and the egg senerio when a calback generates other callbacks. In a non blocking context this is fine, but in a blocking context there are 2 things to keep in mind: 1. The jobs created by running the inital request didn't exist when the id was created. 2. The outter most callback id must always be used when processing the final callback or things get wierd.
334              
335             The example here is a litteral copy paste from L<Net::AppDynamics::REST>
336              
337             sub que_walk_all {
338             my ($self,$cb)=@_;
339              
340             my $state=1;
341             my $data={};
342             my $total=0;
343             my @ids;
344              
345             my $app_cb=sub {
346             my ($self,$id,$result,$request,$response)=@_;
347              
348             if($result) {
349             foreach my $obj (@{$result->get_data}) {
350             $data->{ids}->{$obj->{id}}=$obj;
351             $obj->{our_type}='applications';
352             $data->{applications}->{$obj->{name}}=[] unless exists $data->{applications}->{$obj->{name}};
353             push @{$data->{applications}->{$obj->{name}}},$obj->{id};
354             foreach my $method (qw(que_list_nodes que_list_tiers que_list_business_transactions)) {
355             ++$total;
356             my $code=sub {
357             my ($self,undef,$result,$request,$response)=@_;
358             return unless $state;
359             return ($cb->($self,$id,$result,$request,$response,$method,$obj),$state=0) unless $result;
360             --$total;
361             foreach my $sub_obj (@{$result->get_data}) {
362             my $target=$method;
363             $target=~ s/^que_list_//;
364              
365             foreach my $field (qw(name machineName)) {
366             next unless exists $sub_obj->{$field};
367             my $name=uc($sub_obj->{$field});
368             $data->{$target}->{$name}=[] unless exists $data->{$target}->{$name};
369             push @{$data->{$target}->{$name}},$sub_obj->{id};
370             }
371             $sub_obj->{ApplicationId}=$obj->{id};
372             $sub_obj->{ApplicationName}=$obj->{name};
373             $sub_obj->{our_type}=$target;
374             $data->{ids}->{$sub_obj->{id}}=$sub_obj;
375             }
376              
377             if($total==0) {
378             return ($cb->($self,$id,$self->new_true($data),$request,$response,'que_walk_all',$obj),$state=0)
379             }
380             };
381             push @ids,$self->$method($code,$obj->{id});
382             }
383             }
384             } else {
385             return $cb->($self,$id,$result,$request,$response,'que_list_applications',undef);
386             }
387             $self->add_ids_for_blocking(@ids);
388             };
389              
390             return $self->que_list_applications($app_cb);
391             }
392              
393             =cut
394              
395             sub add_ids_for_blocking {
396 0     0 1 0 my ($self,@ids)=@_;
397 0 0       0 return unless $self->is_blocking;
398 0         0 push @{$self->block_for_more},@ids;
  0         0  
399             }
400              
401             =item * my $code=$self->block_cb($id,$result,$request,$response);
402              
403             For internal use Default callback method used for all que_ methods.
404              
405             =cut
406              
407             sub block_cb {
408 6     6 1 20 my ($self,$id,$result,$request,$response)=@_;
409 6         106 $self->result_map->{$id}=[$result,$request,$response];
410             }
411              
412             =item * my $cb=$self->get_block_cb
413              
414             For Internal use, Returns the default blocking callback: \&block_cbblock_cb
415              
416             =cut
417              
418             sub get_block_cb {
419 5     5 1 25 return \&block_cb;
420             }
421              
422             =back
423              
424             =head1 Non-Blocking Interfaces
425              
426             Every Non-Blocking method has a contrasting blocking method that does not accept a code refrence. All of the blocking interfaces are auto generated using AUTOLOAD. This section documents the non blocking interfaces.
427              
428             All Non Blocking methods provide the following arguments to the callback.
429              
430             my $code=sub {
431             my ($self,$id,$result,$request,$response)=@_;
432             if($result) {
433             print Dumper($result->get_data);
434             } else {
435             warn $result;
436             }
437             }
438              
439             $self->que_xxx($code,$sql);
440              
441             The code refrence $code will be calld when the HTTP::Response has been recived.
442              
443             Callback variables
444              
445             $self
446             This Net::AppDynamics::REST Object
447             $id
448             The Job ID ( used internally )
449             $result
450             A Data::Result Object, when true it contains the results, when false it contains why things failed
451             $request
452             HTTP::Requst Object that was sent to SolarWinds to make this request
453             $response
454             HTTP::Result Object that represents the response from SolarWinds
455              
456             =head1 Blocking Interfaces
457              
458             All Blocking interfaces are generated with the AUTOLOAD method. Each method that begins with que_xxx can be calld in a blocking method.
459              
460             Example:
461              
462             # my $id=$self->que_list_applications(sub {});
463              
464             # can called as a blocking method will simply return the Data::Result object
465             my $result=$self->list_applications;
466              
467             =cut
468              
469             sub AUTOLOAD {
470 5     5   8016 my ($self,@args)=@_;
471              
472 5         61 AnyEvent->now_update;
473 5         70 my $method=$AUTOLOAD;
474 5         29 $method=~ s/^.*:://s;
475 5 50       22 return if $method eq 'DESTROY';
476              
477 5         140 $self->is_blocking(1);
478 5         255 my $que_method="que_$method";
479 5 50       17 unless($self->can($que_method)) {
480 0         0 croak "Undefined subroutine $method";
481             }
482              
483 5         19 my @ids=$self->$que_method($self->get_block_cb,@args);
484 5         83 $self->agent->run_next;
485 5         1714 my $result=$self->block_on_ids(@ids)->[0]->[0];
486              
487 5         112 $self->is_blocking(0);
488 5         202 return $result;
489             }
490              
491             sub can {
492 22     22 0 40891 my ($self,$method)=@_;
493 22         138 my $sub=$self->SUPER::can($method);
494              
495 22 100       92 return $sub if $sub;
496              
497 4         12 my $que_method="que_$method";
498 4 100       104 return undef unless $self->SUPER::can($que_method);
499              
500             $sub=sub {
501 1     1   315 $AUTOLOAD=$method;
502 1         5 $self->AUTOLOAD(@_);
503 1         9 };
504              
505 1         3 return $sub;
506             }
507              
508       1 0   sub DEMOLISH { }
509              
510             =head1 See Also
511              
512             L<https://docs.appdynamics.com/display/PRO43/AppDynamics+APIs>
513              
514             L<AnyEvent::HTTP::MultiGet>
515              
516             =head1 AUTHOR
517              
518             Michael Shipper L<mailto:AKALINUX@CPAN.ORG>
519              
520             =cut
521              
522             1;