————————————package
HTTP::MultiGet::Role;
use
Modern::Perl;
use
Moo::Role;
use
AnyEvent;
use
Data::Dumper;
use
namespace::clean;
use
AnyEvent;
BEGIN {
}
our
$AUTOLOAD
;
=head1 NAME
HTTP::MultiGet::Role - Role for building blocking/non-blocking AnyEvent friendly REST Clients
=head1 SYNOPSIS
package My::Rest::Class;
use Modern::Perl;
use Moo;
BEGIN { with 'HTTP::MultiGet::Role' }
sub que_some_request {
my ($self,$cb)=@_;
my $request=HTTP::Request->new(GET=>'https://some_json_endpoint');
return $self->queue_request($request,$cb);
}
Blocking Example
# blocking context
use My::Rest::Class;
my $self=new My::Rest::Class;
my $result=$self->some_request;
die $result unless $result;
NonBlocking Example
# non blocking
use AnyEvent::Loop;
use My::Rest::Class;
my $self=new My::Rest::Class;
my $id=$self->some_request(sub {
my ($self,$id,$result,$request,$response)=@_;
});
$obj->agent->run_next;
AnyEvent::Loop::run;
=head1 DESCRIPTION
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.
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.
More documentation comming soon.. time permitting.
=cut
our
%MULTIGET_ARRGS
=(
timeout
=>300,
max_que_count
=>20,
);
our
$VERSION
=
$HTTP::MultiGet::VERSION
;
=head1 OO Declarations
This section documents the Object Declarations. ALl of these arguments are optional and autogenerated on demand if not passed into the constructor.
agnet: AnyEvent::HTTP::MultiGet object
json: JSON object
Run Time State Settings ( modify at your own risk!! )
is_blocking: Boolean ( denotes if we are in a blocking context or not )
block_for_more: array ref of additoinal ids to block for in a blocking context
pending: hash ref that outbound request objects
result_map: hash ref that contains the inbound result objects
jobs: anonymous hash, used to keep our results that never hit IO
Success Range for parsing json
As of version 1.017 a range of codes can now be set to validate if the response should be parsed as json
code_parse_start: 199 # if the response code is greater than
code_parse_end: 300 # if the response code is less than
=cut
has
agent
=>(
is
=>
'ro'
,
isa
=>Object,
required
=>1,
default
=>
sub
{
new AnyEvent::HTTP::MultiGet(
%MULTIGET_ARRGS
)
},
lazy
=>1,
);
has
jobs
=>(
is
=>
'ro'
,
default
=>
sub
{ {} },
lazy
=>1,
);
has
is_blocking
=>(
is
=>
'rw'
,
isa
=>Bool,
default
=>0,
lazy
=>1,
);
has
block_for_more
=>(
is
=>
'rw'
,
isa
=>ArrayRef,
default
=>
sub
{ [] },
lazy
=>1,
);
has
json
=>(
is
=>
'ro'
,
isa
=>Object,
required
=>1,
lazy
=>1,
default
=>
sub
{
my
$json
=JSON->new->allow_nonref(
&JSON::true
)->utf8->relaxed(
&JSON::true
);
return
$json
;
},
);
has
pending
=>(
is
=>
'ro'
,
isa
=>HashRef,
required
=>1,
default
=>
sub
{ {} },
lazy
=>1,
);
has
result_map
=>(
is
=>
'ro'
,
isa
=>HashRef,
required
=>1,
default
=>
sub
{ {} },
lazy
=>1,
);
has
code_parse_start
=>(
is
=>
'rw'
,
isa
=>Int,
default
=>199
);
has
code_parse_end
=>(
is
=>
'rw'
,
isa
=>Int,
default
=>300
);
=head1 OO Methods
=over 4
=item * my $result=$self->new_true({qw( some data )});
Returns a new true Data::Result object.
=item * my $result=$self->new_false("why this failed")
Returns a new false Data::Result object
=item * my $code=$self->cb;
Internal object used to construct the global callback used for all http responses. You may need to overload this method in your own class.
=cut
sub
cb {
my
(
$self
)=
@_
;
return
$self
->{cb}
if
exists
$self
->{cb};
my
$code
=
sub
{
my
(
$mg
,
$ref
,
$response
)=
@_
;
my
$request
=is_plain_arrayref(
$ref
) ?
$ref
->[0] :
$ref
;
unless
(
exists
$self
->pending->{
$request
}) {
$self
->log_error(
"Request wasn't found!"
);
croak
"Request Object wasn't found!"
;
}
my
(
$id
,
$cb
)=@{
delete
$self
->pending->{
$request
}};
my
$result
=
$self
->parse_response(
$request
,
$response
);
$cb
->(
$self
,
$id
,
$result
,
$request
,
$response
);
};
$self
->{cb}=
$code
;
return
$code
;
}
=item * my $result=$self->parse_response($request,$response);
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.
=cut
sub
parse_response {
my
(
$self
,
$request
,
$response
)=
@_
;
my
$content
=
$response
->decoded_content;
$content
=
''
unless
defined
(
$content
);
if
(
$response
->code >
$self
->code_parse_start &&
$response
->code <
$self
->code_parse_end) {
if
(
length
(
$content
)!=0 and
$content
=~ /^\s*[\[\{\"]/s) {
my
$data
=
eval
{
$self
->json->decode(
$content
)};
if
($@) {
return
$self
->new_false(
"Code: ["
.
$response
->code.
"] JSON Decode error [$@] Content: $content"
);
}
else
{
return
$self
->new_true(
$data
);
}
}
else
{
return
$self
->new_true(
$content
,
$response
);
}
}
else
{
return
$self
->new_false(
"Code: ["
.
$response
->code.
"] http error ["
.
$response
->status_line.
"] Content: $content"
);
}
}
=item * my $id=$self->queue_request($request,$cb|undef);
Returns an Id for the qued request. If $cb is undef then the default internal blocking callback is used.
=cut
sub
queue_request {
my
(
$self
,
$request
,
$cb
)=
@_
;
$cb
=
$self
->get_block_cb
unless
defined
(
$cb
);
my
$id
=
$self
->agent->add_cb(
$request
,
$self
->cb);
my
$req
=is_plain_arrayref(
$request
) ?
$request
->[0] :
$request
;
$self
->pending->{
$req
}=[
$id
,
$cb
];
return
$id
;
}
=item * my $id=$self->queue_result($cb,$result);
Alows for result objects to look like they were placed in the the job que but wern't.
Call back example
sub {
my ($self,$id,$result,undef,undef)=@_;
# 0 Current object class
# 1 fake_id
# 2 Data::Result Object ( passed into $self->queue_result )
# 3 undef
# 4 undef
};
=cut
sub
queue_result {
my
(
$self
,
$cb
,
$result
)=
@_
;
$cb
=\
&block_cb
unless
$cb
;
$result
=
$self
->new_false(
"unknown error"
)
unless
defined
(
$result
);
my
$id
;
$id
=
$self
->agent->add_result(
sub
{
$cb
->(
$self
,
$id
,
$result
,
undef
,
undef
);
});
}
sub
has_fake_jobs {
return
$_
[0]->agent->has_fake_jobs;
}
=item * my $results=$self->block_on_ids(@ids);
Scalar context returns an array ref.
=item * my @results=$self->block_on_ids(@ids);
Returns a list of array refrences.
Each List refrence contains the follwing
0: Data::Result
1: HTTP::Request
2: HTTP::Result
Example
my @results=$self->block_on_ids(@ids);
foreach my $set (@results) {
my ($result,$request,$response)=@{$set};
if($result)
...
} else {
...
}
}
=cut
sub
block_on_ids {
my
(
$self
,
@ids
)=
@_
;
my
@init
=
@ids
;
$self
->agent->block_for_results_by_id(
@ids
);
my
$ref
={};
while
($
#{$self->block_for_more}!=-1) {
@ids
=@{
$self
->block_for_more};
@{
$self
->block_for_more}=();
$self
->agent->run_next;
$self
->agent->block_for_results_by_id(
@ids
);
}
my
$results
=[
delete
@{
$self
->result_map}{
@init
}];
return
wantarray
? @{
$results
} :
$results
;
}
=item * $self->add_ids_for_blocking(@ids);
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.
The example here is a litteral copy paste from L<Net::AppDynamics::REST>
sub que_walk_all {
my ($self,$cb)=@_;
my $state=1;
my $data={};
my $total=0;
my @ids;
my $app_cb=sub {
my ($self,$id,$result,$request,$response)=@_;
if($result) {
foreach my $obj (@{$result->get_data}) {
$data->{ids}->{$obj->{id}}=$obj;
$obj->{our_type}='applications';
$data->{applications}->{$obj->{name}}=[] unless exists $data->{applications}->{$obj->{name}};
push @{$data->{applications}->{$obj->{name}}},$obj->{id};
foreach my $method (qw(que_list_nodes que_list_tiers que_list_business_transactions)) {
++$total;
my $code=sub {
my ($self,undef,$result,$request,$response)=@_;
return unless $state;
return ($cb->($self,$id,$result,$request,$response,$method,$obj),$state=0) unless $result;
--$total;
foreach my $sub_obj (@{$result->get_data}) {
my $target=$method;
$target=~ s/^que_list_//;
foreach my $field (qw(name machineName)) {
next unless exists $sub_obj->{$field};
my $name=uc($sub_obj->{$field});
$data->{$target}->{$name}=[] unless exists $data->{$target}->{$name};
push @{$data->{$target}->{$name}},$sub_obj->{id};
}
$sub_obj->{ApplicationId}=$obj->{id};
$sub_obj->{ApplicationName}=$obj->{name};
$sub_obj->{our_type}=$target;
$data->{ids}->{$sub_obj->{id}}=$sub_obj;
}
if($total==0) {
return ($cb->($self,$id,$self->new_true($data),$request,$response,'que_walk_all',$obj),$state=0)
}
};
push @ids,$self->$method($code,$obj->{id});
}
}
} else {
return $cb->($self,$id,$result,$request,$response,'que_list_applications',undef);
}
$self->add_ids_for_blocking(@ids);
};
return $self->que_list_applications($app_cb);
}
=cut
sub
add_ids_for_blocking {
my
(
$self
,
@ids
)=
@_
;
return
unless
$self
->is_blocking;
push
@{
$self
->block_for_more},
@ids
;
}
=item * my $code=$self->block_cb($id,$result,$request,$response);
For internal use Default callback method used for all que_ methods.
=cut
sub
block_cb {
my
(
$self
,
$id
,
$result
,
$request
,
$response
)=
@_
;
$self
->result_map->{
$id
}=[
$result
,
$request
,
$response
];
}
=item * my $cb=$self->get_block_cb
For Internal use, Returns the default blocking callback: \&block_cbblock_cb
=cut
sub
get_block_cb {
return
\
&block_cb
;
}
=back
=head1 Non-Blocking Interfaces
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.
All Non Blocking methods provide the following arguments to the callback.
my $code=sub {
my ($self,$id,$result,$request,$response)=@_;
if($result) {
print Dumper($result->get_data);
} else {
warn $result;
}
}
$self->que_xxx($code,$sql);
The code refrence $code will be calld when the HTTP::Response has been recived.
Callback variables
$self
This Net::AppDynamics::REST Object
$id
The Job ID ( used internally )
$result
A Data::Result Object, when true it contains the results, when false it contains why things failed
$request
HTTP::Requst Object that was sent to SolarWinds to make this request
$response
HTTP::Result Object that represents the response from SolarWinds
=head1 Blocking Interfaces
All Blocking interfaces are generated with the AUTOLOAD method. Each method that begins with que_xxx can be calld in a blocking method.
Example:
# my $id=$self->que_list_applications(sub {});
# can called as a blocking method will simply return the Data::Result object
my $result=$self->list_applications;
=cut
sub
AUTOLOAD {
my
(
$self
,
@args
)=
@_
;
AnyEvent->now_update;
my
$method
=
$AUTOLOAD
;
$method
=~ s/^.*:://s;
return
if
$method
eq
'DESTROY'
;
$self
->is_blocking(1);
my
$que_method
=
"que_$method"
;
unless
(
$self
->can(
$que_method
)) {
croak
"Undefined subroutine $method"
;
}
my
@ids
=
$self
->
$que_method
(
$self
->get_block_cb,
@args
);
$self
->agent->run_next;
my
$result
=
$self
->block_on_ids(
@ids
)->[0]->[0];
$self
->is_blocking(0);
return
$result
;
}
sub
can {
my
(
$self
,
$method
)=
@_
;
my
$sub
=
$self
->SUPER::can(
$method
);
return
$sub
if
$sub
;
my
$que_method
=
"que_$method"
;
return
undef
unless
$self
->SUPER::can(
$que_method
);
$sub
=
sub
{
$AUTOLOAD
=
$method
;
$self
->AUTOLOAD(
@_
);
};
return
$sub
;
}
sub
DEMOLISH { }
=head1 See Also
L<AnyEvent::HTTP::MultiGet>
=head1 AUTHOR
Michael Shipper L<mailto:AKALINUX@CPAN.ORG>
=cut
1;