# 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.

package Business::Shipping::RateRequest;

=head1 NAME

Business::Shipping::RateRequest - Abstract class

=head1 VERSION

$Rev: 306 $

=head1 DESCRIPTION

Abstract Class: real implementations are done in subclasses.

Represents a request for shipping cost estimation.

=head1 METHODS

=cut

$VERSION = do { my $r = q$Rev: 306 $; $r =~ /\d+/; $&; };

use strict;
use warnings;
use base ( 'Business::Shipping' );
use Data::Dumper;
use Business::Shipping::Util;
use Business::Shipping::Logging;
use Business::Shipping::Config;

=head2 $rate_request->is_success()

Boolean.  1 = Rate Request was successful.

=head2 $rate_request->cache()

Boolean.  1 = Save results using Cache::FileCache, and reload them if an 
identical request is made later.  See submit() for implementation details.

=head2 $rate_request->invalid()

Boolean.  1 = Rate request was invalid, because user supplied invalid data. This
can be useful in determining whether or not to log incident reports (see 
UserTag/business-shipping.tag for an example implementation).

=head2 $rate_request->results()

Hashref.  Stores the results of a rate request, for example:

 {
   'UPS' => [ 
              { 
                id      => 1,
                charges => 10.50
              },
              { 
                id      => 2,
                charges => 23.00
              }
            ]
 }
                
See _handle_response() for implementation details. 

=head2 $rate_request->shipment()

Stores a Business::Shipping::Shipment object.  Many methods are forwarded to it.
At this time, each RateRequest only has one Shipment.

=head2 $rate_request->error_details()

Arrayref.  Stores the error results of a rate request. There can be multiple
errors for one request.  Each entry in the array represents an error.  Each
error is a hashref with the following keys:

 error_code	: The error code
 error_msg	: A description error message

Additional keys may be added by the shipper class.

=cut

use Class::MethodMaker 2.0
    [ new => [ qw/ -hash new / ],
      scalar        => [ 'is_success', 'cache', 'invalid' ],
      scalar        => [ 'shipper' ],
      scalar        => [ 'results' ],
      scalar        => [ '_total_charges' ],
      scalar        => [ 'price_components' ],
      scalar => [ { -type    => 'Business::Shipping::Shipment',
                    -forward => [ 
                                    'service', 
                                    'service_code', 'service_nick', 'service_name', 'service_nick2',
                                    'from_country',
                                    'from_country_abbrev',
                                    'to_country',
                                    'to_country_abbrev',
                                    'to_ak_or_hi',
                                    'from_zip',
                                    'to_zip',
                                    'packages',
                                    'weight',
                                    'shipper',
                                    'domestic',
                                    'intl',
                                    'domestic_or_ca',
                                    'from_canada',
                                    'to_canada',
                                    'from_ak_or_hi',
                                ],
                   },
                   'shipment'
                 ],
      array  => [ 'error_details' ],
    ];

sub Required { return ( $_[ 0 ]->SUPER::Required, qw/ shipper weight / ); } # weight can be required even though some use pounds.
sub Optional { return ( $_[ 0 ]->SUPER::Optional, qw/ to_residential from_country to_country to_zip from_city
                                                      to_city        / ); }
sub Unique   { return ( $_[ 0 ]->SUPER::Unique,   qw/ shipper service from_zip from_country to_zip from_city
                                                      to_city weight / ); }    
    
=head2 $rate_request->execute()

This method sets some values (optional), executes the request, then parses the
results.

=cut

