10561751; #--------------------------------------------------------------- # # 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" => [15], "US.AL" => [15], "US.AK" => [15], "US.AZ" => [15], "US.AR" => [15], "US.CA" => [15], "US.CO" => [15], "US.CT" => [15], "US.DE" => [15], "US.DC" => [15], "US.FL" => [15], "US.GA" => [15], "US.HI" => [15], "US.ID" => [15], "US.IL" => [15], "US.IN" => [15], "US.IA" => [15], "US.KS" => [15], "US.KY" => [15], "US.LA" => [15], "US.ME" => [15], "US.MD" => [15], "US.MA" => [15], "US.MI" => [15], "US.MN" => [15], "US.MS" => [15], "US.MO" => [15], "US.MT" => [15], "US.NE" => [15], "US.NV" => [15], "US.NH" => [15], "US.NJ" => [15], "US.NM" => [15], "US.NY" => [15], "US.NC" => [15], "US.ND" => [15], "US.OH" => [15], "US.OK" => [15], "US.OR" => [15], "US.PA" => [15], "US.RI" => [15], "US.SC" => [15], "US.SD" => [15], "US.TN" => [15], "US.TX" => [15], "US.UT" => [15], "US.VT" => [15], "US.VA" => [15], "US.WA" => [15], "US.WV" => [15], "US.WI" => [15], "US.WY" => [15], }, "CA" => { "UndefinedRegion" => [15], "CA.AB" => [15], "CA.BC" => [15], "CA.MB" => [15], "CA.NB" => [15], "CA.NF" => [15], "CA.NT" => [15], "CA.NU" => [15], "CA.NS" => [15], "CA.ON" => [15], "CA.PE" => [15], "CA.PQ" => [15], "CA.SK" => [15], "CA.YT" => [15], }, "AD" => { "UndefinedRegion" => [14], }, "AU" => { "UndefinedRegion" => [16], }, "AT" => { "UndefinedRegion" => [14], }, "BS" => { "UndefinedRegion" => [16], }, "BH" => { "UndefinedRegion" => [16], }, "BE" => { "UndefinedRegion" => [14], }, "BM" => { "UndefinedRegion" => [15], }, "BN" => { "UndefinedRegion" => [16], }, "BG" => { "UndefinedRegion" => [14], }, "CY" => { "UndefinedRegion" => [14], }, "CZ" => { "UndefinedRegion" => [14], }, "DK" => { "UndefinedRegion" => [14], }, "EE" => { "UndefinedRegion" => [14], }, "FK" => { "UndefinedRegion" => [16], }, "FO" => { "UndefinedRegion" => [14], }, "FI" => { "UndefinedRegion" => [14], }, "FR" => { "UndefinedRegion" => [14], }, "DE" => { "UndefinedRegion" => [14], }, "GI" => { "UndefinedRegion" => [14], }, "GR" => { "UndefinedRegion" => [14], }, "GG" => { "UndefinedRegion" => [13], }, "HK" => { "UndefinedRegion" => [16], }, "HU" => { "UndefinedRegion" => [14], }, "IS" => { "UndefinedRegion" => [14], }, "IE" => { "UndefinedRegion" => [14], }, "IL" => { "UndefinedRegion" => [16], }, "IT" => { "UndefinedRegion" => [14], }, "JP" => { "UndefinedRegion" => [16], }, "JE" => { "UndefinedRegion" => [13], }, "KW" => { "UndefinedRegion" => [16], }, "LV" => { "UndefinedRegion" => [14], }, "LI" => { "UndefinedRegion" => [14], }, "LT" => { "UndefinedRegion" => [14], }, "LU" => { "UndefinedRegion" => [14], }, "MY" => { "UndefinedRegion" => [16], }, "MT" => { "UndefinedRegion" => [14], }, "MC" => { "UndefinedRegion" => [14], }, "NL" => { "UndefinedRegion" => [14], }, "NZ" => { "UndefinedRegion" => [16], }, "NO" => { "UndefinedRegion" => [14], }, "OM" => { "UndefinedRegion" => [16], }, "PL" => { "UndefinedRegion" => [14], }, "PT" => { "UndefinedRegion" => [14], }, "QA" => { "UndefinedRegion" => [16], }, "RO" => { "UndefinedRegion" => [14], }, "RU" => { "UndefinedRegion" => [16], }, "SM" => { "UndefinedRegion" => [14], }, "SA" => { "UndefinedRegion" => [16], }, "SG" => { "UndefinedRegion" => [16], }, "SK" => { "UndefinedRegion" => [14], }, "SI" => { "UndefinedRegion" => [14], }, "ZA" => { "UndefinedRegion" => [16], }, "ES" => { "UndefinedRegion" => [14], }, "SE" => { "UndefinedRegion" => [14], }, "CH" => { "UndefinedRegion" => [14], }, "TR" => { "UndefinedRegion" => [16], }, "AE" => { "UndefinedRegion" => [16], }, "VG" => { "UndefinedRegion" => [16], }, "YE" => { "UndefinedRegion" => [16], }, ); # # Shipping class table # my %ClassTable = ( 10 => ['First Class Packet', 0, ''], 8 => ['Europe Standard Charge', 1, ''], 6 => ['North America', 0, ''], 12 => ['Rest of World', 1, ''] ); # # Defined Categories # my $phashDefinedCategories = { 'Default' => 1, }; # # Default Category # my $sDefaultCategory = 'Default'; # # Shipping bands table # my %ShippingTable = ( 10 => { 13 => [ {'CalculationBasis' => 2, 'FreeOver' => 1000.000000, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 1, 'ExcessAction' => 'Highest'}, { "wt" => 1000, "cost" => 250, 'costIncTax' => 250.000000}, ], }, 6 => { 15 => [ {'CalculationBasis' => 2, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 1, 'ExcessAction' => 'Error'}, { "wt" => 2000, "cost" => 500, 'costIncTax' => 500.000000}, { "wt" => 8000, "cost" => 1000, 'costIncTax' => 1000.000000}, { "wt" => 20000, "cost" => 1300, 'costIncTax' => 1300.000000}, ], }, 8 => { 14 => [ {'CalculationBasis' => 2, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 1, 'ExcessAction' => 'Error'}, { "wt" => 2000, "cost" => 400, 'costIncTax' => 400.000000}, { "wt" => 8000, "cost" => 900, 'costIncTax' => 900.000000}, { "wt" => 20000, "cost" => 1000, 'costIncTax' => 1000.000000}, { "wt" => 25000, "cost" => 1100, 'costIncTax' => 1100.000000}, { "wt" => 50000, "cost" => 1200, 'costIncTax' => 1200.000000}, ], }, 12 => { 16 => [ {'CalculationBasis' => 2, 'WeightFactor' => 1.000000, 'AltWeightFactor' => 1.000000, 'TaxAppliesToShipping' => 1, 'ShippingCostsIncludeTax' => 1, 'ExcessAction' => 'Error'}, { "wt" => 2000, "cost" => 500, 'costIncTax' => 500.000000}, { "wt" => 8000, "cost" => 1200, 'costIncTax' => 1200.000000}, { "wt" => 40000, "cost" => 1400, 'costIncTax' => 1400.000000}, { "wt" => 500000, "cost" => 0, 'costIncTax' => 0.000000}, ], }, ); 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 = 'Error'; $UnknownRegionCost = 0; $WaiveCharges = 'No'; $WaiveThreshold = 425.000000; my $bPricesIncludesTax = 1; my $dTaxInclusiveMultiplier = 1.000000; # # Handling variables # my $nHandlingCharge = 0; my $nHandlingProportion = 0; # # Parent country zone list # my %ParentZoneTable = ( "US" => [], "CA" => [], ); ################################################################ # # 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) SellerDeck Limited 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 # $::s_Ship_nSubTotalEx - product sub-total excluding discounts listed in extrasettings.fil # # 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 # $::s_Ship_sGFSCarrierAndService - carrier and service if GFS used # $::s_Ship_bInternationalShippingZone - International Shipping # # $Revision: 50945 $ # ################################################################ 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; $::s_Ship_sGFSCarrierAndService = ''; $::s_Ship_bInternationalShippingZone = $::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; # # DPD constants # $::DPD_HOST = "api.dpd.co.uk"; $::DPD_GROUP_HOST = "api.dpdgroup.co.uk"; $::DPD_SSL_PORT = 443; $::DPD_LOGIN_URL = "/user/?action=login"; $::DPD_GET_SERVICES_URL = "/shipping/network/?"; $::DPD_GET_PICKUP_LOCATIONS = "/organisation/pickuplocation/?"; $::DPD_NETWORK_CODE_SHIP_TO_SHOP = "1^91"; # Ship to Shop network service, 1^91 escaped $::DPD_SHIP_TO_SHOP_POSTFIX = "_DPDShipToShop"; $::DPD_MAX_RESULTS = 20; $::DPD_ADD_ALWAYS = "add-always"; %::hashPickupLocations; # hash to be used with Ship to Shop $::sGeoSessionID; # session ID $::DPD_WEEKDAY = 1; $::DPD_SATURDAY = 2; $::DPD_SUNDAY = 4; $::DPD_ALL = $::DPD_WEEKDAY | $::DPD_SATURDAY | $::DPD_SUNDAY; $::g_DPDFilters = { 'w' => $::DPD_WEEKDAY, 'st' => $::DPD_SATURDAY, 'sn' => $::DPD_SUNDAY }; if ($::bAjaxCall) { return($::SUCCESS); } # # 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 } if(defined $::s_hashShipData{InternationalShipping}) # if we have the international shipping zone flag defined { $::s_Ship_bInternationalShippingZone = $::s_hashShipData{InternationalShipping}; # use it } else { $::s_Ship_bInternationalShippingZone = $::FALSE; } 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 DPD integration is used, only display shipping classes that are available for the DPD account # my (%hashDPDServices, %hashCodesToServices); my ($bDPDVarDefined, $bDPDEnabled) = ACTINIC::IsCustomVarDefined("IsDPDEnabled"); my ($bDPDS2SDefined, $bDPDShipToShopEnabled) = ACTINIC::IsCustomVarDefined("IsDPDShipToShopEnabled"); my ($bDPDDateDefined, $bDPDDeliveryDateEnabled) = ACTINIC::IsCustomVarDefined("IsDPDDeliveryDateEnabled"); my $sCountryCode = $::g_LocationInfo{DELIVERY_COUNTRY_CODE}; if ($sCountryCode ne 'UK') { $bDPDEnabled = $::FALSE; } if ($bDPDEnabled) {{ # # Get package and weight information as for other SSPs # my ($phashWeightToQuantity, $parrSortedWeightKeys, $sWeightList, $parrShipSeparatePackages, $parrMixedPackages, $sOptimalWeight) = DivideIntoPackages($c_nWeight, undef); # split into packages my $nPackages = scalar @$parrShipSeparatePackages + scalar @$parrMixedPackages; # count packages # # Calculate the sum of weights for further evaluation # my $dSumOfWeights = 0.0; # shows the sum of weights of all the packages foreach my $dWeight (@$parrSortedWeightKeys) # go through our sorted weights { $dSumOfWeights += $$phashWeightToQuantity{$dWeight} * $dWeight; # add the weight of each package to the sum } ACTINIC::LoadJsonLib(); # make sure the library is loaded my @Response = GetAvailableDPDServices($nPackages, $dSumOfWeights); if ($Response[0] != $::SUCCESS) { if ($Response[4] =~ /^validation/i) { return (@Response); # let validation errors be displayed } ACTINIC::RecordErrors($Response[1], ACTINIC::GetPath()); $bDPDEnabled = $::FALSE; # fail silently, the shipping classes shouldn't be set up using the DPD integration } last if (!$bDPDEnabled); %hashDPDServices = %{$Response[2]}; %hashCodesToServices = %{$Response[3]}; my $sFilename = $::Session->GetSessionFileFolder() . "dpdservices.fil"; @Response = ACTINIC::ReadAndVerifyFileNoChecksum($sFilename); if ($Response[0] != $::SUCCESS) # if not successful { ACTINIC::RecordErrors($Response[1], ACTINIC::GetPath()); $bDPDEnabled = $::FALSE; # fail silently, the shipping classes shouldn't be set up using the DPD integration } last if (!$bDPDEnabled); my ($sScript) = $Response[2]; # # now execute the plug-in # eval($sScript); # execute the script }} 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}; $bDPDDeliveryDateEnabled = $::FALSE; my $sDPDName = $$::g_pShippingToDPDClass{$sClassLabel}; if ($sDPDName ne $hashCodesToServices{$::DPD_NETWORK_CODE_SHIP_TO_SHOP}) # ship 2 shop not enabled? { $bDPDShipToShopEnabled = $::FALSE; } 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"; if (!$bDPDDateClassesAvailable) { $bDPDDeliveryDateEnabled = $::FALSE; # no valid classes found for the postcode/zone, disable } if (!$bDPDS2SClassesAvailable) { $bDPDShipToShopEnabled = $::FALSE; # no valid classes found for the postcode/zone, disable } } # # If neither Delivery by Date nor Postcode shipping is available, disable DPD completely for now # if (!$bDPDShipToShopEnabled && # assume disabled for both !$bDPDDeliveryDateEnabled) { $bDPDEnabled = $::FALSE; } # # 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; if ($bDPDEnabled) { my $sHTML = ""; if ($::bPPConfirmationPage) { # # Use input values if shipping changed on the confirmation page # $::g_ShipInfo{'DPDSHIPPINGTYPE'} = $::g_InputHash{'DPDShippingType'}; $::g_ShipInfo{'DPDPICKUPLOCATION'} = $::g_InputHash{'DPDPickupLocation'}; $::g_ShipInfo{'DPDDELIVERYDATE'} = $::g_InputHash{'DPDDeliveryDate'}; my ($sLocation, $sLocationCode) = split(/\|/, $::g_ShipInfo{'DPDPICKUPLOCATION'}); $sHTML .= sprintf("\n", $sLocationCode); $sHTML .= sprintf("\n", $::g_ShipInfo{'DPDDELIVERYDATE'}); } my $IDsToShippingTypes = { '1' => 'Standard Delivery', '2' => 'Specified Day', '3' => 'Collection Point Pickup' }; $sHTML .= "\n"; my ($sID, $sChecked); foreach $sID (sort keys %$IDsToShippingTypes) { if (($::DPD_SPECIFIED_DAY eq $sID) && !$bDPDDeliveryDateEnabled) { next; # specified date delivery not enabled } if (($::DPD_COLLECTION_POINT_PICKUP eq $sID) && !$bDPDShipToShopEnabled) { next; # ship to shop delivery not enabled } if ($::g_ShipInfo{'DPDSHIPPINGTYPE'} eq "") { $sChecked = ($sID eq "1") ? " checked" : ""; # check first item by default } else { $sChecked = ($::g_ShipInfo{'DPDSHIPPINGTYPE'} eq $sID) ? " checked" : ""; } $sHTML .= sprintf("\n", $sID, $sChecked, $$IDsToShippingTypes{$sID}); } $sHTML .= "
%s
\n"; $::s_Ship_ShippingVariables{$::VARPREFIX . 'SHIPPINGTYPE'} = $sHTML; } else { $::s_Ship_ShippingVariables{$::VARPREFIX . 'SHIPPINGTYPE'} = ""; $::g_ShipInfo{'DPDSHIPPINGTYPE'} = ""; $::g_ShipInfo{'DPDPICKUPLOCATION'} = ""; $::g_ShipInfo{'DPDDELIVERYDATE'} = ""; } if ($::bPPConfirmationPage) { $::g_sShippingDump = ActinicOrder::GetShippingDump(); # make sure we have the page defaults set here } 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_ShipContact{'RESIDENTIAL'} 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 } if(defined $::s_hashShipData{GFSCarrierAndService}) # if we have a gfs carrier and service { $::s_Ship_sGFSCarrierAndService = $::s_hashShipData{GFSCarrierAndService}; # use it } else { $::s_Ship_sGFSCarrierAndService = ''; # 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 $::s_Ship_sGFSCarrierAndService eq "") # not a GFS shipping band { 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_nSubTotalEx) { return ($::s_Ship_nSubTotalEx); } 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 $::s_Ship_sGFSCarrierAndService eq "") # not a GFS shipping band { 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; } my $bInternational = $::FALSE; if (defined $phashBandDefinition->{'InternationalZone'}) # International? { $bInternational = $phashBandDefinition->{'InternationalZone'}; } 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'}, 'GFSCarrierAndService' => $ClassTable{$nClassID}[2], 'InternationalShipping' => $bInternational }; # 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 { my $bInternational = $::FALSE; if (defined $phashBandDefinition->{'InternationalZone'}) # International? { $bInternational = $phashBandDefinition->{'InternationalZone'}; } push @$parrShippingHashes, { 'ShippingLabel' => $ClassTable{$nClassID}[0], 'ShippingClass' => $nClassID, 'ShippingZone' => $nZoneID, 'Cost' => 0, 'BasisTotal' => 0, 'GFSCarrierAndService' => $ClassTable{$nClassID}[2], 'InternationalShipping' => $bInternational }; # 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 $dExcludeFromShippingWeight = 0.0; my (%hashWeightToQuantity, @arrSortedWeightKeys); my ($i); my (@arrShipSeparatePackages, @arrMixedPackages, $parrPackage); # # We support multi-packaging if we're shipping by weight # if (($::s_Ship_sGFSCarrierAndService eq "" || !defined $::s_Ship_sGFSCarrierAndService) && defined $parrZoneClass) # if we have a zone and class { my ($nZoneID, $nClassID) = @$parrZoneClass; # split in zone and class ID $::s_Ship_sGFSCarrierAndService = $ClassTable{$nClassID}[2]; } 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 $::s_Ship_sGFSCarrierAndService eq "") # not a GFS shipping band { 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 # if ($::s_Ship_nExcludeFromShipping[$i] == 0) # product not exluded from shipping { $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 if ($::s_Ship_nExcludeFromShipping[$i] == 1) # product excluded from shipping band { $dExcludeFromShippingWeight += $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 # my $dBasis = 0.0; 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 } $dBasis = $dUnitWeight; if ($dExcludeFromShippingWeight > 0) { $dBasis -= $dExcludeFromShippingWeight; } $hashWeightToQuantity{$dBasis} += $$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; $dExcludeFromShippingWeight = $dExcludeFromShippingWeight / $nQuantity; if($bUseIntegralWeights) # if we're using integral weights { $dWeightRemainder = int($dWeightRemainder + 0.9999); # round up to nearest integer if ($dExcludeFromShippingWeight > 0) { $dExcludeFromShippingWeight = int($dExcludeFromShippingWeight + 0.9999); # round up to nearest integer } } $dBasis = $dWeightRemainder; if ($dExcludeFromShippingWeight > 0) { $dBasis -= $dExcludeFromShippingWeight; } if ($dBasis != 0.0 || $dBasis == $dWeightRemainder) # skip if ended up with zero calculated weight { $hashWeightToQuantity{$dBasis} += $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 if ($dExcludeFromShippingWeight > 0) { $dExcludeFromShippingWeight = int($dExcludeFromShippingWeight + 0.9999); # round up to nearest integer } } $dBasis = $dWeightRemainder; if ($dExcludeFromShippingWeight > 0) { $dBasis -= $dExcludeFromShippingWeight; } if ($dBasis != 0.0 || # skip if ended up with zero calculated weight $dBasis == $dWeightRemainder) { $hashWeightToQuantity{$dBasis} += $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 .= ""; $sRSSRequestDataFormat .= GetUPSRequestNode('Rate', 'Shop'); $sRSSRequestDataFormat .= ""; $sRSSRequestDataFormat .= " $sRateChart"; $sRSSRequestDataFormat .= ""; $sRSSRequestDataFormat .= ""; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= "

