package Business::Shipping::RateRequest::Online;

=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 warnings;
use base ( 'Business::Shipping::RateRequest' );
use Business::Shipping::Logging;
use XML::Simple;
use LWP::UserAgent;
use Cache::FileCache;
use Class::MethodMaker 2.0
    [
      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() 
                    ); 
    }
    use Data::Dumper;
    #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