$VERSION
=
do
{
my
$r
=
q$Rev: 280 $
;
$r
=~ /\d+/; $&; };
use
base (
'Business::Shipping::RateRequest'
);
[
new
=> [ {
-hash
=> 1 },
'new'
],
scalar
=> [
'test_mode'
,
'user_id'
,
'password'
,
'response'
],
];
sub
Required {
return
(
$_
[ 0 ]->SUPER::Required,
qw/ user_id password /
); }
sub
Optional {
return
(
$_
[ 0 ]->SUPER::Optional,
qw/ prod_url test_url /
); }
sub
perform_action
{
my
$self
=
shift
;
my
$request
=
$self
->_gen_request();
trace(
'Please wait while we get a response from the server...'
);
$self
->response(
$self
->_get_response(
$request
) );
if
( !
$self
->response()->is_success() ) {
$self
->user_error(
"HTTP Error. Status line: "
.
$self
->response->status_line .
"Content: "
.
$self
->response->content()
);
}
return
(
undef
);
}
sub
_gen_url
{
trace
'()'
;
my
(
$self
) =
shift
;
return
(
$self
->test_mode() ?
$self
->test_url() :
$self
->prod_url() );
}
sub
_gen_request
{
trace
'()'
;
my
(
$self
) =
shift
;
my
$request_xml
=
$self
->_gen_request_xml();
my
$request
= HTTP::Request->new(
'POST'
,
$self
->_gen_url() );
$request
->header(
'content-type'
=>
'application/x-www-form-urlencoded'
);
$request
->header(
'content-length'
=>
length
(
$request_xml
) );
$request
->content(
$request_xml
);
return
(
$request
);
}
sub
_get_response
{
my
(
$self
,
$request_param
) =
@_
;
trace
'called'
;
my
$ua
= LWP::UserAgent->new;
my
$response
;
$ua
->timeout( 15 );
$ua
->env_proxy();
my
$try_limit
=
$Business::Shipping::Config::Try_Limit
;
my
$tries
;
my
$success
;
for
(
$tries
= 1;
$tries
<=
$try_limit
;
$tries
++ ) {
$response
=
$ua
->request(
$request_param
);
if
( !
$response
->is_success() ) {
sleep
2;
next
;
}
else
{
last
;
}
}
if
( !
$response
->is_success() ) {
$self
->user_error(
"There was an error on the rate server: \""
.
$self
->response->status_line
.
"\". Please try again later"
);
$self
->is_success( 0 );
return
;
}
return
$response
;
}
1;