Amazon-MWS
view release on metacpan or search on metacpan
lib/Amazon/MWS/Routines.pm view on Meta::CPAN
package Amazon::MWS::Routines;
use URI;
use DateTime;
use XML::Simple;
use URI::Escape;
use MIME::Base64;
use Digest::SHA;
use HTTP::Request;
use LWP::UserAgent;
use Digest::MD5 qw(md5_base64);
use Amazon::MWS::TypeMap qw(:all);
use Amazon::MWS::Exception;
use Data::Dumper;
use Exporter qw(import);
our @EXPORT_OK = qw(define_api_method new sign_request convert force_array);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
sub slurp_kwargs { ref $_[0] eq 'HASH' ? shift : { @_ } }
sub define_api_method {
my $method_name = shift;
my $spec = slurp_kwargs(@_);
my $params = $spec->{parameters};
my $method = sub {
my $self = shift;
my $args = slurp_kwargs(@_);
my $body = '';
my %form = (
Action => $method_name,
AWSAccessKeyId => $self->{access_key_id},
Merchant => $self->{merchant_id},
SellerId => $self->{merchant_id},
SignatureVersion => 2,
SignatureMethod => 'HmacSHA256',
Timestamp => to_amazon('datetime', DateTime->now),
);
foreach my $name (keys %$params) {
my $param = $params->{$name};
unless (exists $args->{$name}) {
Amazon::MWS::Exception::MissingArgument->throw(name => $name) if $param->{required};
next;
}
my $type = $param->{type};
my $array_names = $param->{array_names};
my $value = $args->{$name};
if ($type =~ /^List$/) {
my %valuehash;
@valuehash{@{$param->{values}}}=();
Amazon::MWS::Exception::Invalid->throw(field => $name, value=>$value) unless (exists ($valuehash{$value}));
$form{$name} = $value;
next;
}
# Odd 'structured list' notation handled here
if ($type =~ /(\w+)List/) {
my $list_type = $1;
Amazon::MWS::Exception::Invalid->throw(field => $name, value=>$value, message=>"$name should be of type ARRAY") unless (ref $value eq 'ARRAY');
my $counter = 1;
foreach my $sub_value (@$value) {
my $listKey = "$name.$list_type." . $counter++;
$form{$listKey} = $sub_value;
}
next;
}
if ($type =~ /(\w+)Array/) {
Amazon::MWS::Exception::Invalid->throw(field => $name, value=>$value, message=>"$name should be of type ARRAY") unless (ref $value eq 'ARRAY');
my $list_type = $1;
my $counter = 0;
foreach my $sub_value (@$value) {
$counter++;
my $arr_col=0;
foreach my $array_name (@{$array_names}) {
if ( ! defined $sub_value->[$arr_col] ) { next; }
my $listKey = "$name.$list_type." . $counter;
$listKey .= ".$array_name";
$form{$listKey} = $sub_value->[$arr_col++];
}
}
next;
}
if ($type eq 'HTTP-BODY') {
$body = $value;
}
else {
$form{$name} = to_amazon($type, $value);
}
}
$form{Version} = $spec->{version} || '2010-01-01';
my $endpoint = ( $spec->{service} ) ? "$self->{endpoint}$spec->{service}" : $self->{endpoint};
my $uri = URI->new($endpoint);
my $request = HTTP::Request->new;
$request->protocol('HTTP/1.0');
my ($response, $content);
$spec->{method} = 'GET' unless $spec->{method};
if ($spec->{method} eq 'POST') {
$request->uri($uri);
$request->method('POST');
$request->content($body);
$request->content_type($args->{content_type}||'application/x-www-form-urlencoded');
my $signature = $self->sign_request($request, %form);
$response = $self->agent->request($request);
$content = $response->content;
} elsif ($body) {
$request->uri($uri);
$request->method('POST');
$request->content($body);
$request->header('Content-MD5' => md5_base64($body) . '==');
$request->content_type($args->{content_type}||'text/plain');
$self->sign_request($request, %form);
$request->content($body);
$response = $self->agent->request($request);
$content = $response->content;
} else {
$uri->query_form(\%form);
$request->uri($uri);
$request->method('GET');
$self->sign_request($request);
$response = $self->agent->request($request);
$content = $response->content;
}
if ($self->{debug}) {
open LOG, ">>$self->{logfile}";
print LOG Dumper($response);
}
my $xs = XML::Simple->new( KeepRoot => 1 );
if ($response->code == 400 || $response->code == 403) {
my $hash = $xs->xml_in($content);
my $root = $hash->{ErrorResponse};
force_array($root, 'Error');
Amazon::MWS::Exception::Response->throw(errors => $root->{Error}, xml => $content);
}
if ($response->code == 503) {
my $hash = $xs->xml_in($content);
my $root = $hash->{ErrorResponse};
force_array($root, 'Error');
Amazon::MWS::Exception::Throttled->throw(errors => $root->{Error}, xml => $content);
}
( run in 1.320 second using v1.01-cache-2.11-cpan-d8267643d1d )