=head1 NAME
Business::Shipping::RateRequest::Online - Abstract rates class
=head1 VERSION
$Rev: 280 $
=head1 METHODS
=cut
$VERSION = do { my $r = q$Rev: 280 $; $r =~ /\d+/; $&; };
use strict;
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 Unique { return ( $_[ 0 ]->SUPER::Unique, qw/ / ); }
=head2 perform_action()
Sends request to server.
=cut
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 ) );
#debug3( "response content = " . $self->response()->content() );
if ( ! $self->response()->is_success() ) {
$self->user_error(
"HTTP Error. Status line: " . $self->response->status_line .
"Content: " . $self->response->content()
);
}
#debug3 "self->response = " . Dumper( $self->response() );
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();
#debug3( $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 ); # TODO: Make configurable
$ua->env_proxy(); # Read proxy settings from environment variables.
my $try_limit = $Business::Shipping::Config::Try_Limit; # TODO: Make config
my $tries;
my $success;
# The following are known, common errors.
# 'HTTP Error. Status line: 500',
# 'HTTP Error. Status line: 500 Server Error',
# 'HTTP Error. Status line: 500 read timeout',
# 'HTTP Error. Status line: 500 Bizarre copy of ARRAY',
# 'HTTP Error. Status line: 500 Connect failed:',
# 'HTTP Error. Status line: 500 Can\'t connect to ',
for ( $tries = 1; $tries <= $try_limit; $tries++ ) {
$response = $ua->request( $request_param );
if ( ! $response->is_success() ) {
sleep 2; # Default recommended wait time. # TODO: Make configurable
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;
__END__
=head1 AUTHOR
Dan Browning E<lt>F<db@kavod.com>E<gt>, Kavod Technologies, L<http://www.kavod.com>.
=head1 COPYRIGHT AND LICENCE
Copyright (c) 2003-2004 Kavod Technologies, Dan Browning. All rights reserved.
This program is free software; you may redistribute it and/or modify it under
the same terms as Perl itself. See LICENSE for more info.
=cut