"; $sRSSRequestDataFormat .= " $sShipperPostalCode"; $sRSSRequestDataFormat .= " $sShipperCountry"; $sRSSRequestDataFormat .= "
"; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= "
"; $sRSSRequestDataFormat .= " $sConsigneePostalCode"; $sRSSRequestDataFormat .= " $sConsigneeCountry"; $sRSSRequestDataFormat .= ($nResidential == 1) ? '' : ''; $sRSSRequestDataFormat .= "
"; $sRSSRequestDataFormat .= "
"; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " $sServiceLevelCode"; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " $sPackagingType"; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " %d"; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= " "; $sRSSRequestDataFormat .= ""; $sRSSRequestDataFormat .= ""; # # Split the order into packages of integral weight # my ($phashWeightToQuantity, $parrSortedWeightKeys, $sWeightList, $parrShipSeparatePackages, $parrMixedPackages, $sOptimalWeight) = DivideIntoPackages($c_nWeight, undef, $::TRUE); # split into packages # # For each weight ask UPS for the rates # my $nWeight; foreach $nWeight (@$parrSortedWeightKeys) # go through our sorted weights { if ($nWeight == 0) # if this is a zero-weight package skip it { next; } my $sRSSRequestData = sprintf($sRSSRequestDataFormat, $nWeight); # # Get the cost of the shipping for each available classes # my $parrShippingHashes; my $pXmlRoot; ($nReturnCode, $sError, $pXmlRoot) = GetUPSPackageShipping($sRSSRequestData); # Get the UPS response for this rating query if($nReturnCode == $::SUCCESS) # everything OK? { # # Process the list of RatedShipment xml nodes # my $pXmlRatedShipments = $pXmlRoot->GetChildNodes($::UPS_XML_RATED_SHIPMENT); my $pXmlRatedShipment; foreach $pXmlRatedShipment (@{$pXmlRatedShipments}) { # # Get the UPS service level code # my $sServiceCode = $pXmlRatedShipment->GetChildNode($::UPS_XML_SERVICE)->GetChildNode($::UPS_XML_SERVICE_CODE)->GetNodeValue(); my $sClassID = "1_$sServiceCode"; # # Check that this service is acceptable to the merchant # if(defined $$pSSPProvider{ServiceLevelCode}{$sServiceCode}) { # # Get the cost of shipping a package with the specified weight # my $pXmlTotalCharges = $pXmlRatedShipment->GetChildNode($::UPS_XML_TOTAL_CHARGES); my $sCurrencyCode = $pXmlTotalCharges->GetChildNode($::UPS_XML_CURRENCY_CODE)->GetNodeValue(); my $sMonetaryValue = $pXmlTotalCharges->GetChildNode($::UPS_XML_MONETARY_VALUE)->GetNodeValue(); my $nIntegralCost = int($sMonetaryValue * 100 + 0.999); # # Add the cost to our totals hash # $hashClassToTotal{$sClassID} += $$phashWeightToQuantity{$nWeight} * $nIntegralCost; # add quantity * cost to total # # If this is the first time we've seen this class, save the hash reference # if(!defined $hashValidClasses{$sClassID}) { $hashValidClasses{$sClassID} = { 'ShippingLabel' => GetUPSServiceName($sServiceCode), 'ShippingClass' => $sClassID, 'ShippingZone' => -1, 'ShipSeparatePackages' => $parrShipSeparatePackages, 'MixedPackages' => $parrMixedPackages, 'OptimalWeight' => $sOptimalWeight, 'GFSCarrierAndService' => '', 'InternationalShipping' => $::FALSE }; } # # Add to the class to weight/cost hash # $::s_hashClassToWeightCost{$sClassID}{sprintf('%0.03f', $nWeight)} = $nIntegralCost; } } } elsif ($nReturnCode == $::FAILURE) # e.g. server unavailable error { return(HandleUPSOnlineError($sError, $parrSortedWeightKeys, $phashWeightToQuantity, $sWeightList)); } else # Bad data - e.g. oversized packages { # # Return an empty shipping hash and Shipping Band Not Defined logic will determine the following actions # @arrShippingHashes = (); return($::SUCCESS, '', \@arrShippingHashes, $::UPS_CLASSES_NOT_USED); } } # # Now populate the array of hashes of to return # my $nRatingType = $::UPS_CLASSES_NOT_USED; foreach $sClassID (keys %hashValidClasses) # for each valid class { my $phashShipping = $hashValidClasses{$sClassID}; # get a shipping hash $$phashShipping{BasisTotal} = 0; # set the weight $$phashShipping{Cost} = $hashClassToTotal{$sClassID} + $::dShippingSupplements; # adjust the cost and include supplement push @arrShippingHashes, $phashShipping; # add to the array my $dUPSCost = $hashClassToTotal{$sClassID} / 100; # # Save the pseudo UPS raw response to the shipping info # $::g_ShipInfo{$sClassID} = "UPSOnLine%1.2\%0000%0000Success%4%$sServiceLevelCode%$sShipperPostalCode%US%$sConsigneePostalCode%$sConsigneeCountry%000%1%$dUPSCost%0.00%$dUPSCost%-1"; $nRatingType = $::UPS_CLASSES_USED; } return($::SUCCESS, '', \@arrShippingHashes, $nRatingType); } ####################################################### # # GetUPSPackageShipping - get the classes and costs for # a package of a given weight # # Input: $sRequestData - the request data # $nWeight - weight of the package # # Returns: 0 - status code # 1 - error message if any # 2 - ref to array of shipping hashes # ####################################################### sub GetUPSPackageShipping { my ($sRequestData, $nWeight) = @_; my (@arrShippingHashes); # # Set the maximum number of retries before fallback # my $nRetries = 2; # # Testing code to simulate a UPS failure # # if($::s_sDeliveryCountryCode eq 'US' && # ActinicLocations::GetISODeliveryRegionCode() eq 'NOUPS') # { # $nRetries = 0; # } return(UPS_SendAndReceive('/ups.app/xml/Rate', $sRequestData, $nRetries, 2253)); } ####################################################### # # HandleUPSOnlineError - Handle an online error # # Input: $sResponse - reason for failure # $parrSortedWeightKeys - an array of sorted weight keys # $phashWeightToQuantity - hash of weights to quantities # $sWeightList - csv list of qty@weight # # Returns: 0 - status code # 1 - error message if any # 2 - ref to array of shipping hashes # 3 - rating type (BasePlusPer rating or no rating) # ####################################################### sub HandleUPSOnlineError { my ($sResponse, $parrSortedWeightKeys, $phashWeightToQuantity, $sWeightList) = @_; my ( $sRateChart, $sShipperPostalCode, $sConsigneePostalCode, $sConsigneeCountry, $sPackagingType); my (@arrShippingHashes); # # Get the UPS hash ref # my $pSSPProvider = GetUPSSetup(); # # Rating type = no rating until we don't add any classes # my $nRatingType = $::UPS_CLASSES_NOT_USED; $sRateChart = $$pSSPProvider{'RateChart'}; $sShipperPostalCode = $$pSSPProvider{'ShipperPostalCode'}; $sPackagingType = $$pSSPProvider{'PackagingType'}; $sConsigneePostalCode = $::g_ShipContact{'POSTALCODE'}; # # Get the consignee ISO country code # $sConsigneeCountry = ActinicLocations::GetISODeliveryCountryCode(); # # log the error so we know fallback plan used # my $sErrorText = ACTINIC::GetPhrase(-1, 2292, $sResponse); ACTINIC::RecordErrors($sErrorText, ACTINIC::GetPath()); # # checked on any error # if($$::g_pSSPSetupBlob{NotifyMerchantOfFailure}) { my ($Status, $Message) = ACTINIC::SendMail($::g_sSmtpServer, $$::g_pSSPSetupBlob{FailureEmailAddress}, ACTINIC::GetPhrase(-1, 2291), $sErrorText, $$::g_pSSPSetupBlob{FailureEmailAddress}); # # just record the error if mail problem # if ($Status != $::SUCCESS) { ACTINIC::RecordErrors("$sErrorText:\n sending$Message" , ACTINIC::GetPath()); } } # # now decide which classes to put into the shipping dropdown # # virtual zero-cost class # if($$::g_pSSPSetupBlob{ConfirmShippingByEmail}) { # # Save the UPS raw response to the shipping info # $::g_ShipInfo{"1_$sCONFIRM_BY_EMAIL"} = "UPSOnLine%1.2\%0000%0000Success%4%000%$sShipperPostalCode%US%$sConsigneePostalCode%$sConsigneeCountry%000%1%0.00%0.00%0.00%-1"; # # Save the error handling # $sOnlineError = 'Email'; push @arrShippingHashes, { 'ShippingLabel' => GetUPSServiceName($sCONFIRM_BY_EMAIL), 'ShippingClass' => "1_$sCONFIRM_BY_EMAIL", 'ShippingZone' => -1, 'Cost' => 0, 'BasisTotal' => 0, 'OnlineError' => 'Email', 'GFSCarrierAndService' => '', 'InternationalShipping' => $::FALSE }; # # Don't update %::s_hashClassToWeightCost as we don't know the package costs # at this time # } # # Fallback "Base plus Per" table computation # elsif($$::g_pSSPSetupBlob{UseClassDefaultFormula}) { # # Save the error handling # $sOnlineError = 'BasePlusIncrement'; my @arrServiceLevelCodes; if($::s_sDeliveryCountryCode eq 'CA') { push @arrServiceLevelCodes, '11', '07', '08'; #'STD', 'XPR', 'XPD' } elsif($::s_sDeliveryCountryCode eq 'US') { push @arrServiceLevelCodes, '14', '01', '13', '59', '02', '12', '03'; #'1DM', '1DA', '1DAPI'(missing), '1DP', '2DM', '2DA', '3DS', 'GND' } else { push @arrServiceLevelCodes, '07', '08'; #'XPR', 'XPD' } my $sServiceLevelCode; foreach $sServiceLevelCode (@arrServiceLevelCodes) { # # Check if the merchant accepts this service # if(defined $$pSSPProvider{'ServiceLevelCode'}{$sServiceLevelCode}) { my ($nWeight, $nTotalCost); foreach $nWeight (@$parrSortedWeightKeys) { # # Calculate the incremental units # my $nIncrementalUnits = int(($nWeight / $$pSSPProvider{'ServiceLevelCode'}{$sServiceLevelCode}[3]) + 0.999); # # Calculate the fallback cost as base plus charge * increments # my $nIntegralCost = $$pSSPProvider{'ServiceLevelCode'}{$sServiceLevelCode}[1] + ($$pSSPProvider{'ServiceLevelCode'}{$sServiceLevelCode}[2] * $nIncrementalUnits); # # Add package cost * quantity to our total cost # $nTotalCost += $$phashWeightToQuantity{$nWeight} * $nIntegralCost; # # Convert to UPS format # my $dUPSCost = $nIntegralCost / 100; # # Save the pseudo UPS raw response to the shipping info # $::g_ShipInfo{"1_$sServiceLevelCode" . "_$nWeight"} = "UPSOnLine%1.2\%0000%0000Success%4%$sServiceLevelCode%$sShipperPostalCode%US%$sConsigneePostalCode%$sConsigneeCountry%000%1%$dUPSCost%0.00%$dUPSCost%-1"; # # Add to the class to weight/cost hash # $::s_hashClassToWeightCost{"1_$sServiceLevelCode"}{sprintf('%0.03f', $nWeight)} = $nIntegralCost; } # # Convert to UPS format # my $dUPSCost = $nTotalCost / 100; # # Save the pseudo UPS raw response to the shipping info # $::g_ShipInfo{"1_$sServiceLevelCode"} = "UPSOnLine%1.2\%0000%0000Success%4%$sServiceLevelCode%$sShipperPostalCode%US%$sConsigneePostalCode%$sConsigneeCountry%000%1%$dUPSCost%0.00%$dUPSCost%-1"; push @arrShippingHashes, { 'ShippingLabel' => GetUPSServiceName($sServiceLevelCode), 'ShippingClass' => "1_$sServiceLevelCode", 'ShippingZone' => -1, 'Cost' => $nTotalCost, 'BasisTotal' => 0, 'OnlineError' => 'BasePlusIncrement', 'GFSCarrierAndService' => '', 'InternationalShipping' => $::FALSE }; $nRatingType = $::UPS_BASEPLUSPER_CLASSES_USED; } } } # # return reference to the shipping hashes # return($::SUCCESS, '', \@arrShippingHashes, $nRatingType); } ####################################################### # # GetShipmentDetails - Get the request data for UPS RSS # # Returns: 0 - Return Code, # 1 - error message, # 2 - $sServiceLevelCode, # 3 - $sRateChart, # 4 - $sShipperPostalCode, # 5 - $sConsigneePostalCode, # 6 - $sConsigneeCountry, # 7 - $nResidential, # 8 - $sPackagingType) # ####################################################### sub GetShipmentDetails { my ($nReturnCode, $sError, $sServiceLevelCode, $sRateChart, $sShipperPostalCode, $sShipperCountry, $sConsigneePostalCode, $sConsigneeCountry, $nResidential, $sPackagingType); # # Get the UPS hash ref # my $pSSPProvider = GetUPSSetup(); $sRateChart = $$pSSPProvider{'RateChart'}; $sShipperPostalCode = $$pSSPProvider{'ShipperPostalCode'}; $sShipperCountry = $$pSSPProvider{'ShipperCountry'}; $sPackagingType = $$pSSPProvider{'PackagingType'}; $sConsigneePostalCode = $::g_ShipContact{'POSTALCODE'}; # # Get the consignee ISO country code # $sConsigneeCountry = ActinicLocations::GetISODeliveryCountryCode(); if($sConsigneeCountry eq 'CA') { if($sConsigneePostalCode !~ /^(\w\d\w)\s{0,1}(\d\w\d)$/) { # # warn buyer about invalid Canadian postcode format # return($::FAILURE, ACTINIC::GetPhrase(-1, 2149)); } $sConsigneePostalCode =~ s/\s*//g; $sServiceLevelCode = '11'; } elsif($sConsigneeCountry eq 'US') { # # Check the US zip code is in sensible format # my ($nStatus, $sError); ($nStatus, $sError, $sConsigneePostalCode) = GetUS5DigitZipCode($sConsigneePostalCode); if($nStatus == $::FAILURE) { return($nStatus, $sError); } # # On Call Air Pickup and Letter Center is only available for air shipments within US # if($sRateChart eq '07' or $sRateChart eq '19') { $sServiceLevelCode = '02'; } else { $sServiceLevelCode = '03'; } } else { $sServiceLevelCode = '07'; } # # Set the residential flag # $nResidential = $::g_ShipContact{'RESIDENTIAL'} ne '' ? 1 : 0; return($::SUCCESS, '', $sServiceLevelCode, $sRateChart, $sShipperPostalCode, $sShipperCountry, $sConsigneePostalCode, $sConsigneeCountry, $nResidential, $sPackagingType); } ####################################################### # # GetUPSSetup - Return a reference to the UPS setup # # Returns: 0 - reference to the UPS setup hash # ####################################################### sub GetUPSSetup { return($$::g_pSSPSetupBlob{1}); } ####################################################### # # GetUPSServiceName - Return a UPS Service name # # Returns: 0 - reference to the UPS setup hash # ####################################################### sub GetUPSServiceName { my ($sServiceLevelCode) = @_; if($sServiceLevelCode eq $sCONFIRM_BY_EMAIL) { return(ACTINIC::GetPhrase(-1, 2100)); } return($$::g_pSSPSetupBlob{1}{ServiceLevelCode}{$sServiceLevelCode}[0]); } ####################################################### # # CheckUPSAddressValidation - Check the address with UPS # # Any technical failures are ignored, the only errors are invalid # zip code (internal) or mismatched state/cipy/zip (our message but # error is raised by UPS) # # Input: $sConsigneeCountry - delivery country code # $sConsigneeState - delivery ISO state code # $sConsigneeCity - delivery city # $sConsigneePostalCode - delivery zip code # Returns: 1 - result code # 0 - error message if any # ####################################################### sub DoUPSAddressValidation { my ($sConsigneeCountry, $sConsigneeState, $sConsigneeCity, $sConsigneePostalCode) = @_; # # If the country is unknown or not the US # if($sConsigneeCountry ne 'US' || $sConsigneeCountry eq '' || $sConsigneeCountry eq '---') { return($::SUCCESS, ''); } # # Get the UPS hash # my $pSSPProvider = GetUPSSetup(); # # Filter out the non-mainland and Hawaii states # # # Set up an array of UPS-acceptable states # my @arrStates = ( 'AK', 'AL', 'AR', 'AZ', 'CA', 'CO', 'CT', 'DC', 'DE', 'FL', 'GA', 'HI', 'IA', 'ID', 'IL', 'IN', 'KS', 'KY', 'LA', 'MA', 'MD', 'ME', 'MI', 'MN', 'MO', 'MS', 'MT', 'NC', 'ND', 'NE', 'NH', 'NJ', 'NM', 'NV', 'NY', 'OH', 'OK', 'OR', 'PA', 'RI', 'SC', 'SD', 'TN', 'TX', 'UT', 'VA', 'VT', 'WA', 'WI', 'WV', 'WY', ); my $sStatesString = join('|', @arrStates); if($sStatesString !~ $sConsigneeState) { # # Allow our UPS test state to by-pass the 51 states test # # if($sConsigneeState ne 'NOUPS') { # # Only display an error message if we have online rates enabled # if(defined $$pSSPProvider{'RSSEnabled'} && $$pSSPProvider{'RSSEnabled'}) { # # Inform the merchant about the mis-configuration # my $sErrorText = sprintf(ACTINIC::GetPhrase(-1, 2099), ACTINIC::GetCountryName("US.$sConsigneeState")); return($::FAILURE, $sErrorText); } return($::SUCCESS, ''); # not supported so no error } } # # Check the US zip code is in sensible format otherwise tell them off # my ($nStatus, $sError); ($nStatus, $sError, $sConsigneePostalCode) = GetUS5DigitZipCode($sConsigneePostalCode); if($nStatus == $::FAILURE) { return($::FAILURE, $sError); } my (@Response); # # Start building the UPS request # my $pSSPProvider = GetUPSSetup(); my $sAVRequestData = ''; # # Construct header data # $sAVRequestData = $::XML_HEADER; $sAVRequestData .= GetUPSAccessRequestNode($pSSPProvider); # # Construct the request # $sAVRequestData .= $::XML_HEADER; $sAVRequestData .= ""; $sAVRequestData .= GetUPSRequestNode('AV'); # # Construct address information # $sAVRequestData .= "
"; # # Add the state if known # if($sConsigneeState ne '') { # # Strip off the country portion # $sConsigneeState =~ s/^\w\w\.//; $sAVRequestData .= "$sConsigneeState"; } # # Add the city if known # if($sConsigneeCity ne '') { $sAVRequestData .= "$sConsigneeCity"; } # # Add the zip code if known # if($sConsigneePostalCode ne '') { $sAVRequestData .= "$sConsigneePostalCode"; } $sAVRequestData .= "
"; $sAVRequestData .= "
"; # # Set the maximum number of retries before fallback # my $nRetries = 2; # # Testing code to simulate a UPS failure # # if($sConsigneeState eq 'NOUPS') # { # $nRetries = 0; # } # # Try and connect to the UPS site # my ($Result, $sMessage, $pXmlRoot) = UPS_SendAndReceive('/ups.app/xml/AV', $sAVRequestData, $nRetries, 2305); if ($Result != $::SUCCESS) { return ($Result, $sMessage); } # # Process the response list # my $bValidationFailed = $::TRUE; my $raAddressValidationResults = $pXmlRoot->GetChildNodes($::UPS_XML_ADDRESS_VALIDATION_RESULT); my $pXmlAddressValidationResult; foreach $pXmlAddressValidationResult (@{$raAddressValidationResults}) { # # Get the UPS Rank # my $sRank = $pXmlAddressValidationResult->GetChildNode($::UPS_XML_RANK)->GetNodeValue(); # # Get the UPS Quality # my $sQuality = $pXmlAddressValidationResult->GetChildNode($::UPS_XML_QUALITY)->GetNodeValue(); # # Get the UPS State # my $sState = $pXmlAddressValidationResult->GetChildNode($::UPS_XML_ADDRESS)->GetChildNode($::UPS_XML_STATE_PROVINCE_CODE)->GetNodeValue(); # # Get the UPS City # my $sCity = $pXmlAddressValidationResult->GetChildNode($::UPS_XML_ADDRESS)->GetChildNode($::UPS_XML_CITY)->GetNodeValue(); # # Get the UPS PostalCodeLow # my $sPostalCodeLow = $pXmlAddressValidationResult->GetChildNode($::UPS_XML_POSTAL_CODE_LOW_END)->GetNodeValue(); # # Get the UPS PostalCodeHigh # my $sPostalCodeHigh = $pXmlAddressValidationResult->GetChildNode($::UPS_XML_POSTAL_CODE_HIGH_END)->GetNodeValue(); # # If we find a suitable address then the user-specified address is valid # if($sState eq $sConsigneeState && ( (lc($sCity) eq lc($sConsigneeCity) || $sConsigneeCity eq '')) && ($sConsigneePostalCode eq $sPostalCodeLow || ($sConsigneePostalCode gt $sPostalCodeLow && $sPostalCodeHigh ne '' && $sConsigneePostalCode le $sPostalCodeHigh))) { $bValidationFailed = $::FALSE; } } # # If we got a valid response from UPS, but the validation failed # report the error # if($bValidationFailed) { my $sErrorText = ACTINIC::GetPhrase(-1, 2305, ACTINIC::GetPhrase(-1, 2072)); return($::BADDATA, $sErrorText); } return($::SUCCESS, ''); } ####################################################### # # UPS_SendAndReceive - send some data to the UPS server # and do some error handling on the response # # Params: 0 - the path on the UPS server # 1 - the message to be sent # 2 - max. number of attempts to connect # 3 - error phrase ID for response error display # # Returns: 0 - result # 1 - message # 2 - reference to the UPS response xml node # # Author: Tibor Vajda # ####################################################### sub UPS_SendAndReceive { #? ACTINIC::ASSERT($#_ == 3, "Invalid argument count in UPS_SendAndReceive ($#_)", __LINE__, __FILE__); # # Grab parameters # my ($sPath, $sRequestData, $nRetries, $nErrorTitlePhrase) = @_; # # Try and connect to the UPS site # my (@Response, $sHTTPResponse, $sHTTPHeader, $sHTTPContent, $phashHeader); while($nRetries && $bUPS_Available) # UPS was available at the previous function call { @Response = ACTINIC::HTTPS_SendAndReceive('onlinetools.ups.com', 443, $sPath, $sRequestData, 'POST', $::FALSE, $ssl_socket); if($Response[0] != $::SUCCESS || $Response[2] eq '') { $nRetries--; # one less time } else # success { $sHTTPResponse = $Response[2]; $ssl_socket = $Response[3]; last; # leave the retry loop } } unless ($sHTTPResponse) { $bUPS_Available = $::FALSE; # to remember that the server is unavailable return($::FAILURE, $Response[1]); } # # Split the HTTP response up # @Response = ACTINIC::HTTP_SplitHeaderAndContent($sHTTPResponse); if($Response[0] != $::TRUE) { return($::FAILURE, $Response[1]); } # # Store the successful response # $sHTTPHeader = $Response[3]; $sHTTPContent = $Response[4]; $phashHeader = $Response[5]; # # Check we have a content type # my $sContentType = $$phashHeader{'Content-Type'}; unless($sContentType) { return($::FAILURE, ACTINIC::GetPhrase(-1, 2293)); } # # Ignore text/html for Datastream messages # if($sContentType =~ /application\/xml/) { my $pParser = new PXML(); my ($sParsedText, $pXmlRoot) = $pParser->Parse($sHTTPContent); $pXmlRoot = $pXmlRoot->[0]; # # Check for errors # my ($Result, $sMessage) = ParseUPSResponseNode($pXmlRoot->GetChildNode($::UPS_XML_RESPONSE), $nErrorTitlePhrase); return($Result, $sMessage, $pXmlRoot); } return($::FAILURE, ACTINIC::GetPhrase(-1, 2293)); } ####################################################### # # GetUPSAccessRequestNode - Construct the access request xml node # # Params: 0 - SSP provider blob hash # # Returns: 0 - access request xml node text # # Author: Tibor Vajda # ####################################################### sub GetUPSAccessRequestNode { my ($pSSPProvider) = @_; my $sAccessKey = ACTINIC::DecodeXOREncryption($$pSSPProvider{AccessKey}, $::UPS_ENCRYPT_PASSWORD); my $sUserName = ACTINIC::DecodeXOREncryption($$pSSPProvider{UserName}, $::UPS_ENCRYPT_PASSWORD); my $sPassword = ACTINIC::DecodeXOREncryption($$pSSPProvider{Password}, $::UPS_ENCRYPT_PASSWORD); my $sAccessRequestNode = ''; $sAccessRequestNode .= ""; $sAccessRequestNode .= "$sAccessKey"; $sAccessRequestNode .= "$sUserName"; $sAccessRequestNode .= "$sPassword"; $sAccessRequestNode .= ""; return $sAccessRequestNode; } ####################################################### # # GetUPSAccessRequestNode - Construct the access request xml node # # Params: 0 - SSP provider blob hash # # Returns: 0 - access request xml node text # # Author: Tibor Vajda # ####################################################### sub GetUPSRequestNode { my ($sAction, $sOption) = @_; my $sRequestNode = ''; $sRequestNode .= ""; $sRequestNode .= ""; $sRequestNode .= "$::UPS_XPCI_VERSION"; $sRequestNode .= ""; $sRequestNode .= "$sAction"; if (defined $sOption) { $sRequestNode .= "$sOption"; } $sRequestNode .= ""; return $sRequestNode; } ####################################################### # # ParseUPSResponseNode - Check e.g. if response has error # # Params: 0 - UPS response xml node # # Returns: 0 - result # $::SUCCESS if OK # $::BADDATA if the response has a # 1 - error string # # Author: Tibor Vajda # ####################################################### sub ParseUPSResponseNode { my ($pXmlResponse, $nErrorTitlePhrase) = @_; my $pXmlStatusCode = $pXmlResponse->GetChildNode($::UPS_XML_RESPONSE_STATUS_CODE); if (!defined($pXmlStatusCode)) { return ($::FAILURE, ACTINIC::GetPhrase(-1, $nErrorTitlePhrase, ACTINIC::GetPhrase(-1, 2294))); # malformed xml error } # # Check if everything went fine # if ($pXmlStatusCode->GetNodeValue() eq $::UPS_SUCCESSFUL) { return($::SUCCESS, '') } # # There was some problem - look at them # my $paXmlErrors = $pXmlResponse->GetChildNodes($::UPS_XML_ERROR); my $pXmlError; foreach $pXmlError (@$paXmlErrors) { # # Extract severity # my $pXmlErrorSeverity = $pXmlError->GetChildNode($::UPS_XML_ERROR_SEVERITY); if (!defined($pXmlErrorSeverity)) { return ($::FAILURE, ACTINIC::GetPhrase(-1, $nErrorTitlePhrase, ACTINIC::GetPhrase(-1, 2294))); # malformed xml error } my $sSeverity = $pXmlErrorSeverity->GetNodeValue(); # # Extract description # my $pXmlErrorDescription = $pXmlError->GetChildNode($::UPS_XML_ERROR_DESCRIPTION); if (!defined($pXmlErrorDescription)) { return ($::FAILURE, ACTINIC::GetPhrase(-1, $nErrorTitlePhrase, ACTINIC::GetPhrase(-1, 2294))); # malformed xml error } my $sErrorDescription = $pXmlErrorDescription->GetNodeValue(); # # Handle different kind of severities # if ($sSeverity eq $::UPS_ERROR_SEVERITY_HARD_ERROR) # hard error probably due to the info provided { return ($::BADDATA, ACTINIC::GetPhrase(-1, $nErrorTitlePhrase, $sErrorDescription)); } elsif ($sSeverity eq $::UPS_ERROR_SEVERITY_TRANSIENT_ERROR) # temporary server problem - failure and not bad data { return ($::FAILURE, ACTINIC::GetPhrase(-1, $nErrorTitlePhrase, $sErrorDescription)); } elsif ($sSeverity eq $::UPS_ERROR_SEVERITY_WARNING) # not an error { # # We treat it as success ATM # } else { return ($::FAILURE, ACTINIC::GetPhrase(-1, $nErrorTitlePhrase, ACTINIC::GetPhrase(-1, 2294))); # malformed xml error } } # # There were no serious errors, so return success # return($::SUCCESS, '') } #------------------------------------------------------ # # End of UPS functions # #------------------------------------------------------ #------------------------------------------------------ # # DPD functions # #------------------------------------------------------ ###################################################################### # # GetGeoSession - DPD authorization request, fetches geosession ID # # Returns 0 - status $::SUCCESS or $::FAILURE # 1 - error message if not $::SUCCESS # 2 - geosession ID # ###################################################################### sub GetGeoSession { my $SSLConnection = SSLConnection->new($::DPD_HOST, $::DPD_SSL_PORT, $::DPD_LOGIN_URL); $SSLConnection->SetRequestMethod("POST"); $SSLConnection->SetHeaderValue("Content-Type", "application/json"); $SSLConnection->SetHeaderValue("Accept", "application/json"); $SSLConnection->SetHeaderValue("Authorization", "Basic $::sAuthorization"); $SSLConnection->SetHeaderValue("GEOClient", "account/$::sAccount"); $SSLConnection->SetRequestTimeout(5); # set timeout to 2 seconds $SSLConnection->SendRequest(""); # # Due to the way the error handling was done connection status # also means not 200 OK so we need to check the response code first # if ($SSLConnection->GetResponseCode() != 200) { # # For the lookup the error is not meaningful to the buyer # In this case we show the error only in the error file # my $nRetCode = $SSLConnection->GetResponseCode(); if (401 == $nRetCode) { return ($::FAILURE, "DPD authorization error: $nRetCode", ""); } else { return ($::FAILURE, "DPD integration error: $nRetCode", ""); } } if ($SSLConnection->GetConnectStatus() == $::FALSE) { return ($::FAILURE, sprintf("%s (%s) %s", "DPD connection failed:", $SSLConnection->GetResponseCode(), $SSLConnection->GetConnectErrorMessage(), "")); } # # Now fetch the content as key value pairs # my $sGeoSession = ""; if (ref($SSLConnection->GetResponseJSON()) eq 'HASH') { my ($sError, $sType) = GetServerError($SSLConnection->GetResponseJSON()); if ($sError ne "") { return ($::FAILURE, "DPD returned an error. $sError", "", "", $sType); } $sGeoSession = $SSLConnection->GetResponseJSON()->{'data'}->{'geoSession'}; if ($sGeoSession eq "") # no geo session? try to get dpdSession then { $sGeoSession = $SSLConnection->GetResponseJSON()->{'data'}->{'dpdsession'}; } # # Create the blob now with a hash of available finance product for this account # } else { return ($::FAILURE, "Response format error for the DPD request", ""); } return ($::SUCCESS, "", $sGeoSession); } ###################################################################### # # GetAvailableDPDServices - Fetch the DPD services # available for this account # # Input: 0 - package count # 1 - weight total # # Returns 0 - status $::SUCCESS or $::FAILURE # 1 - error message if not $::SUCCESS # 2 - hash of services to service codes # 3 - hash of service codes to services # 4 - error type if any # ###################################################################### sub GetAvailableDPDServices { my ($nParcels, $dTotalWeight) = @_; my @Response = GetGeoSession(); if ($Response[0] != $::SUCCESS) { return ($::FAILURE, $Response[1], ""); } $::sGeoSessionID = $Response[2]; # # Get a secure connection # my $sCountryCode = $::g_LocationInfo{DELIVERY_COUNTRY_CODE}; if ($sCountryCode eq 'UK') { $sCountryCode =~ s/^UK$/GB/; } my $sGetParams = "deliveryDirection=1"; # 1 - outbound, 2 - inbound $sGetParams .= "&numberOfParcels=$nParcels"; $sGetParams .= "&shipmentType=0"; # 0 - default, 1 - collection on delivery, 2 - swap it service $sGetParams .= "&totalWeight=$dTotalWeight"; $sGetParams .= "&deliveryDetails.address.countryCode=$sCountryCode"; $sGetParams .= "&deliveryDetails.address.countryName=" . ACTINIC::EncodeText2($::g_ShipContact{'COUNTRY'}, $::FALSE); $sGetParams .= "&deliveryDetails.address.locality=" . ACTINIC::EncodeText2($::g_ShipContact{'ADDRESS2'}, $::FALSE); $sGetParams .= "&deliveryDetails.address.organisation=" . ACTINIC::EncodeText2($::g_ShipContact{'COMPANY'}, $::FALSE); $sGetParams .= "&deliveryDetails.address.postcode=" . ACTINIC::EncodeText2($::g_ShipContact{'POSTALCODE'}, $::FALSE); $sGetParams .= "&deliveryDetails.address.property="; $sGetParams .= "&deliveryDetails.address.street=" . ACTINIC::EncodeText2($::g_ShipContact{'ADDRESS1'}, $::FALSE); $sGetParams .= "&deliveryDetails.address.town=" . ACTINIC::EncodeText2($::g_ShipContact{'ADDRESS3'}, $::FALSE); $sGetParams .= "&deliveryDetails.address.county=" . ACTINIC::EncodeText2($::g_ShipContact{'ADDRESS4'}, $::FALSE); # # Collection details set to the merchant address # $sCountryCode = $$::g_pSetupBlob{'MERCHANT_COUNTRY_CODE'}; if ($sCountryCode eq 'UK') { $sCountryCode =~ s/^UK$/GB/; } $sGetParams .= "&collectionDetails.address.countryCode=$sCountryCode"; $sGetParams .= "&collectionDetails.address.countryName=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'COUNTRY'}, $::FALSE); $sGetParams .= "&collectionDetails.address.locality=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'ADDRESS_2'}, $::FALSE); $sGetParams .= "&collectionDetails.address.organisation=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'COMPANY_NAME'}, $::FALSE); $sGetParams .= "&collectionDetails.address.postcode=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'POSTAL_CODE'}, $::FALSE); $sGetParams .= "&collectionDetails.address.property="; $sGetParams .= "&collectionDetails.address.street=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'ADDRESS_1'}, $::FALSE); $sGetParams .= "&collectionDetails.address.town=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'ADDRESS_3'}, $::FALSE); $sGetParams .= "&collectionDetails.address.county=" . ACTINIC::EncodeText2($$::g_pSetupBlob{'ADDRESS_4'}, $::FALSE); my $SSLConnection = SSLConnection->new($::DPD_HOST, $::DPD_SSL_PORT, $::DPD_GET_SERVICES_URL . $sGetParams); $SSLConnection->SetRequestMethod("GET"); $SSLConnection->SetHeaderValue("Content-Type", "application/json"); $SSLConnection->SetHeaderValue("Accept", "application/json"); $SSLConnection->SetHeaderValue("GEOClient", "account/$::sAccount"); $SSLConnection->SetHeaderValue("GeoSession", "$Response[2]"); $SSLConnection->SetRequestTimeout(5); # set timeout to 5 seconds $SSLConnection->SendRequest(""); if ($SSLConnection->GetResponseCode() != 200) { my $RetCode = $SSLConnection->GetResponseCode(); my ($sMsg, $sType) = GetServerError($SSLConnection->GetResponseJSON()); return ($::FAILURE, "DPD integration error: $RetCode." . $sMsg, ""); } if ($SSLConnection->GetConnectStatus() == $::FALSE) { return ($::FAILURE, sprintf("%s (%s) %s", "DPD connection failed:", $SSLConnection->GetResponseCode(), $SSLConnection->GetConnectErrorMessage(), "")); } # # Now fetch the content as key value pairs # my (%hashServiceCodes, %hashServices); if (ref($SSLConnection->GetResponseJSON()) eq 'HASH') { my ($sError, $sType) = GetServerError($SSLConnection->GetResponseJSON()); if ($sError ne "") { return ($::FAILURE, "DPD returned an error. Error message:$sError", "", "", $sType); } # # Get and store the JSON response not the hash # my $ServiceItem; if (ref($SSLConnection->GetResponseJSON()->{'data'}) eq 'ARRAY') { foreach $ServiceItem(@{$SSLConnection->GetResponseJSON()->{'data'}}) { if (!exists $ServiceItem->{'network'}) { return ($::FAILURE, "Response format error for the DPD request", ""); } my ($sDesc, $sCode); $sDesc = $ServiceItem->{'network'}->{'networkDescription'}; $sCode = $ServiceItem->{'network'}->{'networkCode'}; $hashServices{$sDesc} = $sCode; $hashServiceCodes{$sCode} = $sDesc; } } } else { return ($::FAILURE, "Response format error for the DPD request", ""); } return ($::SUCCESS, "", \%hashServices, \%hashServiceCodes, ""); } ###################################################################### # # GetServerError - Get the server error message # # Input 0 - hash of error # # Returns 0 - error message # 1 - error type # ###################################################################### sub GetServerError { my ($hashErrors) = shift; # # Expecting a hash key 'error' which should contain an array of errors # Each error consists of a hash of keys # errorCode # errorMessage # errorType # obj # my ($sErrorMessage, $sType); if ((ref($hashErrors) eq 'HASH') && (defined $hashErrors->{'error'}) && (ref($hashErrors->{'error'}) eq 'HASH')) { my $sError = sprintf("%s error, %s (code %s). Field: %s.", $hashErrors->{'error'}->{'errorType'}, $hashErrors->{'error'}->{'errorMessage'}, $hashErrors->{'error'}->{'errorCode'}, $hashErrors->{'error'}->{'obj'}); $sErrorMessage .= $sError; $sType = $hashErrors->{'error'}->{'errorType'}; } return ($sErrorMessage, $sType); } ###################################################################### # # GetPickupLocations - Get the server error message # # Input 0 - geosession ID # 1 - postcode from session # 2 - country code from session # # Returns 0 - success or failure # 1 - error message if any # hash of pickup locations # ###################################################################### sub GetPickupLocations { my ($sGeoSession, $sPostalCode, $sCountryCode) = @_; # # Get a secure connection # my $sGetParams = "filter=nearAddress"; if ($sCountryCode eq 'UK') { $sCountryCode =~ s/^UK$/GB/; } $sGetParams .= "&countryCode=$sCountryCode"; $sGetParams .= "&searchPageSize=$::DPD_MAX_RESULTS"; $sGetParams .= "&searchPage=1&searchCriteria=&maxDistance=10"; $sGetParams .= "&searchAddress=" . ACTINIC::EncodeText2($sPostalCode); my $SSLConnection = SSLConnection->new($::DPD_GROUP_HOST, $::DPD_SSL_PORT, $::DPD_GET_PICKUP_LOCATIONS . $sGetParams); $SSLConnection->SetRequestMethod("GET"); $SSLConnection->SetHeaderValue("Content-Type", "application/json"); $SSLConnection->SetHeaderValue("Accept", "application/json"); $SSLConnection->SetHeaderValue("GEOClient", "account/$::sAccount"); $SSLConnection->SetHeaderValue("GeoSession", "$sGeoSession"); $SSLConnection->SetRequestTimeout(5); # set timeout to 2 seconds $SSLConnection->SendRequest(""); # # Due to the way the error handling was done connection status # also means not 200 OK so we need to check the response code first # if ($SSLConnection->GetResponseCode() != 200) { # # For the lookup the error is not meaningful to the buyer # In this case we show the error only in the error file # my $RetCode = $SSLConnection->GetResponseCode(); my ($sMsg, $sType) = GetServerError($SSLConnection->GetResponseJSON()); my $sError = "DPD integration error: $RetCode" . $sMsg; ACTINIC::RecordErrors($sError, ACTINIC::GetPath()); return ($::FAILURE, $sError); } if ($SSLConnection->GetConnectStatus() == $::FALSE) { my $sError = sprintf("%s (%s) %s", "DPD connection failed:", $SSLConnection->GetResponseCode(), $SSLConnection->GetConnectErrorMessage()); ACTINIC::RecordErrors($sError, ACTINIC::GetPath()); return ($::FAILURE, $sError); } # # Now fetch the content # my $sJsonText = ""; if (ref($SSLConnection->GetResponseJSON()) eq 'HASH') { $sJsonText = $SSLConnection->GetResponseContent(); # original json returned } else { return ($::FAILURE, "DPD response format error"); } return ($::SUCCESS, $sJsonText); } #------------------------------------------------------ # # End of DPD functions # #------------------------------------------------------ return ($::SUCCESS); # # End of ShippingTemplate.pl # # # End of File