sub execute
{
    my ( $self, %args ) = @_;
    #trace( "( " . uneval( %args ) . " )" );
    
    # Try to clear previous results, in case this object was reused.
    $self->_total_charges( 0 );
    
    $self->init( %args ) if %args;
    $self->_massage_values();
    $self->validate() or return;
    my $cache = Cache::FileCache->new() if $self->cache();
    if ( $self->cache() ) {
        trace( 'cache enabled' );    

        my $key = $self->gen_unique_key();
        debug "cache key = $key\n";
        
        my $results = $cache->get( $key );
        if ( $results ) {
            trace( "found cached response, using that." );
            $self->results( $results );
            return 1;
        }
        else {
            trace( 'Cannot find cached results, running request manually, then add to cache.' );
        }
    }
    else {
        trace( 'cache disabled' );
    }
    
    # Estimate shipping for overweight shipments by dividing them into 
    # multiple shipments and sending multiple requests.
    # Lets not assume that every module can do it, though.
    my $handle_response_success;
    my $max_weight_per_package;
    $max_weight_per_package = $self->shipment->max_weight if $self->shipment->can( 'max_weight' );
    $max_weight_per_package ||= 150;
    
    #debug3 "before we start, all packages = " . Dumper( $self->shipment->packages );
    foreach my $p_idx ( 0 .. @{ $self->shipment->packages } - 1 ) {
        my $package = $self->shipment->packages_index( $p_idx );
        
        if ( ! $package->weight ) {
            error "package weight not found for package idx: $p_idx"; #, object = " . Dumper( $package );
            next;
        }
        
        my $original_weight = $package->weight;
        
        if ( $max_weight_per_package and ( $original_weight > $max_weight_per_package ) ) {
            debug 'calculating multiple shipments due to overweight...';
            debug "original weight: $original_weight, max_weight_per_package: $max_weight_per_package";
            
            my $MAX_NUM_PACKAGES = 100;
            
            my $number_of_packages = $original_weight / $max_weight_per_package;
            if ( $number_of_packages != int $number_of_packages ) {
                # 1 for the remainder, this will be the usual case
                $number_of_packages = int $number_of_packages + 1; 
            }
            
            debug 'number of packages = ' . $number_of_packages;
            
            if ( $number_of_packages > $MAX_NUM_PACKAGES ) {
                $self->user_error( "Too heavy." );
                return $self->is_success( 0 );
            }
            
            
            
            # Set the current violating package to the maximum amount, then add packages until the remaining
            # amount runs out.
            
            my $running_weight = $original_weight;
            my $running_total_cost;
            my $sum_rate = 0;
            my $last_charges = 0;
            
            
            $self->shipment->packages_index( $p_idx )->weight( $max_weight_per_package );
            $running_weight -= $max_weight_per_package;
            
            for ( my $c = 1; $c <= $number_of_packages; $c++ ) {
                debug "splitting out package #$c";
                
                my $current_weight = $running_weight > $max_weight_per_package ? 
                    $max_weight_per_package # Common path
                    :
                    $running_weight; # Last shipment, unless it divided evenly.
                    
                $running_weight -= $current_weight;
                debug "setting weight to $current_weight";
                last if $current_weight <= 0;
               
                $self->shipment->add_package( weight => $current_weight );
            }
            
            debug "done handling overweight.";
            #use Data::Dumper;
            #debug2 "shipment now: " . Dumper( $self->shipment );
        }
    }
    
    $self->perform_action();
    $handle_response_success = $self->_handle_response();
    
    my $results = $self->results();
    debug2 'results = ' . Dumper( $results );
    
    # Only cache if there weren't any errors and we only have one package.  The Unique() subs are not
    # built (currently) to generate cache keys for multiple packages.  It's all done at the shipment level.
    if ( $handle_response_success and $self->cache() and @{ $self->shipment->packages } == 1 ) {    
        trace( 'cache enabled, saving results.' );
        #
        # TODO: Allow setting of cache properties (time limit, enable/disable, etc.)
        #
        my $key = $self->gen_unique_key();
        my $new_cache = Cache::FileCache->new();
        $new_cache->set( $key, $results, "2 days" );
    }
    else {
        trace( 'cache disabled, not saving results.' );
    }
    
    debug "returning " . ( $self->is_success || 'undef' );
    return $self->is_success();
}

# COMPAT: submit() go()

*submit = *execute;
*go     = *execute;

=head2 $rate_request->validate()

Does some validation common to all RateRequest objects, but most of the 
validation goes on in the subclass.

=cut

sub validate
{
    my ( $self ) = @_;
    trace '()';
    
    my $return_val = $self->SUPER::validate;
    
    my @invalid_rate_requests_ups = config_to_ary_of_hashes( 
        cfg()->{ invalid_rate_requests }->{ invalid_rate_requests_ups }
    );
    
    foreach my $invalid_rate_request ( @invalid_rate_requests_ups ) {
        #
        # Look for an exact match
        #
        my $matches = 0;
        foreach my $option ( keys %$invalid_rate_request ) {
            
            my $not_logic = 0;
            if ( $invalid_rate_request->{ $option } =~ s/^\!// ) {
                $not_logic = 1;
            }
            if ( $option eq 'reason' ) {
                $matches++;  # Just fudge it so the count will be correct.
            }        
            elsif ( $self->can( $option ) and $self->$option() ) {
                debug3( "checking $option... matches = $matches" );
                if ( $not_logic ) {
                    if ( $self->$option() ne $invalid_rate_request->{ $option } ) {
                        $matches++;
                        debug3( $self->$option() . " does not equal " . $invalid_rate_request->{ $option } );
                    }
                }
                else {
                    if ( $self->$option() eq $invalid_rate_request->{ $option } ) {
                        debug3( $self->$option() . " equals " . $invalid_rate_request->{ $option } );
                        $matches++;
                    }
                }
            }
        }
        #debug( "matches = $matches, keys = " . keys %$invalid_rate_request );
        
        #
        # If all keys matched (i.e. the number of matches == the number of keys )
        #
        if ( $matches == keys %$invalid_rate_request ) {
            my $reason = ( $invalid_rate_request->{ reason } ? '  ' . $invalid_rate_request->{ reason } : '' ); 
            $self->invalid( 1 );
            $self->user_error( "Rate request invalid.$reason  See the configuration file for more information." );
            $return_val = 0;
        }
    }
        
    return $return_val;
}

