CPAN::Groonga

package Amazon::API::Error;

use strict;
use warnings;

use Data::Dumper;
use English qw( -no_match_vars );
use JSON qw( decode_json );
use Scalar::Util qw( reftype );
use XML::Simple qw( XMLin );

__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors(
  qw(
    action
    api
    content_type
    error
    message_raw
    response
  )
);

use parent qw( Class::Accessor::Fast );

our $VERSION = '2.1.4';

use overload q("") => sub {
  my ($self) = shift;

  my $err_prefix = sprintf 'API ERROR(%s): %s->%s', $self->get_error, $self->get_api, $self->get_action;

  my $response = $self->get_response;

  local $Data::Dumper::Terse = 1;
  local $Data::Dumper::Pair  = q{:};
  local $Data::Dumper::Useqq = 1;

  my $response_str = Dumper( ref $response ? $response : [$response] );

  return sprintf "%s\n%s", $err_prefix, $response_str;
};

########################################################################
sub new {
########################################################################
  my ( $class, @options ) = @_;

  my $self = $class->SUPER::new(@options);

  $self->_set_message;

  return $self;
}

###############################################################
sub _set_message {
###############################################################
  my ($self) = @_;

  my $raw_message = $self->get_message_raw;
  my $message;

  if ($raw_message) {

    if ( $self->get_content_type =~ /xml/xmsi ) {
      $message = eval { return XMLin($raw_message); };
    }
    elsif ( $self->get_content_type =~ /json/xmsi ) {
      $message = eval { return decode_json($raw_message); };
    }

    # try a little harder...
    if ( !$message || $EVAL_ERROR ) {
      $message = eval { return decode_json($raw_message); };

      if ( !$message || $EVAL_ERROR ) {
        if ( $raw_message =~ /^\s*\</xsm ) {
          $message = eval { return XMLin($raw_message); };
        }
      }
    } ## end if ( !$message || $EVAL_ERROR)

  } ## end if ($raw_message)

  $message = $message || $raw_message;

  $self->set_response($message);

  return $message;
} ## end sub _set_message

###############################################################
sub get_aws_api {
###############################################################
  my ($self) = @_;

  my $api = eval { return $self->get_api->get_api || ref( $self->get_api ); };

  return $api;
} ## end sub get_aws_api

1;

__END__

=pod

=head1 NAME

C<Amazon::API::Error>

=head1 SYNOPSIS

 my $result = eval {
   decode_json(
     $cwe->PutPermission(
       { Action      => "PutEvents",
         Principal   => "123454657889012",
         StatementId => "12345"
       }
     );
   };
  
 print Dumper( [ $@->get_response, $@->get_error ] )
   if $@ && ref($@) =~ /API::Error/;

=head1 DESCRIPTION

Error object that contains that status code and the error message
contained in the body of the response to the API call.

=head1 METHODS AND SUBROUTINEs

=head2 get_error

Returns the HTTP status code returned by the API call.

=head2 get_response

Returns a decoded response. Usually a hash.

=head2 get_message_raw

Returns the content of the body of the error response.

=head2 get_content_type

Returns the Content-Type of the response.

=head2 get_aws_api

Returns the API that was called that generated the error.

=head1 NOTES

An example response:

<?xml version="1.0" encoding="UTF-8"?>
  <Response><Errors><Error><Code>UnauthorizedOperation</Code><Message>You are not authorized to perform this operation.</Message></Error></Errors><RequestID>599b0f86-4668-4adb-b493-552d6039fcd1</RequestID></Response>

=head1 LICENSE AND COPYRIGHT

This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.

=head1 AUTHOR

Rob Lauer - <rlauer6@comcast.net>

=head1 SEE OTHER

C<Amazon::API>

=cut