8582432; #--------------------------------------------------------------- # # Generated by ActinicSimpleShipping # #--------------------------------------------------------------- # # # Message List # my $pMessageList = [ 'The shipping price is formatted incorrectly. It should be formatted like %s.', 'The shipping price is too large. The price must be less than %s.', 'The shipping price is too small. The price must be greater than or equal to %s.', 'The class/location combination you selected were invalid. Please check and re-enter your selection.', 'The catalog shipping database does not have any shipping options defined for this location. Please contact us directly with your order.', 'Free Shipping', 'Standard Shipping', 'Your order has exceeded the shipping tables defined by the supplier, therefore it is not possible to calculate the shipping cost. Please contact the supplier with this information as they will be happy to process your order and will then be able to correct the shipping tables.
Thank you.',
'Please enter a shipping cost.',
'Please select a state or province.',
];
#
# Zone table
#
my %ZoneTable = (
"UK" => {
"UndefinedRegion" => [13],
},
"US" => {
"UndefinedRegion" => [10],
},
"CA" => {
"UndefinedRegion" => [10],
},
"AU" => {
"UndefinedRegion" => [10],
},
"AT" => {
"UndefinedRegion" => [11],
},
"BE" => {
"UndefinedRegion" => [11],
},
"CY" => {
"UndefinedRegion" => [11],
},
"CZ" => {
"UndefinedRegion" => [11],
},
"DK" => {
"UndefinedRegion" => [11],
},
"EE" => {
"UndefinedRegion" => [11],
},
"FI" => {
"UndefinedRegion" => [11],
},
"FR" => {
"UndefinedRegion" => [11],
},
"DE" => {
"UndefinedRegion" => [11],
},
"GR" => {
"UndefinedRegion" => [11],
},
"HU" => {
"UndefinedRegion" => [11],
},
"IE" => {
"UndefinedRegion" => [11],
},
"IT" => {
"UndefinedRegion" => [11],
},
"JP" => {
"UndefinedRegion" => [10],
},
"KR" => {
"UndefinedRegion" => [10],
},
"LV" => {
"UndefinedRegion" => [11],
},
"LT" => {
"UndefinedRegion" => [11],
},
"LU" => {
"UndefinedRegion" => [11],
},
"MT" => {
"UndefinedRegion" => [11],
},
"NL" => {
"UndefinedRegion" => [11],
},
"NZ" => {
"UndefinedRegion" => [10],
},
"PL" => {
"UndefinedRegion" => [11],
},
"PT" => {
"UndefinedRegion" => [11],
},
"SK" => {
"UndefinedRegion" => [11],
},
"SI" => {
"UndefinedRegion" => [11],
},
"ES" => {
"UndefinedRegion" => [11],
},
"SE" => {
"UndefinedRegion" => [11],
},
);
#
# Shipping class table
#
my %ClassTable = (
12 => ['Royal Mail Airmail', 0],
13 => ['Royal Mail Surface', 1],
15 => ['DHL Global 3 Day Delivery', 0],
12 => ['Royal Mail Airmail', 0],
9 => ['Standard Delivery (2 - 5 Working Days)', 0]
);
#
# Defined Categories
#
my $phashDefinedCategories =
{
'Default' => 1,
};
#
# Default Category
#
my $sDefaultCategory = 'Default';
#
# Shipping bands table
#
my %ShippingTable = (
9 =>
{
13 => [ {'CalculationBasis' => 0, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 0, 'ExcessAction' => 'Highest'}, { "wt" => 10.00, "cost" => 300}, ],
},
13 =>
{
10 => [ {'CalculationBasis' => 0, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 0, 'ExcessAction' => 'Error'}, { "wt" => 1.00, "cost" => 1000}, { "wt" => 2.00, "cost" => 1300}, ],
},
12 =>
{
10 => [ {'CalculationBasis' => 0, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 0, 'ExcessAction' => 'Error'}, { "wt" => 1.00, "cost" => 1600}, { "wt" => 1.50, "cost" => 2200}, { "wt" => 2.00, "cost" => 2700}, ],
11 => [ {'CalculationBasis' => 0, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 0, 'ExcessAction' => 'Highest'}, { "wt" => 1.00, "cost" => 1000}, { "wt" => 1.50, "cost" => 1300}, { "wt" => 2.00, "cost" => 1500}, { "wt" => 3.00, "cost" => 2000}, { "wt" => 4.00, "cost" => 2500}, ],
},
15 =>
{
10 => [ {'CalculationBasis' => 0, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 0, 'ExcessAction' => 'Error'}, { "wt" => 2.00, "cost" => 3500}, { "wt" => 4.00, "cost" => 5000}, { "wt" => 6.00, "cost" => 7500}, { "wt" => 8.00, "cost" => 10000}, ],
},
);
my $phashWeightConfiguration =
{
0 => {'UseWeightIfUndefined' => 0, 'DefaultWeight' => '0.25' ,'OptimalWeight' => '' ,},
4 => {'UseWeightIfUndefined' => 0, 'DefaultWeight' => '0.25' ,'OptimalWeight' => '' ,},
5 => {'UseWeightIfUndefined' => 0, 'DefaultWeight' => '' ,'OptimalWeight' => '' ,},
};
my ($ShippingBasis, $SimpleCost, $UnknownRegion, $UnknownRegionCost, $WaiveCharges, $WaiveThreshold);
$ShippingBasis = 'ByZoneClass';
$UnknownRegion = 'Default';
$UnknownRegionCost = 1000;
$WaiveCharges = 'No';
$WaiveThreshold = 20100.000000;
my $bPricesIncludesTax = 0;
my $dTaxInclusiveMultiplier = 1.000000;
#
# Handling variables
#
my $nHandlingCharge = 0;
my $nHandlingProportion = 0;
#
# Parent country zone list
#
my %ParentZoneTable = (
"US" => [10, ],
"CA" => [10, ],
);
################################################################
#
# ShippingTemplate.pl - code part of Shipping
#
# *** Do not change this code unless you know what you are doing ***
#
# Written by Kevin Grumball
# Revised by Mike Purnell November 2001
#
# Copyright (c) Actinic Software Ltd 1998-2001 All rights reserved
#
# This script is called by an eval() function and it will already
# have the following variables set up:
#
# Expects: %::g_InputHash - contains the input parameters (only for validation modes)
# @::s_Ship_sShipProducts - list of product IDs
# @::s_Ship_nShipQuantities - list of quantities (to match ProductIDs)
# @::s_Ship_nShipPrices - list of unit prices (to match ProductIDs)
# %::s_Ship_PriceFormatBlob - the price format data
# $::s_Ship_sOpaqueShipData - contains user shipping selection
# $::s_sDeliveryCountryCode - contains shipping address country code
# $::s_sDeliveryRegionCode - contains shipping address region code
# $::s_Ship_bDisplayPrices - flag indicating whether or not the prices are visible
# %::s_Ship_OpaqueDataTables - product opaque data table
# $::s_Ship_nSubTotal - product sub-total
#
# Affects: $::s_Ship_sOpaqueShipData - contains user shipping selection
# $::s_Ship_sOpaqueHandleData - contains user handling selection
# %::s_Ship_nShippingStatus - hash table containing the return codes for the
# various functions of the script. Valid keys are:
# ValidatePreliminaryInput, ValidateFinalInput,
# RestoreFinalUI, CalculateShipping,
# IsFinalPhaseHidden, GetShippingDescription,
# GetHandlingDescription, or CalculateHandling.
# Valid values are:
# $::SUCCESS - OK, $::FAILURE - error
# %::s_Ship_sShippingError - hash table containing the error messages for the various
# functions of the script. Valid keys are the same as for
# %::s_Ship_sShippingStatus.
# %::s_Ship_PreliminaryInfoVariables - hash where the keys are lists of strings
# to replace in the HTML and values are the new HTML strings
# %::s_Ship_ShippingVariables - hash where the keys are lists of strings
# to replace in the HTML and values are the new HTML strings
# $::s_Ship_bShipPhaseIsHidden - $::TRUE if the shipping phase is hidden
# $::s_Ship_sShippingDescription - the selected shipping method description
# $::s_Ship_sHandlingDescription - the selected handling method description
# $::s_Ship_sShippingCountryName - the country the customer selected
# $::s_Ship_nShipCharges - the shipping total for this order
# $::s_Ship_nShipOptions - the number of shipping options
# $::s_Ship_nHandlingCharges - the handling total for this order
# $::s_Ship_bDisplayExtraCartInformation - determine whether the extra cart xml tag should be displayed or not
# %::s_Ship_aShippingClassProviderIDs - provider ids for which the extra shipping xml tag should be displayed
# %::s_Ship_aBasePlusPerProviderIDs - provider ids for which the extra base plus per reclaiming xml tag should be displayed
#
# $Revision: 24456 $
#
################################################################
use strict;
#? my @__keys1 = keys %::g_InputHash;
#? ACTINIC::ASSERT($#__keys1 != -1, 'Input has undefined', __LINE__, __FILE__);
#? my @__keys2 = keys %::s_Ship_PriceFormatBlob;
#? ACTINIC::ASSERT($#__keys2 != -1, 'Price object undefined', __LINE__, __FILE__);
my $UNDEFINED = 'UndefinedRegion'; # undefined region flag
#
# Add a variable to hold the online error handling if any
#
my $sOnlineError = '';
#
# UPS constants
#
$::UPS_XPCI_VERSION = '1.0001';
#
# UPS status codes
#
$::UPS_SUCCESSFUL = '1';
$::UPS_FAILED = '0';
#
# UPS node names
#
$::XML_HEADER = "";
$::UPS_XML_RESPONSE = 'Response';
$::UPS_XML_RESPONSE_STATUS_CODE = 'ResponseStatusCode';
$::UPS_XML_RESPONSE_STATUS_DESCRIPTION = 'ResponseStatusDescription';
$::UPS_XML_ERROR = 'Error';
$::UPS_XML_ERROR_DESCRIPTION = 'ErrorDescription';
$::UPS_XML_ERROR_SEVERITY = 'ErrorSeverity';
$::UPS_XML_ADDRESS_VALIDATION_RESULT = 'AddressValidationResult';
$::UPS_XML_RATED_SHIPMENT = 'RatedShipment';
$::UPS_XML_SERVICE = 'Service';
$::UPS_XML_SERVICE_CODE = 'Code';
$::UPS_XML_TOTAL_CHARGES = 'TotalCharges';
$::UPS_XML_CURRENCY_CODE = 'CurrencyCode';
$::UPS_XML_MONETARY_VALUE = 'MonetaryValue';
$::UPS_XML_RANK = 'Rank';
$::UPS_XML_QUALITY = 'Quality';
$::UPS_XML_ADDRESS = 'Address';
$::UPS_XML_STATE_PROVINCE_CODE = 'StateProvinceCode';
$::UPS_XML_CITY = 'City';
$::UPS_XML_POSTAL_CODE_LOW_END = 'PostalCodeLowEnd';
$::UPS_XML_POSTAL_CODE_HIGH_END = 'PostalCodeHighEnd';
$::UPS_ERROR_SEVERITY_TRANSIENT_ERROR = 'Transient';
$::UPS_ERROR_SEVERITY_HARD_ERROR = 'Hard';
$::UPS_ERROR_SEVERITY_WARNING = 'Warning';
#
# SSL Connection for UPS communication
#
my $ssl_socket;
#
# initialize the response variables
#
%::s_Ship_nShippingStatus = ();
%::s_Ship_sShippingError = ();
%::s_Ship_PreliminaryInfoVariables = ();
%::s_Ship_ShippingVariables = ();
$::s_Ship_bPrelimIsHidden = $::FALSE;
$::s_Ship_bShipPhaseIsHidden = $::FALSE;
$::s_Ship_sShippingDescription = '';
$::s_Ship_sHandlingDescription = ''; # not used in this plug-in
$::s_Ship_sShippingCountryName = '';
$::s_Ship_nShipCharges = 0;
$::s_Ship_nShipOptions = 0;
$::s_Ship_nShippingStatus{GetHandlingDescription} = $::SUCCESS;
$::s_Ship_sShippingError{GetHandlingDescription} = '';
$::s_Ship_bDisplayExtraCartInformation = $::FALSE;
%::s_Ship_hShippingClassProviderIDs = ();
%::s_Ship_hBasePlusPerProviderIDs = ();
$::s_Ship_nSSPProviderID = -1;
$::s_Ship_bTaxAppliesToShipping = $::FALSE;
#
# Remember if
# - there was no UPS classes added to the shipping service classes
# - there were base plus per classes added to the shipping classes due to a server connection failure
# - there were UPS classes added to the shipping classes
#
$::UPS_CLASSES_NOT_USED = 0;
$::UPS_CLASSES_USED = 1;
$::UPS_BASEPLUSPER_CLASSES_USED = 2;
my %hSSPUsed;
#
# Handling UPS unavailability
#
my $bUPS_Available = $::TRUE;
#
# define the string for confirm by email shipping
#
my $sCONFIRM_BY_EMAIL = 'Actinic:ConfirmByEmail';
#
# Define our array of valid classes
#
@::s_arrSortedShippingHashes;
#
# Make simple shipping and default shipping variables available outside (needed for GC)
#
$::SimpleCost = $SimpleCost;
$::ShippingBasis = $ShippingBasis;
$::UnknownRegion = $UnknownRegion;
$::UnknownRegionCost = $UnknownRegionCost;
$::UnknownRegionLabel = $$pMessageList[6];
$::FreeShippingLabel = $$pMessageList[5];
#
# Define a hash of our current selection as specified by
# the contents of the opaque data
#
local %::s_hashShipData;
#
# Define a hash of class IDs to weight/cost entries
#
local %::s_hashClassToWeightCost;
#
# Define constants for calculation basis
#
my $c_nWeight = 0;
my $c_nQuantity = 1;
my $c_nPrice = 2;
my $c_nSimple = 3;
my $c_nAlternateWeight = 4;
my $c_nMaximumWeight = 5;
my $c_nPerItemShipping = 6;
#
# Initialise the shipping and handling supplements
#
$::dShippingSupplements = 0;
$::dHandlingSupplements = 0;
#
# Initialise the adjusted shipping quantity
#
$::s_Ship_nAdjustedTotalQuantity = undef;
#
# Define our array of functions to be called
# in sequence
#
my @arrFuncns =
(
[\&ValidatePreliminaryInput, 'ValidatePreliminaryInput'],
[\&ValidateFinalInput, 'ValidateFinalInput'],
[\&RestoreFinalUI, 'RestoreFinalUI'],
[\&CalculateShipping, 'CalculateShipping'],
[\&IsFinalPhaseHidden, 'IsFinalPhaseHidden'],
[\&GetShippingDescription, 'GetShippingDescription'],
[\&CalculateHandling, 'CalculateHandling'],
);
#
# Get the current selection into a hash
#
OpaqueToHash();
#
# Do the actual processing
#
my ($parrFunction, $nReturnCode, $sError);
$nReturnCode = $::SUCCESS; # make sure we start
foreach $parrFunction (@arrFuncns) # for each function in the array
{
my $pFunction = $$parrFunction[0];
($nReturnCode, $sError) = &$pFunction(); # call this function
$::s_Ship_nShippingStatus{$$parrFunction[1]} = $nReturnCode; # save status
$::s_Ship_sShippingError{$$parrFunction[1]} = $sError; # save error text
}
SaveSelectionToOpaqueData();
#
# Make a global copy of the class list
#
my $nClassID;
foreach $nClassID (keys(%ClassTable))
{
push (@::s_ShipClassList, $ClassTable{$nClassID}[0]);
}
return($::SUCCESS); # abort execution (the $::SUCCESS here indicates that the script did not crash)
#------------------------------------------------------
#
# High-level functions
#
#------------------------------------------------------
#######################################################
#
# ValidatePreliminaryInput - Validate the user
# selection at the preliminary level and filter out
# any special cases if we can identify them
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub ValidatePreliminaryInput
{
#
# If it's simple shipping then just return. Simple shipping has no preliminary
# input.
#
if ($ShippingBasis eq 'Simple') # if simple shipping
{
return($::SUCCESS, undef);
}
#
# Advanced shipping
#
# Check if we qualify for free shipping
#
if ($WaiveCharges eq 'Value' && # we support free over
CalculatePrice() > $WaiveThreshold) # and we've exceeded the threshold
{
return(SetFreeShipping());
}
#
# If we don't know the country, shipping is undefined
#
if($::s_sDeliveryCountryCode eq '')
{
return(SetUndefinedShipping());
}
#
# If they selected None of the Above, we apply a default charge if
# allowed otherise return an error
#
if($::s_sDeliveryCountryCode eq $ActinicOrder::REGION_NOT_SUPPLIED)
{
return(SetDefaultCharge());
}
#
# We've handled an unknown country and None of the Above, so we
# must have a valid country
#
# Make sure that they have selected a state if this country has states and requires them.
# They do not need to select a state if the country has no states or if the country is in
# a zone that none of its states are in.
#
if ($::s_sDeliveryRegionCode eq "" || # if the state is undefined
$::s_sDeliveryRegionCode eq $UNDEFINED)
{
if (defined $ParentZoneTable{$::s_sDeliveryCountryCode} && # if the country has states and
$#{$ParentZoneTable{$::s_sDeliveryCountryCode}} == -1) # the country requires a state to map to a zone
{
return ($::FAILURE, $$pMessageList[9]); # tell the user we want a state
}
}
#
# If we know the delivery country
# Get the SSP providers for this country
#
my $pProviderList = GetSSPProviderList($::s_sDeliveryCountryCode);
if (keys %ZoneTable == 0 && # if no actinic zones and
@$pProviderList == 0 ) # no SSP support for this country
{
return(SetDefaultCharge()); # set default charge or return an error
}
#
# If we're using online tools check the required fields
#
# Check AVS if enabled
#
if($::g_pSSPSetupBlob &&
$$::g_pSSPSetupBlob{1}{'AVSEnabled'} &&
(exists $::g_InputHash{'LocationDeliveryCountry'} || exists $::g_InputHash{DELIVERADDRESSSELECT}))
{
my $sCity = $::g_ShipContact{'ADDRESS3'};
#
# Do the online AVS
#
my ($Result, $sSSPError) = DoUPSAddressValidation(ActinicLocations::GetISODeliveryCountryCode(),
ActinicLocations::GetISODeliveryRegionCode(), $sCity, $::g_LocationInfo{DELIVERPOSTALCODE});
if($Result == $::BADDATA) # note that it doesn't cover server unavailable error in which case we let the user proceed buying
{
#
# This can occur either for state/postcode or state/city/postcode.
# If just state/postcode, we can't calculate the shipping so set to
# undefined
#
if($sCity eq '')
{
SetUndefinedShipping();
}
return($::FAILURE, $sSSPError);
}
}
return($::SUCCESS, undef);
}
#######################################################
#
# ValidateFinalInput - Validate the final user
# selection and return the shipping selection in
# an opaque string
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub ValidateFinalInput
{
#
# If it's simple shipping then validate the input cost
#
if ($ShippingBasis eq 'Simple')
{
return(SimpleValidateFinalInput()); # validate simple
}
#
# Advanced shipping
#
# If we've populated our shipping hashes with free or default shipping
# there's nothing more to do
#
if(@::s_arrSortedShippingHashes > 0)
{
return($::SUCCESS, undef);
}
#
# Calculate the multi-package shipping if we haven't hit
# free, undefined or default shipping
#
my ($nReturnCode, $sError);
if(@::s_arrSortedShippingHashes == 0)
{
#
# Calculate the (multi-package) shipping
#
($nReturnCode, $sError) = CalculateMultiPackageShipping();
if($nReturnCode != $::SUCCESS)
{
return($nReturnCode, $sError);
}
}
SaveSelectionToOpaqueData(); # Save the selection to the opaque data
return($::SUCCESS, undef);
}
#######################################################
#
# RestoreFinalUI - generate a hash of substitution values
# The keys in the hash are strings in the shipping
# HTML that need to be replaced with the corresponding
# value. This function processes the final shipping UI.
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub RestoreFinalUI
{
#
# Simple mode
#
if ($ShippingBasis eq 'Simple') # we are in simple mode
{
return(SimpleRestoreFinalUI());
}
#
# Advanced mode
#
my ($phashShipping, $sClassLabel, $sClassID, $sSelectHTML);
my $sPriceLabelFormat = ' (%s)';
$::s_Ship_nShipOptions = @::s_arrSortedShippingHashes; # Record the number of shipping options
if (@::s_arrSortedShippingHashes == 1) # if there's only one option
{
$phashShipping = $::s_arrSortedShippingHashes[0];
#
# Handle the label by appending the cost if we're displaying prices
#
$sClassLabel = $$phashShipping{ShippingLabel};
if ($::s_Ship_bDisplayPrices) # displaying prices?
{
my (@PriceResponse) =
ActinicOrder::FormatPrice($$phashShipping{Cost},
$::TRUE,
\%::s_Ship_PriceFormatBlob);
$sClassLabel .= sprintf($sPriceLabelFormat, $PriceResponse[2]); # add the price to the label
}
#
# Format as a HIDDEN tag
#
$sSelectHTML =
sprintf("%s\n",
$sClassLabel,
$$phashShipping{ShippingClass});
}
elsif (@::s_arrSortedShippingHashes > 1) # if there's more than one option
{
#
# Start the SELECT tag
#
$sSelectHTML = "\n";
}
#
# Determine which trademarks, disclaimers should be displayed
#
if($hSSPUsed{$::UPS_CLASSES_USED} == $::TRUE)
{
$::s_Ship_hShippingClassProviderIDs{1} = $::TRUE;
}
elsif ($hSSPUsed{$::UPS_BASEPLUSPER_CLASSES_USED} == $::TRUE)
{
$::s_Ship_hBasePlusPerProviderIDs{1} = $::TRUE;
}
$::s_Ship_ShippingVariables{$::VARPREFIX . 'SHIPPINGSELECT'} = $sSelectHTML;
return($::SUCCESS, undef);
}
#######################################################
#
# CalculateShipping
# Get the possible zones for this country and region
# There may be more than one possible zone and we can
# select the shipping band based on the class of shipping.
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub CalculateShipping
{
#
# For simple shipping, we just apply the single value
#
if ($ShippingBasis eq 'Simple') # Simple shipping
{
return(SimpleCalculateShipping());
}
#
# If there are no hashes in the sorted array
#
if(@::s_arrSortedShippingHashes == 0)
{
return($::SUCCESS, undef);
}
#
# Handle a selected UPS class
#
if($::s_hashShipData{'ShippingClass'} =~ /^(\d+)_(.+)/)
{
$::s_Ship_nSSPProviderID = $1;
#
# Check if this is an error class
#
my $bSSPError = $2 eq $sCONFIRM_BY_EMAIL;
my $pSSPProvider = GetUPSSetup();
$::s_Ship_sSSPOpaqueShipData =
sprintf("SSPID=%d;SSPClassRef=%s;OrigZip=%s;OrigCntry=%s;OrigCntryDesc=%s;Pack=%s;Rate=%s;Weight=%.03f;DestCntry=%s;DestPost=%s;Residential=%s;",
$::s_Ship_nSSPProviderID,
$2,
$$pSSPProvider{ShipperPostalCode},
$$pSSPProvider{ShipperCountry},
ACTINIC::GetCountryName($$pSSPProvider{ShipperCountry}),
$$pSSPProvider{'PackagingType'},
$$pSSPProvider{'RateChart'},
$::s_hashShipData{BasisTotal},
$::s_sDeliveryCountryCode,
$::g_ShipContact{'POSTALCODE'},
$::g_LocationInfo{DELIVERRESIDENTIAL} ne '' ? 1 : 0
);
if($::s_Ship_nSSPProviderID == 1)
{
if(!$bSSPError)
{
$::s_Ship_bDisplayExtraCartInformation = $::TRUE;
}
}
}
return($::SUCCESS, undef); # It succeeded
}
#######################################################
#
# IsFinalPhaseHidden - is the final shipping phase
# hidden. Yes if there is only one payment option
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub IsFinalPhaseHidden
{
#
# Simple mode
#
if ($ShippingBasis eq 'Simple') # we are in simple mode
{
return($::SUCCESS, undef); # default visible
}
#
# Hide the phase if there's less than 1 options
#
if ((@::s_arrSortedShippingHashes < 1) ||
(scalar @::s_Ship_sShipProducts == 0))
{
$::s_Ship_bShipPhaseIsHidden = $::TRUE; # hide the pointless phase
}
return($::SUCCESS, undef); # default visible
}
#######################################################
#
# GetShippingDescription - retrieve the description
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub GetShippingDescription
{
if(defined $::s_hashShipData{ShippingLabel}) # if we have a label defined
{
$::s_Ship_sShippingDescription =
$::s_hashShipData{ShippingLabel}; # use it
}
else
{
$::s_Ship_sShippingDescription = ''; # empty string
}
return($::SUCCESS, undef);
}
#######################################################
#
# CalculateHandling - calculate the handling value
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub CalculateHandling
{
#
# handling charges are simply a flat value plus a percentage of the shipping charge. Since Actinic stores
# 2 decimal percentages as ints, the actual percentage value is the number / 100 (for decimals) / 100 (for percent)
#
$::s_Ship_nHandlingCharges = $nHandlingCharge + int (GetTaxExclusiveShipping() * $nHandlingProportion / $ActinicOrder::PERCENTOFFSET);
#
# Add the handling supplements
#
$::s_Ship_nHandlingCharges += $::dHandlingSupplements;
#
# store the current handling value in our opaque data for future reference
#
$::s_Ship_sOpaqueHandleData = sprintf("Handling;%d;", $::s_Ship_nHandlingCharges);
return ($::SUCCESS, undef);
}
#######################################################
#
# GetTaxExclusiveShipping - Get tax exclusive shipping
#
# Returns: 0 - tax inclusive shipping
#
#######################################################
sub GetTaxExclusiveShipping
{
my ($phashShipping, $phashSelected);
$phashSelected = undef;
foreach $phashShipping (@::s_arrSortedShippingHashes) # for each valid selection
{
if($$phashShipping{ShippingClass} eq $::s_hashShipData{ShippingClass}) # is this our selected class
{
$phashSelected = $phashShipping; # save selection
last;
}
}
if(!defined $phashSelected && # if we didn't find our selection
@::s_arrSortedShippingHashes > 0) # and there are valid options
{
$phashSelected = $::s_arrSortedShippingHashes[0]; # select the cheapest
}
if (defined $phashSelected) # if we have a selection
{
%::s_hashShipData = %$phashSelected; # store to our working hash
$::s_Ship_nShipCharges = $$phashSelected{Cost};
}
# if (!$bPricesIncludesTax || $::s_Ship_nShipCharges == 0)
# {
# return ($::s_Ship_nShipCharges);
# }
# return ($::s_Ship_nShipCharges / $dTaxInclusiveMultiplier);
return ($::s_Ship_nShipCharges);
}
#------------------------------------------------------
#
# End of high-level functions
#
#------------------------------------------------------
#------------------------------------------------------
#
# SimpleXXX functions
#
#------------------------------------------------------
#######################################################
#
# SimpleValidateFinalInput - Validate the simple shipping
# final user selection and return the shipping
# selection in an opaque string
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub SimpleValidateFinalInput
{
my (@Response);
if(!defined $::g_InputHash{SHIPPING})
{
return($::SUCCESS, undef);
}
if ($::g_InputHash{SHIPPING})
{
$::g_InputHash{SHIPPING} =~ s/^\s*(.*?)\s*$/$1/gs;
}
#
# If the user has been presented with the edit control, we preserve the input intact
# until it has been validated. We mark this as user input in the opaque data
# by prepending 'Error-'.
#
if (defined $::g_InputHash{SHIPPING}) # if the shipping is defined, store its value
{
my $sText = (0 == length $::g_InputHash{SHIPPING}) ? ' ' : $::g_InputHash{SHIPPING};
$::s_Ship_sOpaqueShipData = sprintf("Simple;Error-%s;", $sText); # get the user value
}
if (!defined $::g_InputHash{'SHIPPING'} ||# if the shipping is undefined, error out
length $::g_InputHash{'SHIPPING'} == 0)
{
return($::FAILURE, $$pMessageList[8]);
}
@Response = ActinicOrder::ReadPrice($::g_InputHash{SHIPPING}, \%::s_Ship_PriceFormatBlob); # make sure the price is readable
if ($Response[0] != $::SUCCESS || # if the price is not readable, or
$Response[2] != int $Response[2]) # it is fractional
{
#
# format an example price
#
@Response = ActinicOrder::FormatSinglePrice(10000, $::FALSE, \%::s_Ship_PriceFormatBlob);
if ($Response[0] != $::SUCCESS)
{
return($Response[0], $Response[1]);
}
return($::FAILURE, sprintf($$pMessageList[0], $Response[2]));
}
my ($nMaxShipping) = 99999999;
if ($Response[2] >= $nMaxShipping) # if the shipping is too big, display error
{
#
# format the max price
#
@Response = ActinicOrder::FormatPrice($nMaxShipping, $::TRUE, \%::s_Ship_PriceFormatBlob);
if ($Response[0] != $::SUCCESS)
{
return($Response[0], $Response[1]);
}
return($::FAILURE, sprintf($$pMessageList[1], $Response[2]));
}
my ($nMinShipping) = 0;
if ($Response[2] < $nMinShipping) # if the shipping is too small, display error
{
#
# format the min price
#
@Response = ActinicOrder::FormatPrice($nMinShipping, $::TRUE, \%::s_Ship_PriceFormatBlob);
if ($Response[0] != $::SUCCESS)
{
return($Response[0], $Response[1]);
}
return($::FAILURE, sprintf($$pMessageList[2], $Response[2]));
}
#
# the user input must be OK so now we convert the opaque data into internal format
#
if (defined $::g_InputHash{SHIPPING}) # if the shipping is defined, store its value
{
$::s_Ship_sOpaqueShipData = sprintf("Simple;%s;", $Response[2]); # get the user value
if ($bPricesIncludesTax)
{
$::s_Ship_sOpaqueShipData .= sprintf('TaxApplies;%d;', $::s_sShip_bLocationTaxable);
}
OpaqueToHash();
}
return($::SUCCESS, undef);
}
#######################################################
#
# SimpleRestoreFinalUI - generate a hash of substitution values
# The keys in the hash are strings in the shipping
# HTML that need to be replaced with the corresponding
# value. This function processes the final shipping UI.
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub SimpleRestoreFinalUI
{
my (@Response);
$::s_Ship_nShipOptions = -1; # -1 is used to indicate simple shipping mode
#
# Substitute the currency sign
#
my $ePosOrder = $::s_Ship_PriceFormatBlob{"ICURRENCY"};
if ($ePosOrder == 0)
{
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL1"} = $::s_Ship_PriceFormatBlob{"SCURRENCY"};
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL2"} = '';
}
elsif ($ePosOrder == 1)
{
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL1"} = '';
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL2"} = $::s_Ship_PriceFormatBlob{"SCURRENCY"};
}
elsif ($ePosOrder == 2)
{
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL1"} = $::s_Ship_PriceFormatBlob{"SCURRENCY"} . ' ';
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL2"} = '';
}
elsif ($ePosOrder == 3)
{
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL1"} = '';
$::s_Ship_ShippingVariables{"NETQUOTEVAR:CURRENCYSYMBOL2"} = $::s_Ship_PriceFormatBlob{"SCURRENCY"} . ' ';
}
#
# Substitute the price
#
if (!defined $::s_hashShipData{'Simple'}) # shipping is still undefined
{
#
# Format the default price. This needs to be done because the default is stored in
# Actinic internal format.
#
@Response = ActinicOrder::FormatSinglePrice($SimpleCost, $::FALSE, \%::s_Ship_PriceFormatBlob);
if ($Response[0] != $::SUCCESS)
{
return($Response[0], $Response[1]);
}
$::s_Ship_ShippingVariables{"NETQUOTEVAR:SHIPPINGVALUE"} = $Response[2];
$::s_hashShipData{'Simple'} = $SimpleCost;
$::s_Ship_sOpaqueShipData = sprintf("Simple;%s;", $SimpleCost); # get the user value
if ($bPricesIncludesTax)
{
$::s_Ship_sOpaqueShipData .= sprintf('TaxApplies;%d;', $::s_sShip_bLocationTaxable);
}
}
elsif($::s_hashShipData{'Simple'} =~ /Error-/) # there is an error in simple shipping
{
#
# no need to format the user input since it was formatted when the entered it
#
$::s_hashShipData{'Simple'} =~ s/^Error-\s*(.*?)\s*$/$1/g;
$::s_Ship_ShippingVariables{"NETQUOTEVAR:SHIPPINGVALUE"} = $::s_hashShipData{'Simple'};
}
else # shipping is already defined
{
#
# Valid opaque data is in Actinic format so format it as currency
#
$::s_hashShipData{'Simple'} =~ s/^\s*(.*?)\s*$/$1/g;
@Response = ActinicOrder::FormatSinglePrice($::s_hashShipData{'Simple'}, $::FALSE, \%::s_Ship_PriceFormatBlob);
if ($Response[0] != $::SUCCESS)
{
return($Response[0], $Response[1]);
}
$::s_Ship_ShippingVariables{"NETQUOTEVAR:SHIPPINGVALUE"} = $Response[2];
}
if ($bPricesIncludesTax)
{
$::s_Ship_bTaxAppliesToShipping = ActinicOrder::IsTaxApplicableForLocation('TAX_1');
}
else
{
$::s_Ship_bTaxAppliesToShipping = $::TRUE;
}
return($::SUCCESS, undef);
}
#######################################################
#
# SimpleCalculateShipping
# Get the possible zones for this country and region
# There may be more than one possible zone and we can
# select the shipping band based on the class of shipping.
#
# Returns: 0 - status
# 1 - message (if any)
#
#######################################################
sub SimpleCalculateShipping
{
#
# For simple shipping, we just apply the single value
#
if (!defined $::s_hashShipData{'Simple'} || # shipping is still undefined
$::s_hashShipData{'Simple'} =~ /Error-/) # or there was an error
{
#
# Note that if the shipping is undefined we don't use the default value. Instead we
# return "0" which results in the shipping fields being hidden in the shopping cart summary.
#
$::s_Ship_nShipCharges = 0;
}
else # shipping is already defined
{
$::s_Ship_nShipCharges = $::s_hashShipData{'Simple'};
}
return($::SUCCESS, undef);
}
#------------------------------------------------------
#
# End of SimpleXXX functions
#
#------------------------------------------------------
#------------------------------------------------------
#
# Low-level functions
#
#------------------------------------------------------
################################################################
#
# CalculateQuantity - get the total number of products
#
# Expects: $::s_Ship_nTotalQuantity - the number of non-component items
#
# Returns: Total quantity
#
################################################################
sub CalculateQuantity
{
#? ACTINIC::ASSERT((defined $::s_Ship_nTotalQuantity), '$::s_Ship_nTotalQuantity not defined', __LINE__, __FILE__);
#
# Return the total quantity
#
return($::s_Ship_nTotalQuantity);
}
################################################################
#
# CalculateAdjustedQuantity - Get the total number of products taking into account
# shipping quantities and whether the product is excluded
#
# Returns: Total quantity
#
################################################################
sub CalculateAdjustedQuantity
{
if (defined $::s_Ship_nAdjustedTotalQuantity) # if we have already calculated this
{
return ($::s_Ship_nAdjustedTotalQuantity); # return it
}
$::s_Ship_nAdjustedTotalQuantity = 0; # clear quantity
$::s_Ship_nNonExcludedCount = 0; # clear quantity
my $i;
for $i (0 .. $#::s_Ship_sShipProducts)
{
if($::s_Ship_sShipProducts[$i] =~ /_/) # filter out components with no associated products
{
next;
}
if ($::s_Ship_nExcludeFromShipping[$i] == 1) # skip if excluded from shipping
{
next;
}
if ($::s_Ship_bProduct == 0 &&
$::s_Ship_bUseAssociatedShip[$i] == 0) # skip if we aren't using associated product shipping
{
next;
}
$::s_Ship_nNonExcludedCount++; # increment non excluded count
$::s_Ship_nAdjustedTotalQuantity +=
($::s_Ship_nShipShipQuantities[$i] *
$::s_Ship_nShipQuantities[$i]); # add line quantity * shipping quantity
}
return($::s_Ship_nAdjustedTotalQuantity);
}
################################################################
#
# CalculatePrice - get the total price of products
#
# Expects: @::s_Ship_sShipProducts - List of product IDs
# @::s_Ship_nShipQuantities - List of quantities (to match ProductIDs)
# @::s_Ship_nShipPrices - List of prices (to match ProductIDs)
#
# Returns: Total price of goods
#
################################################################
sub CalculatePrice
{
my $j;
if (defined $::s_Ship_nTotalPrice)
{
return ($::s_Ship_nTotalPrice);
}
if (defined $::s_Ship_nSubTotal)
{
return ($::s_Ship_nSubTotal);
}
$::s_Ship_nTotalPrice = 0;
for $j (0 .. $#::s_Ship_sShipProducts)
{
$::s_Ship_nTotalPrice += ($::s_Ship_nShipPrices[$j] * $::s_Ship_nShipQuantities[$j]); # Add units * price
}
return($::s_Ship_nTotalPrice);
}
#######################################################
#
# GetBands - retrieve the band for this region
#
# Returns: 0+ - band list
#
#######################################################
sub GetBands
{
if ($::s_sDeliveryRegionCode eq "" || # if the state is undefined
$::s_sDeliveryRegionCode eq $UNDEFINED)
{
if ($#{$ParentZoneTable{$::s_sDeliveryCountryCode}} != -1) # if this parent zone table has any entries
{
return (@{$ParentZoneTable{$::s_sDeliveryCountryCode}}); # return this list (has invalid entries stripped)
}
}
#
# If we have a zone hash entry for the delivery country
#
if(defined $ZoneTable{$::s_sDeliveryCountryCode})
{
#
# See if there is an entry for the region code as it is
#
if(defined $ZoneTable{$::s_sDeliveryCountryCode}{$::s_sDeliveryRegionCode})
{
return(@{ $ZoneTable{$::s_sDeliveryCountryCode}{$::s_sDeliveryRegionCode} });
}
#
# It failed so let's see if the location is a sub-district and try
# the parent state/province
#
my $sParentState = ActinicLocations::GetDeliveryParentRegionCode();
if($sParentState ne '' && # if we have something
$sParentState ne $::s_sDeliveryRegionCode && # and it's different from the original code
defined $ZoneTable{$::s_sDeliveryCountryCode}{$sParentState}) # and there's an entry for it
{
return(@{ $ZoneTable{$::s_sDeliveryCountryCode}{$sParentState} }); # return the bands
}
#
# See if there is an entry for the country code with an undefined region
#
if(defined $ZoneTable{$::s_sDeliveryCountryCode}{$UNDEFINED})
{
return(@{ $ZoneTable{$::s_sDeliveryCountryCode}{$UNDEFINED} });
}
}
#
# Return an empty list
#
my @listEmpty = ();
return(@listEmpty);
}
#######################################################
#
# GetSSPProviderList - Get the list of SSP providers for this country
#
# Input: $sCountryCode - country code
#
# Returns: 0 - list of providers
#
#######################################################
sub GetSSPProviderList
{
my ($sCountryCode) = @_;
my @arrReturn;
#
# If we have supported regions and the delivery country is supported
# get the list of providers
#
if(defined $$::g_pSSPSetupBlob{SupportedRegions} &&
defined $$::g_pSSPSetupBlob{SupportedRegions}{$sCountryCode})
{
my $nProviderID;
foreach $nProviderID ($$::g_pSSPSetupBlob{SupportedRegions}{$sCountryCode})
{
push(@arrReturn, $nProviderID);
}
}
return (\@arrReturn);
}
#######################################################
#
# GetUS5DigitZipCode - Returns a 5 digit zip code or an
# error if format un-recognised
#
# Input: $sZipCode - zip code
#
# Returns: 0 - $::SUCCESS or $::FAILURE
# 1 - error message
# 2 - 5 digit zip code
#
#######################################################
sub GetUS5DigitZipCode
{
my ($sZipCode) = @_;
#
# Check the US and Puerto Rico zip code is in a sensible format
#
if($sZipCode !~ /^\d{5}$/ &&
$sZipCode !~ /^\d{5}-\d{4}$/ &&
$sZipCode !~ /^\d{9}$/)
{
#
# Tell buyer about US and PR zip format
#
return($::FAILURE, ACTINIC::GetPhrase(-1, 2150));
}
#
# Use the first 5 digits of the zip code
#
$sZipCode = substr($sZipCode, 0, 5);
return($::SUCCESS, '', $sZipCode);
}
################################################################
#
# CalculatePackageShipping - calculate the cost of a single package
# for a given zone and class
#
# Input: $nZoneID - the zone ID
# $nClassID - the class ID
# $objBasis - the basis for the calculation
# $nCalculationBasis - calculation basis
#
# Returns: 1 - $::TRUE if we calculated a cost, $::FALSE if failed
# 2 - the cost of the package
#
# Author: Mike Purnell
#
################################################################
sub CalculatePackageShipping
{
my ($nZoneID, $nClassID, $objBasis, $nCalculationBasis) = @_;
if ($nCalculationBasis == $c_nPerItemShipping)
{
return (CalculatePerItemShipping($nZoneID, $nClassID, $objBasis));
}
#
# Set up our initial values
#
my $nCost = 0;
my $bWeightOK = $::TRUE;
my $dMaxWeight = 0.0;
my $nHighestCost = 0;
my $sCostKey = 'cost';
#
# The ShippingTable entry for {class}{zone} is an array of hashes. The first
# entry defines the excess action, the rest are {wt},{cost} entries
# in ascending order
#
my $parrBandEntries = $ShippingTable{$nClassID}{$nZoneID};
my $nEntryCount = @$parrBandEntries; # get the number of entries in the array
my $phashBandEntry;
#
# Get the values for the maximum weight defined
#
if($nEntryCount > 1) # any wt/cost entries?
{
$phashBandEntry = $$parrBandEntries[$nEntryCount - 1]; # get the highest weight entry
$dMaxWeight = $$phashBandEntry{wt}; # store the max weight
if (defined $phashBandEntry->{'costIncTax'})
{
$sCostKey = 'costIncTax';
}
$nHighestCost = $$phashBandEntry{$sCostKey}; # and the cost for max weight
}
#
# Check the maximum weight defined against our package weight
#
if($objBasis > $dMaxWeight) # exceeded max weight defined?
{
my $phashExcessAction = $$parrBandEntries[0]; # get the excess action hash
if($$phashExcessAction{ExcessAction} eq 'Highest') # use the highest value?
{
$nCost = $nHighestCost;
}
elsif($$phashExcessAction{ExcessAction} eq 'AddFurther') # add increment?
{
my $dExtraWeight = $objBasis - $dMaxWeight; # get the excess weight
my $sCostSuffix = defined $phashExcessAction->{'IncrementalChargeIncTax'} ?
'IncTax' : '';
my ($dWeightIncrement, $nChargeIncrement) =
($$phashExcessAction{'IncrementalWeight'},
$$phashExcessAction{'IncrementalCharge' . $sCostSuffix}); # get the increment and incremental charge
my $nExtraUnits = int ($dExtraWeight / $dWeightIncrement + 0.999); # round up the number of incremental units
$nCost = $nHighestCost + # cost is highest +
($nExtraUnits * $nChargeIncrement); # extra units * incremental charge
}
elsif($$phashExcessAction{ExcessAction} eq 'Error') # error out?
{
$bWeightOK = $::FALSE; # we failed to get a cost for this weight
}
}
else # our weight is in the band table
{
my $i;
for($i = 1; $i < $nEntryCount; $i++) # go through the wt/cost entries in ascending order
{
$phashBandEntry = $$parrBandEntries[$i]; # get the wt/cost hash reference
if($$phashBandEntry{wt} >= $objBasis) # inside the weight?
{
$nCost = $$phashBandEntry{$sCostKey}; # found our cost
last;
}
}
}
return($bWeightOK, $nCost);
}
################################################################
#
# GetPerItemQuantities - Get the per item shipping quantities
#
# Input: $phashCategoryQuantities - reference to has to populate
#
# Author: Mike Purnell
#
################################################################
sub GetPerItemQuantities
{
my ($phashCategoryQuantities) = @_;
my $i;
for $i (0 .. $#::s_Ship_sShipProducts) # for each product
{
if($::s_Ship_sShipProducts[$i] =~ /_/) # filter out components with no associated products
{
next;
}
if ($::s_Ship_nExcludeFromShipping[$i] == 1) # skip if excluded from shipping
{
next;
}
if ($::s_Ship_bUseAssociatedShip[$i] == 0) # skip if we aren't using associated product shipping
{
next;
}
my $sCategory = $::s_Ship_sShipCategories[$i]; # get category
if (!defined $phashDefinedCategories->{$sCategory}) # if category is unknown
{
$sCategory = $sDefaultCategory; # use default category
}
#
# Quantity is line quantity * item shipping quantity
#
my $nTotalQuantity =
$::s_Ship_nShipQuantities[$i] * $::s_Ship_nShipShipQuantities[$i];
#
# Add to the hash
#
if (defined $phashCategoryQuantities->{$sCategory})
{
$phashCategoryQuantities->{$sCategory} += $nTotalQuantity;
}
else
{
$phashCategoryQuantities->{$sCategory} = $nTotalQuantity;
}
}
}
################################################################
#
# CalculateSupplements - Calculate the supplements for the order
#
# Input: $phashCategoryQuantities - reference to has to populate
#
# Author: Mike Purnell
#
################################################################
sub CalculateSupplements
{
my %hashShippingSupplementApplied;
my %hashHandlingSupplementApplied;
my $i;
for $i (0 .. $#::s_Ship_sShipProducts) # for each product
{
if ($::s_Ship_sShipProducts[$i] =~ /_/) # filter out components with no associated products
{
next;
}
if ($::s_Ship_bProduct[$i] || # if this is a product
($::s_Ship_bUseAssociatedShip[$i] == 1)) # or component using associated product shipping
{
#
# Add the shipping supplement for this item line
#
my $nQuantity = $::s_Ship_nShipQuantities[$i]; # get the quantity
if ($::s_Ship_dShipSupplementOnce[$i] == 1)
{
if (defined $hashShippingSupplementApplied{$::s_Ship_sShipProducts[$i]})
{
$nQuantity = 0;
}
else
{
$hashShippingSupplementApplied{$::s_Ship_sShipProducts[$i]} = 1;
$nQuantity = 1;
}
}
$::dShippingSupplements += $nQuantity * $::s_Ship_dShipSupplements[$i];
#
# Add the handling supplement for this item line
#
$nQuantity = $::s_Ship_nShipQuantities[$i]; # get the quantity
if ($::s_Ship_dHandSupplementOnce[$i] == 1)
{
if (defined $hashHandlingSupplementApplied{$::s_Ship_sShipProducts[$i]})
{
$nQuantity = 0;
}
else
{
$hashHandlingSupplementApplied{$::s_Ship_sShipProducts[$i]} = 1;
$nQuantity = 1;
}
}
$::dHandlingSupplements += $nQuantity * $::s_Ship_dHandSupplements[$i];
}
}
}
################################################################
#
# CalculatePerItemShipping - Calculate the per item shipping
#
# Input: $nZoneID - List of product IDs
# $nClassID - List of quantities (to match ProductIDs)
# $phashCategoryQuantities - product opaque data table
#
# Returns: 0 - $::TRUE always
# 1 - per item shipping
#
# Author: Mike Purnell
#
################################################################
sub CalculatePerItemShipping
{
my ($nZoneID, $nClassID, $phashCategoryQuantities) = @_;
my $nMaxFixedCost = 0; # clear maximum fixed cost
my $dPerItemCharges = 0; # clear per item charges
my $parrBandEntries = $ShippingTable{$nClassID}{$nZoneID}; # get band array for zone and class
my $phashZoneClassPerItemCharges = $parrBandEntries->[1]; # get hash of category charges for zone/class
my $sKeySuffix = '';
if ($bPricesIncludesTax && # if we're in tax-inclusive mode
$parrBandEntries->[0]->{'TaxAppliesToShipping'} && # and tax applies to shipping
!$parrBandEntries->[0]->{'ShippingCostsIncludeTax'}) # and tax is included in shipping
{
$sKeySuffix = 'IncTax';
}
my $sCategory;
foreach $sCategory (keys %$phashCategoryQuantities) # for each category ordered
{
my $phashCategory = $phashZoneClassPerItemCharges->{$sCategory}; # get category charges
if ($phashCategory->{'Fixed' . $sKeySuffix} > $nMaxFixedCost) # if fixed charge bigger than max
{
$nMaxFixedCost = $phashCategory->{'Fixed' . $sKeySuffix}; # save new max
}
my $nQuantity = $phashCategoryQuantities->{$sCategory}; # get category quantity
$dPerItemCharges += $phashCategory->{'PerItem' . $sKeySuffix} * $nQuantity; # add per item charges
}
return ($::TRUE, $nMaxFixedCost + $dPerItemCharges); # return total cost
}
################################################################
#
# CalculateMultiPackageShipping - Calculate multi-package shipping
#
# Expects: @::s_Ship_sShipProducts - List of product IDs
# @::s_Ship_nShipQuantities - List of quantities (to match ProductIDs)
# %::s_Ship_OpaqueDataTables - product opaque data table
# $::s_Ship_nShipSeparately - list of ship separately flags
#
# Returns: 0 - status
# 1 - error message or ''
# 2 - reference to array of single item parcels
# 3 - reference to array of mixed item parcels
#
# Author: Mike Purnell
#
################################################################
sub CalculateMultiPackageShipping
{
my $dWeightRemainder = 0.0;
my $bNonSeparateShipFound = $::FALSE;
my ($i);
my $dWeight;
my @arrShippingHashes;
#
# Get the valid zone/class combinations for our location
#
my $parrZonesClasses = GetZoneClassCombinations();
my $pProviderList = GetSSPProviderList($::s_sDeliveryCountryCode);
#
# Handle no valid zone/class combinations and no valid SSP Providers for our location
#
if(@$parrZonesClasses == 0 &&
@$pProviderList == 0)
{
return(SetDefaultCharge());
}
CalculateAdjustedQuantity(); # make sure totals are in place
CalculateSupplements(); # calculate the shipping and handling supplements
#
# Split the zone/classes by calculation basis adding any free classes to our array of valid hashes
#
my %hashCalculationBases = {};
GetZoneClassesByBasis(\%hashCalculationBases, $parrZonesClasses, \@arrShippingHashes);
my $nCalculationBasis;
foreach $nCalculationBasis (keys %hashCalculationBases) # for each calculation basis
{
my $parrBasisZoneClasses =
$hashCalculationBases{$nCalculationBasis}; # get zone/classes for this basis
my $parrZoneClass;
foreach $parrZoneClass (@$parrBasisZoneClasses) # go through all zone/class combinations for this basis
{
CalculateZoneClassShipping($nCalculationBasis,
$parrZoneClass, \@arrShippingHashes); # add any zone/classes to our hash array
}
}
#
# Now handle SSPs if required
#
if (@$pProviderList > 0)
{
my ($phashWeightToQuantity, $parrSortedWeightKeys, $sWeightList,
$parrShipSeparatePackages, $parrMixedPackages, $sOptimalWeight)
= DivideIntoPackages($c_nWeight, undef); # split into packages
#
# Calculate the sum of weights for further evaluation
#
my $dSumOfWeights = 0.0; # shows the sum of weights of all the packages
foreach $dWeight (@$parrSortedWeightKeys) # go through our sorted weights
{
$dSumOfWeights += $$phashWeightToQuantity{$dWeight} * $dWeight; # add the weight of each package to the sum
}
#
# Add SSP calculations
#
my $nProviderID;
foreach $nProviderID (@$pProviderList)
{
#
# Get weight limit information
#
my $bWeightThresholdExceeded = IsWeightThresholdExceeded($nProviderID, $dSumOfWeights); # determine whether there is a weight limit defined and whether the total weight exceeded that or not
#
# Do the rate calculation if possible
#
if($::g_pSSPSetupBlob &&
$$::g_pSSPSetupBlob{$nProviderID}{'RSSEnabled'} &&
$bWeightThresholdExceeded == $::FALSE) # do the calculation only if we allow UPS classes
{
my ($nReturnCode, $sSSPError, $parrShippingHashes, $nRateType) = GetUPSRates();
$hSSPUsed{$nRateType} = $::TRUE;
if($nReturnCode != $::SUCCESS)
{
return($nReturnCode, $sSSPError);
}
else
{
push @arrShippingHashes, @$parrShippingHashes;
}
}
}
}
#
# Handle no valid zone/class combinations and no valid SSP classes (e.g. due to overweight) for our location
# See cix:actinic_catlog/bugs_details9:3012
#
if(@$parrZonesClasses == 0 &&
@arrShippingHashes == 0)
{
return(SetDefaultCharge());
}
#
# If we don't have any valid classes, at least one package must exceed
# the limit for all classes
#
if (@arrShippingHashes == 0 &&
scalar @::s_Ship_sShipProducts != 0)
{
return ($::FAILURE, $$pMessageList[7]); # tell the user a package is overweight
}
#
# ACTINIC CUSTOMISE: Sort the shipping options
#
# If you would like to change the order in which shipping options are presented in the shipping
# drop-down, comment out the line starting '@::s_arrSortedShippingHashes' and uncomment the
# appropriate line
#
# Store the hashes in ascending order of total cost
#
@arrShippingHashes = sort{$$a{Cost} <=> $$b{Cost}} @arrShippingHashes;
#
# Store the hashes in descending order of total cost
#
# @arrShippingHashes = sort{$$b{Cost} <=> $$a{Cost}} @arrShippingHashes;
#
# Store the hashes in ascending alphabetical order
#
# @arrShippingHashes = sort{$$a{ShippingLabel} cmp $$b{ShippingLabel}} @arrShippingHashes;
#
# Store the hashes in descending alphabetical order
#
# @arrShippingHashes = sort{$$b{ShippingLabel} cmp $$a{ShippingLabel}} @arrShippingHashes;
#
# Now handle putting any classes marked as last at the end
#
my @arrLastClasses;
my $phashClass;
foreach $phashClass (@arrShippingHashes) # go through our hashes
{
my $bLastClass = 0; # assume it isn't a last class
my $nClassID = $phashClass->{'ShippingClass'}; # get class ID
if (defined $ClassTable{$nClassID}) # if it's a valid class ID
{
$bLastClass = $ClassTable{$nClassID}->[1]; # get last class setting
}
if ($bLastClass) # if this should go at end
{
push @arrLastClasses, $phashClass; # add to last class array
}
else
{
push @::s_arrSortedShippingHashes, $phashClass; # add to static sorted hash array
}
}
push @::s_arrSortedShippingHashes, @arrLastClasses; # add any last classes to the sorted hash array
return($::SUCCESS, '');
}
################################################################
#
# CalculateZoneClassShipping - Calculate shipping for a zone/class combination
#
# Input: $nCalculationBasis - calculation basis
# $parrZonesClass - ref to array of zone/class IDs
# $parrShippingHashes - ref to array of handled zone classes
#
################################################################
sub CalculateZoneClassShipping
{
my ($nCalculationBasis, $parrZoneClass, $parrShippingHashes) = @_;
my ($phashWeightToQuantity, $parrSortedWeightKeys, $sWeightList,
$parrShipSeparatePackages, $parrMixedPackages, $sOptimalWeight)
= DivideIntoPackages($nCalculationBasis, $parrZoneClass); # split into packages
my $nTotalCost = 0; # no cost yet
my ($nZoneID, $nClassID) = @$parrZoneClass; # split into zone and class
my ($bBasisOK, $nPackageCost);
$bBasisOK = $::TRUE;
my $dBasisTotal = 0;
my $dBasis;
foreach $dBasis (@$parrSortedWeightKeys) # go through our sorted weights
{
($bBasisOK, $nPackageCost) =
CalculatePackageShipping($nZoneID, $nClassID,
$dBasis, $nCalculationBasis); # calculate the cost for this basis
if ($bBasisOK) # the basis was OK?
{
$nTotalCost +=
$$phashWeightToQuantity{$dBasis} * $nPackageCost; # add quantity * cost to total
my $sKey = sprintf('%0.03f', $dBasis); # format basis key
$::s_hashClassToWeightCost{$nClassID}{$sKey} = $nPackageCost; # save package cost
$dBasisTotal += $dBasis; # add to total basis
}
else # basis was too big
{
last; # no point going on
}
}
if ($bBasisOK) # if all bases were valid for this zone/class
{
if ($::s_Ship_nNonExcludedCount == 0 &&
$dBasisTotal == 0)
{
$nTotalCost = 0.0;
}
my $nCost = ActinicOrder::RoundScientific($nTotalCost + $::dShippingSupplements);
my $phashBandDefinition = GetBandDefinition(@$parrZoneClass); # get the band definition hash
if (defined $phashBandDefinition->{'FreeOver'} && # if we have a zone/class free over defined
CalculatePrice() > $phashBandDefinition->{'FreeOver'}) # and the order cost exceeds it
{
$nCost = 0;
}
push @$parrShippingHashes, {
'ShippingLabel' => $ClassTable{$nClassID}[0],
'ShippingClass' => $nClassID,
'ShippingZone' => $nZoneID,
'Cost' => $nCost,
'BasisTotal' => $dBasis,
'ShipSeparatePackages' => $parrShipSeparatePackages,
'MixedPackages' => $parrMixedPackages,
'OptimalWeight' => $sOptimalWeight,
'TaxAppliesToShipping' => $phashBandDefinition->{'TaxAppliesToShipping'},
'ShippingCostsIncludeTax' => $phashBandDefinition->{'ShippingCostsIncludeTax'}
}; # add the zone/class to our shipping hashes
}
}
################################################################
#
# GetZoneClassesByBasis - Get zone/class combinations hashed by calculation basis
#
# Input: $phashCalculationBases - ref to hash to populate
# $parrZonesClasses - ref to array of all zone/classes
# $parrShippingHashes - ref to array of handled zone classes
#
# Returns: true if any calculation bases require shipping calculated
#
################################################################
sub GetZoneClassesByBasis
{
my ($phashCalculationBases, $parrZonesClasses, $parrShippingHashes) = @_;
my $parrZoneClass;
foreach $parrZoneClass (@$parrZonesClasses) # go through all zone/class combinations
{
my ($nZoneID, $nClassID) = @$parrZoneClass; # split into zone and class
my $phashBandDefinition = GetBandDefinition(@$parrZoneClass); # get the band definition hash
if (defined $phashBandDefinition->{'FreeClass'}) # if this is a free class
{
push @$parrShippingHashes, {
'ShippingLabel' => $ClassTable{$nClassID}[0],
'ShippingClass' => $nClassID,
'ShippingZone' => $nZoneID,
'Cost' => 0,
'BasisTotal' => 0
}; # add a zero cost hash
}
else
{
my $nCalculationBasis = $phashBandDefinition->{'CalculationBasis'}; # get calculation basis
if (!defined $phashCalculationBases->{$nCalculationBasis}) # if this is a new basis
{
$phashCalculationBases->{$nCalculationBasis} = []; # add an empty array
}
my $parrBasisZoneClasses = $phashCalculationBases->{$nCalculationBasis}; # get ref to array of zone classes
push @$parrBasisZoneClasses, $parrZoneClass; # add this zone class
}
}
return (scalar(keys %$phashCalculationBases) > 0); # return whether we have any bases to calculate
}
################################################################
#
# GetBandDefinition - Gets the band definition for a zone/class
#
# Input: $nZoneID - Zone ID
# $nClassID - Class ID
#
# Returns: $phashBandDefinition - ref to band definition hash
#
################################################################
sub GetBandDefinition
{
my ($nZoneID, $nClassID) = @_;
my $parrBandEntries = $ShippingTable{$nClassID}{$nZoneID}; # get band entry
my $phashBandDefinition = $$parrBandEntries[0]; # get the band definition hash
return ($phashBandDefinition);
}
################################################################
#
# IsWeightThresholdExceeded - Get weight threshold value from the catalog blob if defined
#
# Expects: $::g_pCatalogBlob - Catalog blob
#
# Input: $nProviderID - ID of the provider whose classes to be added to the list
# $dSumOfWeights - sum of weight of all the packages
#
# Returns: 0 - a bool value which specifies if a given threshold value is exceeded or not
#
# Author: Tibor Vajda
#
################################################################
sub IsWeightThresholdExceeded
{
my $nProviderID = shift; # get the first parameter
my $dSumOfWeights = shift; # get the second parameter
#
# Init variables
#
my $bWeightThresholdExceeded = $::FALSE; # shows whether there is a threshold defined and this is lower than the sum of package weights
#
# Do anything only if there is a threshold defined
#
if($::g_pSSPSetupBlob &&
$$::g_pSSPSetupBlob{$nProviderID}{'WEIGHTTHRESHOLD'}) # check if WEIGHTTHRESHOLD is defined for this provider
{
#
# Get the threshold value from the catalog blob
#
my $dWeightThreshold = $$::g_pSSPSetupBlob{$nProviderID}{'WEIGHTTHRESHOLD'}; # get the weight threshold from the SSPSetup blob
#
# Check if the value is right
#
if (($dWeightThreshold ne '') && # the threshold is not empty
($dWeightThreshold =~ /^[+]?[\d]*(\.[\d]+)?$/)) # and it is a positive real number
{
#
# Check if this order is above the limit - mind if it is
#
if ($dWeightThreshold < $dSumOfWeights) # if the packages exceeded the threshold weight then don't supply UPS classes
{
$bWeightThresholdExceeded = $::TRUE;
}
}
}
#
# Pass back the result
#
return $bWeightThresholdExceeded;
}
################################################################
#
# DivideIntoPackages - Divide the order into packages
#
# Expects: @::s_Ship_sShipProducts - List of product IDs
# @::s_Ship_nShipQuantities - List of quantities (to match ProductIDs)
# %::s_Ship_OpaqueDataTables - product opaque data table
# $::s_Ship_nShipSeparately - list of ship separately flags
#
# Input: $nCalculationBasis - calculation basis
# $parrZoneClass - ref to array of zone and class ID
# $bUseIntegralWeights - whether to use integral weights (optional)
#
# Returns: 0 - reference to a hash of weight to quantity
# 1 - reference to an array of sorted keys
# 2 - csv list of quantity@weight values
# 3 - reference to array of single item parcels
# 4 - reference to array of mixed item parcels
# 5 - optimal weight
#
# Author: Mike Purnell
#
################################################################
sub DivideIntoPackages
{
my ($nCalculationBasis, $parrZoneClass, $bUseIntegralWeights) = @_;
my $dWeightRemainder = 0.0;
my $nNonSeparateShipCount = 0;
my (%hashWeightToQuantity, @arrSortedWeightKeys);
my ($i);
my (@arrShipSeparatePackages, @arrMixedPackages, $parrPackage);
#
# We support multi-packaging if we're shipping by weight
#
my $nBasisTotal = -1;
if ($nCalculationBasis == $c_nQuantity)
{
$nBasisTotal = CalculateAdjustedQuantity();
}
elsif ($nCalculationBasis == $c_nPrice)
{
$nBasisTotal = CalculatePrice();
}
elsif ($nCalculationBasis == $c_nPerItemShipping)
{
$nBasisTotal = {};
GetPerItemQuantities($nBasisTotal);
}
if (ref($nBasisTotal) ne '' || $nBasisTotal != -1)
{
$hashWeightToQuantity{$nBasisTotal} = 1; # single package
#
# Now get the array of sorted keys
#
@arrSortedWeightKeys = ($nBasisTotal);
return(\%hashWeightToQuantity, \@arrSortedWeightKeys, $nBasisTotal);
}
#
# Get the divisors for the zone and class if supplied. UPS will use normal weight
# so we set the divisors to 1
#
my $dWeightDivisor = 1;
my $dAltWeightDivisor = 1;
my $sOptimalWeight = '';
if (defined $parrZoneClass) # if we have a zone and class
{
my ($nZoneID, $nClassID) = @$parrZoneClass; # split in zone and class ID
my $parrBandEntries = $ShippingTable{$nClassID}{$nZoneID};
my $phashBandDefinition = $$parrBandEntries[0]; # get the band definition hash
$dWeightDivisor = $phashBandDefinition->{'WeightFactor'}; # get weight factor
$dAltWeightDivisor = $phashBandDefinition->{'AltWeightFactor'}; # get alt weight factor
$sOptimalWeight =
$phashWeightConfiguration->{$nCalculationBasis}->{'OptimalWeight'};
}
else
{
$sOptimalWeight =
$phashWeightConfiguration->{$c_nWeight}->{'OptimalWeight'};
}
#
# Handle multi-packaging
#
my $dUnitWeight;
for $i (0 .. $#::s_Ship_sShipProducts)
{
my $sProdRef = $::s_Ship_sShipProducts[$i];
if($::s_Ship_sShipProducts[$i] =~ /_/) # filter out components with no associated products
{
next;
}
if ($::s_Ship_nExcludeFromShipping[$i] == 1) # skip if excluded from shipping
{
next;
}
#
# Get the unit weight to use for the product
#
if ($nCalculationBasis == $c_nWeight) # normal weight?
{
$dUnitWeight =
GetWeight($i, $phashWeightConfiguration, $dWeightDivisor);
}
elsif ($nCalculationBasis == $c_nAlternateWeight) # alternative weight?
{
$dUnitWeight =
GetAltWeight($i, $phashWeightConfiguration,
$dWeightDivisor, $dAltWeightDivisor);
}
elsif ($nCalculationBasis == $c_nMaximumWeight) # maximum weight?
{
$dUnitWeight =
GetMaxWeight($i, $phashWeightConfiguration,
$dWeightDivisor, $dAltWeightDivisor);
}
#
# Now decide whether to ship separately based upon the flag
# and the unit weight versus the optimal weight
#
if($::s_Ship_nShipSeparately[$i] == 1 || # this product ships separately?
($sOptimalWeight > 0 && # or we have an optimal weight?
$dUnitWeight >= $sOptimalWeight)) # and this package is greater than or equal to the optimal weight?
{
if($bUseIntegralWeights) # if we're using integral weights
{
$dUnitWeight = int($dUnitWeight + 0.9999); # round up to nearest integer
}
#
# We may already have an entry for the weight or it may be a new weight
#
$hashWeightToQuantity{$dUnitWeight} +=
$::s_Ship_nShipQuantities[$i]; # add to existing quantity
#
# Add the package details
#
my @arrTemp = ($::s_Ship_sShipProducts[$i], $::s_Ship_nShipQuantities[$i], $dUnitWeight);
push @arrShipSeparatePackages, \@arrTemp;
}
else # ship as mixed package
{
$nNonSeparateShipCount += $::s_Ship_nShipQuantities[$i]; # we have a mixed package
$dWeightRemainder +=
$dUnitWeight * $::s_Ship_nShipQuantities[$i]; # add the weight * quantity
#
# Add the details to the non-ship separate details
#
my @arrTemp = ($::s_Ship_sShipProducts[$i], $::s_Ship_nShipQuantities[$i], $dUnitWeight);
push @arrMixedPackages, \@arrTemp;
}
}
#
# Add the amalgamated weight to the hash if we found any non-separate ship packages
#
if($nNonSeparateShipCount > 0)
{
my $nQuantity = 1;
#
# If they specfied an optimal weight, split the non-separate items into
# packages
#
if($sOptimalWeight ne '' &&
$dWeightRemainder > $sOptimalWeight)
{
my $nCalculatedPackages = int(($dWeightRemainder / $sOptimalWeight) + 0.9999);
#
# If the number of calculated packages is the same as
# the number of non-ship separately items, treat all items
# as ship-separately
#
if($nCalculatedPackages == $nNonSeparateShipCount)
{
foreach $parrPackage (@arrMixedPackages) # for each package
{
$dUnitWeight = $$parrPackage[2];
if($bUseIntegralWeights) # if we're using integral weights
{
$dUnitWeight = int($dUnitWeight + 0.9999); # round up to nearest integer
}
$hashWeightToQuantity{$dUnitWeight} +=
$$parrPackage[1]; # add to weight to quantity
push @arrShipSeparatePackages, $parrPackage; # add the package details to ship separate
}
@arrMixedPackages = (); # empty the mixed packages array
}
else
{
#
# We use the minimum of the number of items and the number of calculated packages
#
$nQuantity =
($nCalculatedPackages < $nNonSeparateShipCount) ?
$nCalculatedPackages :
$nNonSeparateShipCount;
#
# Get the average package weight
#
$dWeightRemainder = $dWeightRemainder / $nQuantity;
if($bUseIntegralWeights) # if we're using integral weights
{
$dWeightRemainder = int($dWeightRemainder + 0.9999); # round up to nearest integer
}
$hashWeightToQuantity{$dWeightRemainder} += $nQuantity; # add however many packages
#
# Add the details to the non-ship separate details
#
my @arrTemp = ('', $nQuantity, $dWeightRemainder);
push @arrMixedPackages, \@arrTemp;
}
}
else
{
if($bUseIntegralWeights) # if we're using integral weights
{
$dWeightRemainder = int($dWeightRemainder + 0.9999); # round up to nearest integer
}
$hashWeightToQuantity{$dWeightRemainder} += $nQuantity; # add however many packages
#
# Add the details to the non-ship separate details
#
my @arrTemp = ('', $nQuantity, $dWeightRemainder);
push @arrMixedPackages, \@arrTemp;
}
}
#
# We sort any weights into descending order. That way we know if
# a weight is invalid for a class/zone as soon as possible
#
@arrSortedWeightKeys = sort {$b <=> $a} keys %hashWeightToQuantity;
my ($dWeight, $sWeightList);
#
# Format the weight/quantities as a csv list of 'qty@weight'
#
foreach $dWeight (@arrSortedWeightKeys) # go through our sorted weights
{
$sWeightList .= sprintf("%d@%.03f,", $hashWeightToQuantity{$dWeight}, $dWeight);
}
#
# Trim the trailing comma
#
$sWeightList =~ s/,$//;
return(\%hashWeightToQuantity, \@arrSortedWeightKeys, $sWeightList,
\@arrShipSeparatePackages, \@arrMixedPackages, $sOptimalWeight);
}
################################################################
#
# GetWeight - Get the normal weight for a product
#
# Input: $nIndex - index into product arrays
# $phashWeightConfiguration - reference to weight configuration hash
# $dWeightDivisor - number to divide the weight by
# $dAltWeightDivisor - number to divide the alternative weight by
#
# Returns: $dUnitWeight - unit weight to use
#
# Author: Mike Purnell
#
################################################################
sub GetWeight
{
my ($nIndex, $phashWeightConfiguration, $dWeightDivisor) = @_;
my $dUnitWeight = $::s_Ship_OpaqueDataTables{$::s_Ship_sShipProducts[$nIndex]};
if ($dUnitWeight eq "") # if we have no weight in the opaque data
{
$dUnitWeight = $phashWeightConfiguration->{$c_nWeight}->{'DefaultWeight'}; # use default weight
}
if ($dWeightDivisor != 0) # if divisor isn't zero
{
$dUnitWeight /= $dWeightDivisor; # divide by divisor
}
return ($dUnitWeight);
}
################################################################
#
# GetAltWeight - Get the alternative weight for a product
#
# Input: $nIndex - index into product arrays
# $phashWeightConfiguration - reference to weight configuration hash
# $dWeightDivisor - number to divide the weight by
# $dAltWeightDivisor - number to divide the alternative weight by
#
# Returns: $dUnitWeight - unit weight to use
#
# Author: Mike Purnell
#
################################################################
sub GetAltWeight
{
my ($nIndex, $phashWeightConfiguration, $dWeightDivisor, $dAltWeightDivisor) = @_;
my $dUnitWeight = $::s_Ship_dShipAltWeights[$nIndex]; # use the alternative weight
if ($::s_Ship_dShipAltWeights[$nIndex] eq "") # if we have no alternative weight in the opaque data
{
my $phashWeightDetails = $phashWeightConfiguration->{$c_nAlternateWeight};
if ($phashWeightDetails->{'UseWeightIfUndefined'}) # if we're using weight if undefined
{
return (GetWeight($nIndex, $phashWeightConfiguration, $dWeightDivisor)); # return the normal weight
}
$dUnitWeight =
$phashWeightConfiguration->{$c_nAlternateWeight}->{'DefaultWeight'}; # use default alternative weight
}
if ($dAltWeightDivisor != 0) # if the divisor isn't zero
{
$dUnitWeight /= $dAltWeightDivisor; # divide weight by it
}
return ($dUnitWeight);
}
################################################################
#
# GetMaxWeight - Get the maximum weight for a product
#
# Input: $nIndex - index into product arrays
# $phashWeightConfiguration - reference to weight configuration hash
# $dWeightDivisor - number to divide the weight by
# $dAltWeightDivisor - number to divide the alternative weight by
#
# Returns: $dUnitWeight - unit weight to use
#
# Author: Mike Purnell
#
################################################################
sub GetMaxWeight
{
my ($nIndex, $phashWeightConfiguration, $dWeightDivisor, $dAltWeightDivisor) = @_;
my $dUnitWeight = GetWeight($nIndex, $phashWeightConfiguration, $dWeightDivisor);
my $dAltWeight = GetAltWeight($nIndex, $phashWeightConfiguration, $dWeightDivisor, $dAltWeightDivisor);
if ($dAltWeight > $dUnitWeight)
{
$dUnitWeight = $dAltWeight;
}
return ($dUnitWeight);
}
################################################################
#
# GetZoneClassCombinations - get the zone class combinations
#
# Returns: 0 - an array of zone/class array refs defined for the location
#
# Author: Mike Purnell
#
################################################################
sub GetZoneClassCombinations
{
my @arrZones = GetBands();
my (%hashZones, $nZoneID, $nClassID, @arrZonesClasses);
#
# Hash the zone IDs for easy checking
#
foreach $nZoneID (@arrZones)
{
$hashZones{$nZoneID} = 1;
}
#
# Go through the class hashes in the shipping table checking to
# see if one of our zone IDs is defined
#
foreach $nClassID (keys %ShippingTable)
{
my $phashClass = $ShippingTable{$nClassID}; # get the class hash
foreach $nZoneID (keys %$phashClass) # go through all the zone ID keys
{
if(defined $hashZones{$nZoneID}) # is this one of our zone IDs?
{
my @arrClassZone = ($nZoneID, $nClassID); # add the zone/class combination
push @arrZonesClasses, \@arrClassZone;
}
}
}
return(\@arrZonesClasses); # return our array of array refs
}
################################################################
#
# AddShippingHash - add a hash reference to our sorted array of
# shipping hashes
#
# This should only be called when @::s_arrSortedShippingHashes
# is empty.
#
# Input: $phashShipping - reference to the shipping hash
#
# Author: Mike Purnell
#
################################################################
sub AddShippingHash
{
my ($phashShipping) = @_;
#? ACTINIC::ASSERT(@::s_arrSortedShippingHashes == 0, 's_arrSortedShippingHashes has entries in it', __LINE__, __FILE__);
push @::s_arrSortedShippingHashes, $phashShipping;
}
################################################################
#
# SetDefaultCharge - Sets the default charge
#
# Returns: 0 - status - $::SUCCESS if default charge allowed
# 1 - error - configuration error message
#
# Author: Mike Purnell
#
################################################################
sub SetDefaultCharge
{
if ($UnknownRegion eq 'Default') # a default charge?
{
#
# Add the default charge hash to our array
#
AddShippingHash({
'ShippingLabel' => $$pMessageList[6],
'ShippingClass' => 'Default',
'ShippingZone' => -1,
'Cost' => $UnknownRegionCost,
'TaxAppliesToShipping' => $::s_sShip_bLocationTaxable,
});
return($::SUCCESS, '');
}
#
# Return an error
#
return($::FAILURE, $$pMessageList[4]);
}
################################################################
#
# SetFreeShipping - Sets the free shipping charge
#
# Returns: 0 - status - always $::SUCCESS
# 1 - error - always ''
#
# Author: Mike Purnell
#
################################################################
sub SetFreeShipping
{
#
# Add the free charge hash to our array
#
AddShippingHash(GetFreeShippingHash());
return($::SUCCESS, '');
}
################################################################
#
# GetFreeShippingHash - Returns the free shipping hash
#
# Returns: free shipping hash
#
# Author: Mike Purnell
#
################################################################
sub GetFreeShippingHash
{
#
# Add the free charge hash to our array
#
return({
'ShippingLabel' => $$pMessageList[5],
'ShippingClass' => '-1',
'ShippingZone' => -1,
'Cost' => 0,
'BasisTotal' => 0
});
}
################################################################
#
# SetUndefinedShipping - Sets the shipping undefined
#
# Returns: 0 - status - always $::SUCCESS
# 1 - error - always ''
#
# Author: Mike Purnell
#
################################################################
sub SetUndefinedShipping
{
#
# Add the undefined hash to our array
#
AddShippingHash({
'ShippingLabel' => '',
'ShippingClass' => -1,
'ShippingZone' => -1,
'Cost' => 0,
});
return($::SUCCESS, '');
}
#######################################################
#
# OpaqueToHash - populate the hash of the current selection
# from the shipping opaque data
#
# Author: Mike Purnell
#
#######################################################
sub OpaqueToHash
{
if(defined $::g_InputHash{ShippingClass}) # if we know the user's selection
{
$::s_hashShipData{ShippingClass} = $::g_InputHash{ShippingClass}; # just save the class
}
else # otherwise
{
%::s_hashShipData =
split (';', $::s_Ship_sOpaqueShipData); # restore from opaque data
}
}
################################################################
#
# SaveSelectionToOpaqueData - Save the selected class to the
# shipping opaque data
#
# Author: Mike Purnell
#
################################################################
sub SaveSelectionToOpaqueData
{
#
# Simple shipping handles it's own opaque data
#
if($ShippingBasis eq 'Simple')
{
return;
}
#
# Check if our current selection is valid
#
my ($phashShipping, $phashSelected);
$phashSelected = undef;
foreach $phashShipping (@::s_arrSortedShippingHashes) # for each valid selection
{
HashToOpaque($phashShipping);
$$phashShipping{'OpaqueData'} = $::s_Ship_sOpaqueShipData;
if($$phashShipping{ShippingClass} eq $::s_hashShipData{ShippingClass}) # is this our selected class
{
$phashSelected = $phashShipping; # save selection
}
}
if(!defined $phashSelected && # if we didn't find our selection
@::s_arrSortedShippingHashes > 0) # and there are valid options
{
$phashSelected = $::s_arrSortedShippingHashes[0]; # select the cheapest
}
#
# create the opaque data
#
if (defined $phashSelected) # if we have a selection
{
%::s_hashShipData = %$phashSelected; # store to our working hash
}
HashToOpaque($phashSelected);
#
# If this isn't an SSP class, clear the SSP opaque data
#
if (!$phashSelected ||
$$phashSelected{ShippingClass} !~ /^\d+_/)
{
$::s_Ship_sSSPOpaqueShipData = ''; # clear the SSP data
}
}
#######################################################
#
# HashToOpaque - populate the shipping opaque data from the hash of the current selection
#
# Author: Mike Purnell
#
#######################################################
sub HashToOpaque
{
my $phashSelected = shift;
if (defined $phashSelected) # if we have a selection
{
#
# Format the shipping opaque data
#
$::s_Ship_sOpaqueShipData =
sprintf("ShippingClass;%s;ShippingZone;%d;BasisTotal;%s;Cost;%d;",
$$phashSelected{ShippingClass},
$$phashSelected{ShippingZone},
$$phashSelected{BasisTotal},
$$phashSelected{Cost});
#
# If we're in tax-inclusive mode, save tax related fields
#
if ($bPricesIncludesTax)
{
$::s_Ship_sOpaqueShipData .=
sprintf("TaxApplies;%s;TaxIncluded;%d;TaxMultiplier;%0.06f;",
$$phashSelected{'TaxAppliesToShipping'},
$$phashSelected{'ShippingCostsIncludeTax'},
$dTaxInclusiveMultiplier);
}
#
# Add the online SSP error handling if present
#
if(defined $$phashSelected{OnlineError} &&
$$phashSelected{OnlineError} ne '')
{
$::s_Ship_sOpaqueShipData .=
sprintf('OnlineError;%s;', $$phashSelected{OnlineError});
}
#
# Add the optimal weight if specified and more than 0
#
my $sOptimalWeight = $phashSelected->{'OptimalWeight'};
if($sOptimalWeight ne '' &&
$sOptimalWeight > 0)
{
$::s_Ship_sOpaqueShipData .=
sprintf('OptimalWeight;%s;', $sOptimalWeight);
}
#
# Set the shipping charge
#
$::s_Ship_nShipCharges = $$phashSelected{Cost};
if ($bPricesIncludesTax)
{
$::s_Ship_bTaxAppliesToShipping = $$phashSelected{TaxAppliesToShipping};
}
else
{
$::s_Ship_bTaxAppliesToShipping = $::TRUE;
}
my $sClassID = $$phashSelected{ShippingClass};
#
# Get package details from selected class
#
my $parrShipSeparatePackages = $phashSelected->{'ShipSeparatePackages'};
my $parrMixedPackages = $phashSelected->{'MixedPackages'};
#
# Add the costs to packaging details
#
if(defined $parrShipSeparatePackages &&
defined $parrMixedPackages)
{
my $phashWeightToCost =
(defined $::s_hashClassToWeightCost{$sClassID}) ?
$::s_hashClassToWeightCost{$sClassID} :
undef;
#
# Clear our globals
#
$::s_Ship_sSeparatePackageDetails = '';
$::s_Ship_sMixedPackageDetails = '';
my $parrPackage;
foreach $parrPackage (@$parrShipSeparatePackages)
{
my $sUnitWeight = ($sClassID =~ /^1_/) ?
sprintf('%0.03f', int($$parrPackage[2] + 0.9999)) :
sprintf('%0.03f', $$parrPackage[2]);
my $nUnitCost =
(defined $phashWeightToCost) ?
$$phashWeightToCost{$sUnitWeight} :
0;
$::s_Ship_sSeparatePackageDetails .=
sprintf("%s\t%d\t%0.03f\t%d\n",
$$parrPackage[0], $$parrPackage[1], $$parrPackage[2], $nUnitCost);
}
#
# The summary record is the last record in the array
#
my $parrSummary =
(@$parrMixedPackages > 0) ? # if we have mixed packages
$$parrMixedPackages[-1] : # get the last package
undef; # we use this
foreach $parrPackage (@$parrMixedPackages)
{
my $sUnitWeight = ($sClassID =~ /^1_/) ?
sprintf('%0.03f', int($$parrPackage[2] + 0.9999)) :
sprintf('%0.03f', $$parrPackage[2]);
#
# Only supply a real unit cost for the summary record
#
my $nUnitCost =
(defined $phashWeightToCost && $parrSummary == $parrPackage) ?
$$phashWeightToCost{$sUnitWeight} :
0;
$::s_Ship_sMixedPackageDetails .=
sprintf("%s\t%d\t%0.03f\t%d\n",
$$parrPackage[0], $$parrPackage[1], $$parrPackage[2], $nUnitCost);
}
}
}
else
{
$::s_Ship_sOpaqueShipData = '';
$::s_Ship_nShipCharges = 0;
$::s_Ship_sSSPOpaqueShipData = ''; # clear the SSP data
}
}
################################################################
#
# ClearUnusedSSPShippingEntries - Clear any SSP shipping (%::g_ShipInfo) hash entries
#
# Author: Mike Purnell
#
################################################################
sub ClearUnusedSSPShippingEntries
{
if (CalculateQuantity() == 0) # if we have no items
{
my $sShipKey;
foreach $sShipKey (keys %::g_ShipInfo) # for each entry in the shipping checkout hash
{
if($sShipKey =~ /^\d+_/) # is this an SSP entry?
{
delete $::g_ShipInfo{$sShipKey}; # delete it
}
}
return;
}
}
#------------------------------------------------------
#
# End of low-level functions
#
#------------------------------------------------------
#------------------------------------------------------
#
# UPS functions
#
#------------------------------------------------------
#######################################################
#
# GetUPSRates - Get the UPS rates
#
# Input: 0 - the order weight
#
# Returns: 0 - status code
# 1 - error message if any
# 2 - ref to an array of class hashes
# 3 - rating type (no UPS rate, BasePlusPer rating or UPS rating
#
#######################################################
sub GetUPSRates
{
my @arrShippingHashes;
my (%hashValidClasses, %hashClassToTotal, $sClassID);
#
# Clean the SSP entries from the shipping info hash
#
my $sShipKey;
foreach $sShipKey (keys %::g_ShipInfo) # for each entry in the shipping checkout hash
{
if($sShipKey =~ /^1_/) # is this an SSP entry?
{
delete $::g_ShipInfo{$sShipKey}; # delete it
}
}
#
# Get the setup hash
#
my $pSSPProvider = GetUPSSetup();
#
# Get the merchant and shipment details
#
my ($nReturnCode, $sError, $sServiceLevelCode, $sRateChart,
$sShipperPostalCode, $sShipperCountry, $sConsigneePostalCode, $sConsigneeCountry,
$nResidential, $sPackagingType) =
GetShipmentDetails();
if($nReturnCode != $::SUCCESS)
{
return($nReturnCode, $sError);
}
#
# Build the request data to be posted to UPS
#
my $sRSSRequestDataFormat;
$sRSSRequestDataFormat = $::XML_HEADER;
$sRSSRequestDataFormat .= GetUPSAccessRequestNode($pSSPProvider);
$sRSSRequestDataFormat .= $::XML_HEADER;
$sRSSRequestDataFormat .= "$sRateChart";
$sRSSRequestDataFormat .= "$sServiceLevelCode";
$sRSSRequestDataFormat .= " $sPackagingType";
$sRSSRequestDataFormat .= "