=head2 $rate_request->get_unique_hash()

Calls unique() on all subclasses to determine a list of unique elements.

Returns a hash of element_name => element_value.  Used by gen_unique_key().

=cut

sub get_unique_hash
{
    my $self = shift;
    
    my %unique;
    
    my @Unique = $self->get_grouped_attrs( 'Unique' );
    
    debug( "Unique attributes for this RateRequest are: " . join( ',', @Unique ) ); 
    for ( @Unique ) {
        if ( $self->can( $_ ) ) {
            $unique{ $_ } = $self->$_;
        }
    }
    
    foreach my $package ( $self->shipment->packages() ) {
        foreach my $package_unique_key ( $package->get_grouped_attrs( 'Unique', object => $package ) ) {
            $unique{ 'p1_' . $package_unique_key } = $package->$package_unique_key();
        }
    }
    return %unique;
}

=head2 $rate_request->hash_to_sorted_values()

Sorts hash alphabetically, then returns just the values.  (So that the key will
have the values sorted in the same order always).

=cut

sub hash_to_sorted_values
{
    my $self = shift;
    my ( %hash ) = @_;
    my @sorted_values;
    foreach my $key ( sort keys %hash ) {
        push @sorted_values, ( $hash{ $key } || '' );
    }
    return @sorted_values;
}

=head2 $rate_request->gen_unique_key( )

Calls get_unique_hash(), sorts them with hash_to_sorted_values(), then returns 
them in string format.

=cut

sub gen_unique_key
{
    my $self = shift;
    my %unique = $self->get_unique_hash();
    my @sorted_values = $self->hash_to_sorted_values( %unique ); 
    return join( '|', @sorted_values );
    return;
}

=head2 $rate_request->rate()

Iterates the $self->results hash and sums the charges from each 
package->charges.  Returns the total.

Example of what the results look like:

 [
     { 
         name => 'UPS_Online',
         rates   => [
                        {
                            code        => '03',
                            short_name  => 'GNDRES',
                            name        => 'Ground Residential',
                            est_deliv   => 4,
                            charges     => 5.32,
                            charges_formatted => '$5.32',
                        },
                    ]
     }
 ];

=cut

sub rate
{
    my ( $self ) = @_;
    
    if ( $self->service and lc $self->service eq 'shop' ) {
        # rate() does not work for 'shop' types, how would you know
        # which service to return?  Return data structure with all
        # that is needed.
        return $self->results;
    }
    
    if ( ref( $self->results ) ne 'ARRAY' ) {
        $self->user_error( "Could not determine rate." );
        return;
    }
    
    foreach my $shipper ( @{ $self->results } ) {
        # Just return the amount for the first one.
        #debug "Shipper: $shipper\n";
        return $shipper->{ rates }->[ 0 ]->{ split_shipment_sum_rate } 
            || $shipper->{ rates }->[ 0 ]->{ charges };
    }
    
    return;
}

=head2 $rate_request->get_unique_keys()

=cut

sub get_unique_keys
{
    my $self = shift;
    
    # None at the Business::Shipping level, so do not check parent.
    my @unique_keys = ();
    
    return( @unique_keys );
}

=head2 $rate_request->_gen_unique_values()

=cut

sub _gen_unique_values
{
    trace '()';
    my ( $self ) = @_;
        
    # Now I need to get unique values for all packages.
    
    my @unique_values;
    foreach my $package ( @{$self->packages()} ) {
        push @unique_values, $package->get_unique_values();
    }
    
    # We prefer 0 in the key to represent 'undef'
    # clean it all up...
    my @new_unique_values;
    foreach my $value ( @unique_values ) {
        if ( not defined $value ) {
            $value = 0;
        }
        push @new_unique_values, $value;
    }

    return( @new_unique_values );
}

=head2 $rate_request->calc_debug_string()

Arrange the values of some important variables in a pretty format.
Return a scalar string.

=cut

sub calc_debug_string
{
    my ( $self ) = @_;
    
    my $vars_out .= "\nActual values from the rate_request object\n";
    foreach ( qw/ from_country to_country from_zip to_zip weight service / ) {
        
        my $val = ( $self->can( $_ ) ? $self->$_ : '' ) || '';
        $vars_out .= "\t$_ => \t\t\'" . $val . "\',\n";
    }
    
    return $vars_out;
}

=head2 $rate_request->display_price_components()

Return formatted string of price component information

=cut

sub display_price_components
{
    my ( $self ) = @_;
    return Data::Dumper::Dumper( $self->price_components ) if $self->price_components;
    return;
}

# COMPAT: get_total_charges()
# COMPAT: get_total_price()
# COMPAT: total_charges()

*get_total_charges = *rate;
*get_total_price   = *rate;
*total_charges     = *rate;

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