File Coverage

blib/lib/HTTP/MultiGet/Role.pm

Criterion	Covered	Total	%
statement	98	115	85.2
branch	21	34	61.7
condition	4	6	66.6
subroutine	24	26	92.3
pod	8	11	72.7
total	155	192	80.7

package HTTP::MultiGet::Role;

use Modern::Perl;
use Moo::Role;
use MooX::Types::MooseLike::Base qw(:all);
use AnyEvent::HTTP::MultiGet;
use AnyEvent;
use JSON qw();
use Data::Dumper;
use Carp qw(croak);
use namespace::clean;
use Ref::Util qw(is_plain_arrayref);

BEGIN {
  with 'Log::LogMethods','Data::Result::Moo';
}

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)=@_;

  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<https://docs.appdynamics.com/display/PRO43/AppDynamics+APIs>

L<AnyEvent::HTTP::MultiGet>

=head1 AUTHOR

Michael Shipper L<mailto:[e-mail]>

=cut

1;