The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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__

=head1 NAME

WWW::Giraffi::API::Request - Giraffi API Access Request Base Module

=head1 VERSION

0.2_04

=head1 SYNOPSIS

  use strict;
  use warnings;
  use WWW::Giraffi::API::Request;
  
  my $apikey = "ilovenirvana_ilovekurtcobain";
  my $g = WWW::Giraffi::API->new(apikey => $apikey);
  # get all media data
  my $arrayref = $g->media->all;
  foreach $ref(@{$arrayref}) {
      ## anything to do...
  }

=head1 DESCRIPTION

WWW::Giraffi::API::Request is Giraffi API Access Request Base Module

Axion/Item/Media/Service/Trigger Base Module

=head1 GLOBAL VARIABLE

=head2 %REQUEST_HEADERS 

request headers hash

  (
    "Accept"       => "application/json",
    "Content-Type" => "application/json"
  )

=head2 $CLIENT_TIMEOUT_DELAY

2;

=head2 $CLIENT_TIMEOUT_CODE

408;

=head1 ACCESSOR METHOD

=head2 apikey

=head2 agent

=head2 ssl_verify_hostname

=head2 use_time_piece

=head2 timeout

=head2 default_endpoint

=head2 applogs_endpoint

=head2 monitoringdata_endpoint

=head2 last_request

=head2 last_response

=head2 verbose

=head1 METHOD

=head2 get

Request GET method. request method wrapper

Example:

  # $ref is hash or array reference
  my $path_or_uri = "media.json";
  my $queryref = { name => "Alert Email" };
  my $ref = $req->get($path_or_uri, $queryref);

=head2 post

Request POST method. request method wrapper

Example:

  # $ref is hash or array reference
  my $path_or_uri = "media.json";
  my $queryref = {};
  my $contentref = { 
              options' => { address => "me@domain" },
              mediumtype => 'email',
              name => 'Alert Email',
           };
  my $ref = $req->post($path_or_uri, $queryref, $contentref);

=head2 put

Request PUT method. request method wrapper

Example:

  # $ref is hash or array reference
  my $path_or_uri = "media/1.json";
  my $queryref = {};
  my $contentref = { 
              mediumtype => 'twitter',
              name => 'Emergency Email',
           };
  my $ref = $req->put($path_or_uri, $queryref, $contentref);

=head2 delete

Request DELETE method. request method wrapper

Example:

  # $ref is hash or array reference
  my $path_or_uri = "media/1.json";
  my $queryref = {};
  my $contentref = {};
  my $ref = $req->delete($path_or_uri, $queryref, $contentref);

=head2 request

GET/POST/PUT/DELETE low layer request method

Example:

  my $path_or_uri = "media/1.json";
  my $queryref = {};
  my $contentref = { 
              mediumtype => 'twitter',
              name => 'Emergency Email',
           };
  # $res is HTTP::Response Object
  my $res = $req->request("PUT", $path_or_uri, $queryref, $contentref);


=head2 make_request

Create HTTP::Request Object. using internal request method

Example:

  my $path_or_uri = "media.json";
  my $queryref = { name => "Alert Email" };
  my $contentref = {};
  # $req is HTTP::Request Object
  my $res = $req->make_request("GET", $path_or_uri, $queryref, $contentref);

=head2 make_response

Create HTTP::Response Object. using internal request method

Example:

  # $res is HTTP::Response Object
  my $code = 500;
  my $message = "internal server error";
  my $json = JSON::Any->new->encode({ error => $message });
  my $res = $req->make_response($code, $message, $json);

=head1 AUTHOR

Akira Horimoto E<lt>emperor@gmail.comE<gt>

=head1 SEE ALSO

L<Class::XSAccessor> L<Crypt::SSLeay> L<JSON::Any> L<LWP::Protocol::https>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut