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
;
}
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
);
}
unless
(
$response
->is_success) {
Amazon::MWS::Exception::Transport->throw(
request
=>
$request
,
response
=>
$response
);
}
if
(
my
$md5
=
$response
->header(
'Content-MD5'
)) {
Amazon::MWS::Exception::BedChecksum->throw(
response
=>
$response
)
unless
(
$md5
eq md5_base64(
$content
) .
'=='
);
}
return
$content
if
(
$spec
->{raw_body} ||
$args
->{raw_body});
my
$hash
=
$xs
->xml_in(
$content
);
my
$root
=
$hash
->{
$method_name
.
'Response'
}
->{
$method_name
.
'Result'
};
return
$spec
->{respond}->(
$root
);
};
my
$module_name
=
$spec
->{module_name} ||
'Amazon::MWS::Client'
;
my
$fqn
=
join
'::'
,
"$module_name"
,
$method_name
;
no
strict
'refs'
;
*$fqn
=
$method
;
}
sub
force_array {
my
(
$hash
,
$key
) =
@_
;
my
$val
=
$hash
->{
$key
};
if
(!
defined
$val
) {
$val
= [];
}
elsif
(
ref
$val
ne
'ARRAY'
) {
$val
= [
$val
];
}
$hash
->{
$key
} =
$val
;
}
sub
sign_request {
my
(
$self
,
$request
,
%form
) =
@_
;
my
$uri
=
$request
->uri;
my
%params
= (
$request
->method eq
'GET'
) ?
$uri
->query_form :
%form
;
my
$canonical
=
join
'&'
,
map
{
my
$param
= uri_escape(
$_
);
my
$value
= uri_escape(
$params
{
$_
});
"$param=$value"
;
}
sort
keys
%params
;
my
$path
=
$uri
->path ||
'/'
;
my
$string
=
$request
->method .
"\n"
.
$uri
->authority .
"\n"
.
$path
.
"\n"
.
$canonical
;
$params
{Signature} = Digest::SHA::hmac_sha256_base64(
$string
,
$self
->{secret_key});
while
(
length
(
$params
{Signature}) % 4) {
$params
{Signature} .=
'='
;
}
if
(
$request
->{_method} eq
'GET'
||
$request
->{_content} ) {
$uri
->query_form(\
%params
);
}
else
{
$request
->{_content} =
"$canonical&Signature=$params{Signature}"
;
}
$request
->uri(
$uri
);
return
$request
;
}
sub
convert {
my
(
$hash
,
$key
,
$type
) =
@_
;
$hash
->{
$key
} = from_amazon(
$type
,
$hash
->{
$key
});
}
sub
new {
my
(
$pkg
,
%opts
) =
@_
;
$opts
{configfile} ||=
'amazon.xml'
;
if
(-r
$opts
{configfile} ) {
my
$xmlconfig
= XML::Simple::XMLin(
"$opts{configfile}"
);
$opts
{access_key_id} ||=
$xmlconfig
->{access_key_id};
$opts
{secret_key} ||=
$xmlconfig
->{secret_key};
$opts
{merchant_id} ||=
$xmlconfig
->{merchant_id};
$opts
{marketplace_id} ||=
$xmlconfig
->{marketplace_id};
$opts
{endpoint} ||=
$xmlconfig
->{endpoint};
$opts
{debug} ||=
$xmlconfig
->{debug};
$opts
{logfile} ||=
$xmlconfig
->{logfile};
}
my
$attr
=
$opts
->{agent_attributes};
$attr
->{Language} =
'Perl'
;
my
$attr_str
=
join
';'
,
map
{
"$_=$attr->{$_}"
}
keys
%$attr
;
my
$appname
=
$opts
{Application} ||
'Amazon::MWS::Client'
;
my
$version
=
$opts
{Version} || 0.5;
my
$agent_string
=
"$appname/$version ($attr_str)"
;
die
'No access key id'
unless
$opts
{access_key_id};
die
'No secret key'
unless
$opts
{secret_key};
die
'No merchant id'
unless
$opts
{merchant_id};
die
'No marketplace id'
unless
$opts
{marketplace_id};
if
(
$opts
{debug}) {
open
LOG,
">$opts{logfile}"
or
die
"Cannot open logfile."
;
print
LOG DateTime->now();
print
LOG
"\nNew instance created. \n"
;
print
LOG Dumper(\
%opts
);
close
LOG;
}
bless
{
package
=>
"$pkg"
,
agent
=> LWP::UserAgent->new(
agent
=>
$agent_string
),
access_key_id
=>
$opts
{access_key_id},
secret_key
=>
$opts
{secret_key},
merchant_id
=>
$opts
{merchant_id},
marketplace_id
=>
$opts
{marketplace_id},
debug
=>
$opts
{debug},
logfile
=>
$opts
{logfile},
},
$pkg
;
}
1;