| Business::Shipping::UPS_Offline::RateRequest - Calculates shipping cost offline |
Business::Shipping::UPS_Offline::RateRequest - Calculates shipping cost offline
$Rev: 165 $ $Date: 2004-09-14 09:20:29 -0700 (Tue, 14 Sep 2004) $
Hash. Format:
$self->Zones() = (
'Canada' => {
'zone_data' => [
'low high service1 service2',
'004 005 208 209',
'006 010 208 209',
'Canada Canada 504 504',
]
}
)
- For International, it's the name of the country (e.g. 'Canada') - For Domestic, it is the first three of a zip (e.g. '986') - For Canada, it is...?
do_convert_data()
Find all data .csv files and convert them from the vanilla UPS CSV format into one that Business::Shipping can use.
Increase the _total_charges by an amount.
The "Delivery Area Surcharge" is also known as "Extended Area Surcharge", but does not include special residential charges that apply to some services (air services, for example).
calc_residential_surcharge()
Note that this is different than the delivery area surcharge sub calc_residential_surcharge. It is listed as "Residential Differential" in the accessorials.csv file.
Currently $1.40.
calc_zone_data()
* Modifies the class attribute Zones(), and adds data for the zone like so...
$self->Zones() = (
'Canada' => {
'zone_data' => [
'low high service1 service2',
'004 005 208 209',
'006 010 208 209',
'Canada Canada 504 504',
]
}
)
=cut
sub calc_zone_data
{
trace( 'called' );
my ( $self ) = @_;
my $zone_name = $self->zone_name;
if ( not defined $zone_name ) {
$self->user_error( "Need zone_name" );
return;
}
#
# Don't recalculate it if it already exists, unless overridden by configuration.
#
debug( "zone_name = $zone_name" );
debug( "Zones = " . $self->Zones );
if (
$self->Zones->{ $zone_name }
and ! cfg()->{ ups_information }->{ always_calc_zone_data }
)
{
debug( "Zone $zone_name already defined, skipping." );
return;
}
#
# Initialize this zone
#
$self->Zones->{ $zone_name } = {};
#
# World-wide: instead of 130-139,123,345, we have:
# Albania,123,345
#
debug( 'looking for zone_name: ' . $zone_name . ", with zone_file: " . $self->zone_file );
for ( keys %{ $self->Zones } ) {
my $this_zone = $self->Zones->{ $_ };
if ( ! $this_zone->{ zone_data } ) {
$this_zone->{ zone_data } = Business::Shipping::Util::readfile( $self->zone_file() );
}
if ( ! $this_zone->{ zone_data } ) {
$self->user_error( "Bad shipping file for zone " . $_ . ", lookup disabled." );
next;
}
my ( @zone ) = grep /\S/, split /[\r\n]+/, $this_zone->{ zone_data };
shift @zone while @zone and $zone[0] !~ /^(Postal|Dest\. ZIP|Country)/;
if ( $zone[ 0 ] and $zone[ 0 ] =~ /^Postal/ ) {
debug3( 'this zone (' . $zone[ 0 ] . ') =~ ^Postal' );
$zone[ 0 ] =~ s/,,/,/;
for ( @zone[ 1 .. $#zone ] ) {
s/,/-/;
}
}
if ( $zone[ 0 ] and $zone[ 0 ] !~ /\t/ ) {
@zone = grep /\S/, @zone;
@zone = grep /^[^"]/, @zone;
$zone[0] =~ s/[^\w,]//g;
$zone[0] =~ s/^\w+/low,high/;
@zone = grep /,/, @zone;
$zone[0] =~ s/\s*,\s*/\t/g;
#
# Split into a tab-separated format.
#
my $count;
for(@zone[1 .. $#zone]) {
#debug( "before = $_" );
my @columns = split( ',', $_ );
if ( $columns[ 0 ] =~ /-/ ) {
#
# "601-605" => "601,605"
#
my ( $low, $high ) = split( '-', $columns[ 0 ] );
splice( @columns, 0, 1, ( $low, $high ) );
}
else {
#
# Copy the country name (or zip with no range) into the second field.
# "601" => "601,601"
#
splice( @columns, 1, 0, ( $columns[ 0 ]) );
}
$_ = join( ',', @columns );
#
# "," => " "
#
s/\s*,\s*/\t/g;
#debug( "after = $_" );
}
}
$this_zone->{ zone_data } = \@zone;
#
# TODO: Do I need to copy the $this_zone back into the Zones() hash?
# Or does copying the reference, then modifying the reference do the
# same thing?
#
# $self->Zones( $zone_name => $this_zone )
#
}
return;
}
determine_keys()
Decides what unique keys will be used to locate the zone record.
* The first key ("key") is a shortened version (the zip code "98682" becomes
"986") to locate the zone file and the range that it fits into.
* The second key ("raw_key") is the actual key, for looking up the record
in the correct zone file once it has been found.
Returns ( $key, $raw_key )
WorldWide methods use different tables for Canada
* Modifies the class attribute $Zones, and adds data for the zone like so...
$Zones => {
'Canada' => {
'zone_data' => [
'first line of zone file',
'second line',
'etc.',
]
}
}
=cut
sub calc_cost
{
my ( $self ) = @_;
if ( ! $self->zone_name or ! $self->service ) {
$self->user_error( "Need zone_name and service" );
return;
}
my $zone_name = $self->zone_name;
my $zref = $self->Zones->{ $zone_name };
my $type = $self->service_code_to_ups_name( $self->service() );
my $table = $self->ups_name_to_table( $type );
$table = $self->rate_table_exceptions( $type, $table );
my ( $key, $raw_key ) = $self->determine_keys;
my @data;
my @fieldnames;
my $i;
my $point;
my $zone;
my $rawzip;
my $weight = $self->weight;
my $code = 'u';
my $opt = {};
$opt->{residential} ||= $self->shipment()->to_residential();
#
# TODO: validation checks...
#
# Check that the GNDRES.csv database exists.
# Check that the zone (e.g. 450) was defined.
# Check that we have the zone data calculated.
#
debug( "rate table = " . ( $table ? $table : 'undef' ) . ", zone_name = " . ( $zone_name ? $zone_name : 'undef' ) );
if ( ! defined $zref->{zone_data} ) {
$self->user_error( "zone data could not be found" );
return 0;
}
my $zdata = $zref->{zone_data};
#
# Here we can adapt for pounds/kg
#
if ($zref->{mult_factor}) {
$weight = $weight * $zref->{mult_factor};
}
#
# Tables don't cover fractional pounds, so round up.
#
$weight = POSIX::ceil($weight);
#
# Handle eastcoast / westcoast fieldnames
# Except for Canada.
#
if ( $self->to_canada ) {
#
# Remove the 'SM' from the end, Canada doesn't have that silliness.
#
$type =~ s/SM$//;
}
else {
#
# The only other Express/Expedited methods are intl.
#
if ( $type eq 'ExpressSM' ) {
$type = $self->is_from_west_coast() ? 'ExpressSM_WC' : 'ExpressSM_EC';
}
elsif ( $type eq 'ExpeditedSM' ) {
$type = $self->is_from_west_coast() ? 'ExpeditedSM_WC' : 'ExpeditedSM_EC';
}
}
@fieldnames = split( /\t/, $zdata->[ 0 ] ) if $zdata->[ 0 ];
debug( "Looking for $type in fieldnames: " . ( join( ' ', @fieldnames ) || 'undef' ) );
for($i = 0; $i < @fieldnames; $i++) {
debug( "checking $fieldnames[$i] eq $type" );
next unless $fieldnames[ $i ] eq $type;
$point = $i;
last;
}
if ( ! defined $point) {
$self->user_error( "Zone '$code' lookup failed, type '$type' not found" );
return 0;
}
else {
#
# We have to add one because the International files don't have a "low high", just "country".
#
$point++ if ! $self->domestic_or_ca;
debug( "point (i.e. field index) found! It is $point. Fieldname referenced by point is $fieldnames[$point]" );
}
debug( "point = $point, looking in zone data..." );
for ( @{ $zdata }[ 1.. $#{ $zdata } ] ) {
@data = split /\t/, $_;
debug3( "data = " . join( ',', @data ) );
if ( $self->current_shipment->domestic_or_ca ) {
my $low = $data[0];
my $high = $data[1];
my $goal = $key;
if ( $self->current_shipment->to_canada ) {
#
# Canada uses a base-36 (0-10 + A-Z) zip number system.
# Use a base converter to convert the numbers to base-10
# just for the sake of comparison.
#
$low = cnv( $low, 36, 10 );
$high = cnv( $high, 36, 10 );
$goal = cnv( $goal, 36, 10 );
}
#debug( "checking if $goal is between $low and $high" );
next unless $goal and $low and $high;
next unless $goal ge $low and $goal le $high;
debug( "setting zone to $data[$point] (the line was: " . join( ',', @data ) . ")" );
$zone = $data[ $point ];
}
else {
next unless ( $data[0] and $key eq $data[0] );
$zone = $data[ ( $point - 1) ];
debug( "found key! data = " . join( ',', @data ) );
}
last;
}
$zone = $self->special_zone_hi_ak( $type, $zone );
if ( not defined $zone ) {
$self->user_error(
"No zone found for geo code (key) " . ( $key || 'undef' ) . ", "
. "type " . ( $type || 'undef' ) . '.'
);
return 0;
}
elsif ( ! $zone or $zone eq '-') {
$self->user_error( "No $type shipping allowed for $key." );
$self->invalid( 1 );
return 0;
}
# Some UPS files (ww_xpr) do not have a record for every weight (e.g. 55).
# To solve the problem, add 1 to the weight, and try again.
my $cost;
for ( my $tries = 0; $tries <= 5; $tries++ ) {
debug( "zone=$zone, going to call record( $table, $zone, " . ( $weight + $tries ) . " ) " );
$cost = record( $table, $zone, $weight + $tries );
last if $cost;
}
if ( ! $cost ) {
$self->user_error( "Zero cost returned for mode $type, geo code (key) $key.");
return 0;
}
debug "cost = $cost";
#
# TODO: Surcharge table + Surcharge_field?
# TODO: Residential field (same table)?
#
return $cost || 0;
}
$type Type of service. Hawaii and Alaska have special per-zipcode zone exceptions for 1da/2da.
calc_zone_info()
Determines which zone (zone_name), and which zone file to use for lookup.
If this is an international order, we need to determine which state the shipper is in, then if it is east or west coast. If west, then use the first "Express" field in the zone chart. If east, then use the second.
_massage_values()
Performs some final value modification just before the submit.
Dan Browning <db@kavod.com>, Kavod Technologies, http://www.kavod.com.
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.
| Business::Shipping::UPS_Offline::RateRequest - Calculates shipping cost offline |