File Coverage

blib/lib/WWW/Giraffi/API/Request.pm

Criterion	Covered	Total	%
statement	27	101	26.7
branch	0	20	0.0
condition	0	16	0.0
subroutine	9	24	37.5
pod	7	7	100.0
total	43	168	25.6

package WWW::Giraffi::API::Request;

use strict;
use warnings;
use 5.10.0;
use Class::XSAccessor
  constructor => "new",
  accessors   => {
    apikey                  => "apikey",
    agent                   => "agent",
    ssl_verify_hostname     => "ssl_verify_hostname",
    use_time_piece          => "use_time_piece",
    timeout                 => "timeout",
    default_endpoint        => "default_endpoint",
    applogs_endpoint        => "applogs_endpoint",
    monitoringdata_endpoint => "monitoringdata_endpoint",
    verbose                 => "verbose",
	last_request            => "last_request",
	last_response           => "last_response",
  },
  #true    => [qw(verbose)],
  replace => 1;
use JSON::Any;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use URI;

our $VERSION         = '0.2_04';
our %REQUEST_HEADERS = (
    "Accept"       => "application/json",
    "Content-Type" => "application/json"
);
our $CLIENT_TIMEOUT_DELAY = 2;
our $CLIENT_TIMEOUT_CODE  = 408;

#has apikey               => ( is => "rw", isa => "Str" );
#has agent                => ( is => "rw", isa => "Str" );
#has ssl_verify_hostname  => ( is => "rw", isa => "Num");
#has timeout              => ( is => "rw", isa => "Num" );
#has default_endpoint     => ( is => "rw", isa => "Str" );
#has applogs_endpoint     => ( is => "rw", isa => "Str" );
#has monitoringdata_endpoint  => ( is => "rw", isa => "Str" );
#has verbose              => ( is => "rw", isa => "Num" );

sub get {

	my ( $self, $path_or_uri, $queryref, $other_options ) = @_;
	my $res = $self->request( "GET", $path_or_uri, $queryref, undef, $other_options );
	#return $self->_json2ref( $res->content );
	return $self->_response2ref( $res );
}

sub post {

	my ( $self, $path_or_uri, $queryref, $contentref, $other_options ) = @_;
	my $res = $self->request( "POST", $path_or_uri, $queryref, $contentref, $other_options );
	#return $self->_json2ref( $res->content );
	return $self->_response2ref( $res );
}

sub put {

	my ( $self, $path_or_uri, $queryref, $contentref, $other_options ) = @_;
	my $res = $self->request( "PUT", $path_or_uri, $queryref, $contentref, $other_options );
	#return $self->_json2ref( $res->content );
	return $self->_response2ref( $res );
}

sub delete {

    my ( $self, $path_or_uri, $queryref, $contentref, $other_options ) = @_;
    my $res = $self->request( "DELETE", $path_or_uri, $queryref, $contentref, $other_options );
	#return $self->_json2ref( $res->content );
    return $self->_response2ref( $res );
}

sub request {

	my ( $self, $method, $path_or_uri, $queryref, $contentref, $other_options ) = @_;
	my $req = $self->make_request( $method, $path_or_uri, $queryref, $contentref, $other_options );
	return $self->_request($req);
}

sub _request {

	my($self, $req) = @_;

	my $ua = LWP::UserAgent->new( agent => $self->agent, timeout => $self->timeout );
	if ( !$self->ssl_verify_hostname ) {
		$ua->ssl_opts( verify_hostname => 0 );
	}
	$self->_verbose( sprintf "request request_line %s => %s", $req->method, $req->uri );
	if ($req->content) {
	   $self->_verbose( sprintf "request content => %s", $req->content );
	}

	my $res;
	my $is_client_timeout;
	eval {
		local $SIG{ALRM} = sub { $is_client_timeout = 1 };
		alarm $self->timeout + $CLIENT_TIMEOUT_DELAY;
		$self->last_request($req);
		$res = $ua->request($req);
		alarm 0;
	};
	if ($is_client_timeout) {
		$res = $self->make_response( $CLIENT_TIMEOUT_CODE, { error => "alarm timeout" } );
	}
	$self->last_response($res);

	$self->_verbose( sprintf "response status_line => %s", $res->status_line );

	return $res;
}

sub make_request {

    my($self, $method, $path_or_uri, $queryref, $contentref, $other_options) = @_;
    my $req = HTTP::Request->new( $method => $self->_make_uri( $path_or_uri, $queryref, $other_options ) );
    if ( $req->method =~ /^(POST|PUT|DELETE)$/ && ref($contentref) =~ /^(ARRAY|HASH)$/ ) {
        $req->header(%REQUEST_HEADERS);
        $req->content( $self->_ref2json($contentref) );
    }
    return $req;
}

sub make_response {

	my ( $self, $code, $message, $json ) = @_;
	$json //= $self->_ref2json($message);
	return HTTP::Response->new( $code, $message, [ "Content-Type" => "application/json" ], $json );
}

sub _json2ref {

    my ( $self, $json ) = @_;
	#my $ref;
	#eval {
	#	$ref = JSON::Any->new->decode($json);
	#};
	#if ($@) {
	#	$ref = JSON::Any->new->decode("{'error':'$json'}");
	#}
	#return $ref;
	return JSON::Any->new->decode($json);
}

sub _ref2json {

    my ( $self, $ref ) = @_;
	#my $json;
	#eval {
	#	$json = JSON::Any->new->encode($ref);
	#};
	#if ($@) {
	#	$json = JSON::Any->new->encode({ error => $ref });
	#}
	#return $json;
	return JSON::Any->new->encode($ref);
}

sub _response2ref {

	my( $self, $res ) = @_;
	my $ref;
	if ($self->_is_json($res->content)) {
		$ref = $self->_json2ref($res->content);
	} else {
		if ($res->code =~ /^2\d{2}$/) { # if  normal http success code
			$ref = { content => $res->content };
		} else {
			$ref = { error => $res->status_line };
		}
	}

	return $ref;
}

sub _is_json {

	my($self, $json) = @_;
	return ($json =~ /^\{.*\}$/ or $json =~ /^\[.*\]$/) ? 1 : 0;
}

sub _verbose {

    my ( $self, $message ) = @_;
    return if !$self->verbose;
    warn "VERBOSE: $message\n";
}

sub _make_uri {

	my ( $self, $path_or_uri, $queryref, $other_options ) = @_;

	$path_or_uri //= "";
	$queryref //= {};
	if ($path_or_uri !~ /^https?:\/\//) {
		$path_or_uri = sprintf "%s/%s", $self->default_endpoint, $path_or_uri;
	}

	my $apikey;
	if (ref($other_options) eq "HASH" && exists $other_options->{apikey}) {
		$apikey = $other_options->{apikey};
	} else {
		$apikey = $self->apikey;
	}

	my $uri = URI->new($path_or_uri);
	$uri->query_form( [ apikey => $apikey, %{$queryref} ] );
	return $uri;
}

1;
__END__