################################################################ # # ShippingTemplate.pl - code part of Shipping # # *** Do not change this code unless you know what you are doing *** # # Written by Kevin Grumball # Revised by Mike Purnell November 2001 # # Copyright (c) Actinic Software Ltd 1998-2001 All rights reserved # # This script is called by an eval() function and it will already # have the following variables set up: # # Expects: %::g_InputHash - contains the input parameters (only for validation modes) # @::s_Ship_sShipProducts - list of product IDs # @::s_Ship_nShipQuantities - list of quantities (to match ProductIDs) # @::s_Ship_nShipPrices - list of unit prices (to match ProductIDs) # %::s_Ship_PriceFormatBlob - the price format data # $::s_Ship_sOpaqueShipData - contains user shipping selection # $::s_sDeliveryCountryCode - contains shipping address country code # $::s_sDeliveryRegionCode - contains shipping address region code # $::s_Ship_bDisplayPrices - flag indicating whether or not the prices are visible # %::s_Ship_OpaqueDataTables - product opaque data table # $::s_Ship_nSubTotal - product sub-total # # Affects: $::s_Ship_sOpaqueShipData - contains user shipping selection # $::s_Ship_sOpaqueHandleData - contains user handling selection # %::s_Ship_nShippingStatus - hash table containing the return codes for the # various functions of the script. Valid keys are: # ValidatePreliminaryInput, ValidateFinalInput, # RestoreFinalUI, CalculateShipping, # IsFinalPhaseHidden, GetShippingDescription, # GetHandlingDescription, or CalculateHandling. # Valid values are: # $::SUCCESS - OK, $::FAILURE - error # %::s_Ship_sShippingError - hash table containing the error messages for the various # functions of the script. Valid keys are the same as for # %::s_Ship_sShippingStatus. # %::s_Ship_PreliminaryInfoVariables - hash where the keys are lists of strings # to replace in the HTML and values are the new HTML strings # %::s_Ship_ShippingVariables - hash where the keys are lists of strings # to replace in the HTML and values are the new HTML strings # $::s_Ship_bShipPhaseIsHidden - $::TRUE if the shipping phase is hidden # $::s_Ship_sShippingDescription - the selected shipping method description # $::s_Ship_sHandlingDescription - the selected handling method description # $::s_Ship_sShippingCountryName - the country the customer selected # $::s_Ship_nShipCharges - the shipping total for this order # $::s_Ship_nHandlingCharges - the handling total for this order # $::s_Ship_bDisplayExtraCartInformation - determine whether the extra cart xml tag should be displayed or not # %::s_Ship_aShippingClassProviderIDs - provider ids for which the extra shipping xml tag should be displayed # %::s_Ship_aBasePlusPerProviderIDs - provider ids for which the extra base plus per reclaiming xml tag should be displayed # # $Revision: 101 $ # ################################################################ 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_nShippingStatus{GetHandlingDescription} = $::SUCCESS; $::s_Ship_sShippingError{GetHandlingDescription} = ''; $::s_Ship_bDisplayExtraCartInformation = $::FALSE; %::s_Ship_hShippingClassProviderIDs = (); %::s_Ship_hBasePlusPerProviderIDs = (); $::s_Ship_nSSPProviderID = -1; # # 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 # local @::s_arrSortedShippingHashes; # # 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 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 { # if($nReturnCode == $::SUCCESS) # if the previous function succeeded { my $pFunction = $$parrFunction[0]; ($nReturnCode, $sError) = &$pFunction(); # call this function } # # Save the status and error if any # $::s_Ship_nShippingStatus{$$parrFunction[1]} = $nReturnCode; $::s_Ship_sShippingError{$$parrFunction[1]} = $sError; } SaveSelectionToOpaqueData(); 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'}) { my $sCity = ''; if(defined $::g_InputHash{DELIVERADDRESS3}) { $sCity = $::g_InputHash{DELIVERADDRESS3}; } elsif(defined $::g_InputHash{INVOICEADDRESS3} && $::g_LocationInfo{SEPARATESHIP} eq '') { $sCity = $::g_InputHash{INVOICEADDRESS3}; } # # 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, $parrShipSeparatePackages, $parrMixedPackages); if(@::s_arrSortedShippingHashes == 0) { # # Calculate the (multi-package) shipping # ($nReturnCode, $sError, $parrShipSeparatePackages, $parrMixedPackages) = CalculateMultiPackageShipping(); if($nReturnCode != $::SUCCESS) { return($nReturnCode, $sError); } } SaveSelectionToOpaqueData($parrShipSeparatePackages, $parrMixedPackages); # 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)'; if(@::s_arrSortedShippingHashes == 1) # if there's only one option { $phashShipping = $::s_arrSortedShippingHashes[0]; # # Handle the label by appending the cost if we're displaying prices # $sClassLabel = $$phashShipping{ShippingLabel}; if ($::s_Ship_bDisplayPrices) # displaying prices? { my (@PriceResponse) = ActinicOrder::FormatPrice($$phashShipping{Cost}, $::TRUE, \%::s_Ship_PriceFormatBlob); $sClassLabel .= sprintf($sPriceLabelFormat, $PriceResponse[2]); # add the price to the label } # # Format as a HIDDEN tag # $sSelectHTML = sprintf("%s\n", $sClassLabel, $$phashShipping{ShippingClass}); } else { # # Start the SELECT tag # $sSelectHTML = ""; # CHD moved this expression out of the quotes \n", # CHD changed the
%s
} # # Determine which trademarks, disclaimers should be displayed # if($hSSPUsed{$::UPS_CLASSES_USED} == $::TRUE) { $::s_Ship_hShippingClassProviderIDs{1} = $::TRUE; } elsif ($hSSPUsed{$::UPS_BASEPLUSPER_CLASSES_USED} == $::TRUE) { $::s_Ship_hBasePlusPerProviderIDs{1} = $::TRUE; } $::s_Ship_ShippingVariables{$::VARPREFIX . 'SHIPPINGSELECT'} = $sSelectHTML; return($::SUCCESS, undef); } ####################################################### # # CalculateShipping # Get the possible zones for this country and region # There may be more than one possible zone and we can # select the shipping band based on the class of shipping. # # Returns: 0 - status # 1 - message (if any) # ####################################################### sub CalculateShipping { # # For simple shipping, we just apply the single value # if ($ShippingBasis eq 'Simple') # Simple shipping { return(SimpleCalculateShipping()); } # # If there are no hashes in the sorted array # if(@::s_arrSortedShippingHashes == 0) { return($::SUCCESS, undef); } # # Handle a selected UPS class # if($::s_hashShipData{'ShippingClass'} =~ /^(\d+)_(.+)/) { $::s_Ship_nSSPProviderID = $1; # # Check if this is an error class # my $bSSPError = $2 eq $sCONFIRM_BY_EMAIL; my $pSSPProvider = GetUPSSetup(); $::s_Ship_sSSPOpaqueShipData = sprintf("SSPID=%d;SSPClassRef=%s;OrigZip=%s;OrigCntry=%s;OrigCntryDesc=%s;Pack=%s;Rate=%s;Weight=%.03f;DestCntry=%s;DestPost=%s;Residential=%s;", $::s_Ship_nSSPProviderID, $2, $$pSSPProvider{ShipperPostalCode}, $$pSSPProvider{ShipperCountry}, ACTINIC::GetCountryName($$pSSPProvider{ShipperCountry}), $$pSSPProvider{'PackagingType'}, $$pSSPProvider{'RateChart'}, $::s_hashShipData{BasisTotal}, $::s_sDeliveryCountryCode, $::g_ShipContact{'POSTALCODE'}, $::g_LocationInfo{DELIVERRESIDENTIAL} ne '' ? 1 : 0 ); if($::s_Ship_nSSPProviderID == 1) { if(!$bSSPError) { $::s_Ship_bDisplayExtraCartInformation = $::TRUE; } } } return($::SUCCESS, undef); # It succeeded } ####################################################### # # IsFinalPhaseHidden - is the final shipping phase # hidden. Yes if there is only one payment option # # Returns: 0 - status # 1 - message (if any) # ####################################################### sub IsFinalPhaseHidden { # # Simple mode # if ($ShippingBasis eq 'Simple') # we are in simple mode { return($::SUCCESS, undef); # default visible } # # Hide the phase if there's only one option # if(@::s_arrSortedShippingHashes == 1) { $::s_Ship_bShipPhaseIsHidden = $::TRUE; # hide the pointless phase } return($::SUCCESS, undef); # default visible } ####################################################### # # GetShippingDescription - retrieve the description # # Returns: 0 - status # 1 - message (if any) # ####################################################### sub GetShippingDescription { if(defined $::s_hashShipData{ShippingLabel}) # if we have a label defined { $::s_Ship_sShippingDescription = $::s_hashShipData{ShippingLabel}; # use it } else { $::s_Ship_sShippingDescription = ''; # empty string } return($::SUCCESS, undef); } ####################################################### # # CalculateHandling - calculate the handling value # # Returns: 0 - status # 1 - message (if any) # ####################################################### sub CalculateHandling { # # handling charges are simply a flat value plus a percentage of the shipping charge. Since Actinic stores # 2 decimal percentages as ints, the actual percentage value is the number / 100 (for decimals) / 100 (for percent) # $::s_Ship_nHandlingCharges = $nHandlingCharge + int ($::s_Ship_nShipCharges * $nHandlingProportion / $ActinicOrder::PERCENTOFFSET); # # store the current handling value in our opaque data for future reference # $::s_Ship_sOpaqueHandleData = sprintf("Handling;%d;", $::s_Ship_nHandlingCharges); return ($::SUCCESS, undef); } #------------------------------------------------------ # # 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 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); # # 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]; } 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]; } 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 # #------------------------------------------------------ ####################################################### # # GetShippingBasisTotal - Get the total based upon the shipping basis # # Returns: the basis total # ####################################################### sub GetShippingBasisTotal { my $nTotalBasis = 0; if ($ShippingBasis eq 'Quantity') # Quantity based shipping { $nTotalBasis = CalculateQuantity(); # Calculate total number of items } elsif ($ShippingBasis eq 'Price') # Price based shipping { $nTotalBasis = CalculatePrice(); # Calculate total price } elsif ($ShippingBasis eq 'Weight') # Weight-based pricing { $nTotalBasis = CalculateWeight(); # Calculate total weight } return($nTotalBasis); } ################################################################ # # CalculateWeight - get the total weight of products # # Expects: @::s_Ship_sShipProducts - List of product IDs # @::s_Ship_nShipQuantities - List of quantities (to match ProductIDs) # %::s_Ship_OpaqueDataTables - product opaque data table # $DefaultWeight - default weight to use # # Returns: Total weight # ################################################################ sub CalculateWeight { my $j; if (defined $::s_Ship_nTotalWeight) { return ($::s_Ship_nTotalWeight); } $::s_Ship_nTotalWeight = 0; for $j (0 .. $#::s_Ship_sShipProducts) { # # If we have a weight specified for that product ID # then we use it # Test for a null string so that any value- including 0 - can be used for the # product weight - a null sting is value undefined # if ("" ne $::s_Ship_OpaqueDataTables{$::s_Ship_sShipProducts[$j]}) # If we have a weight { $::s_Ship_nTotalWeight += $::s_Ship_OpaqueDataTables{$::s_Ship_sShipProducts[$j]} * $::s_Ship_nShipQuantities[$j]; } # # If not, we use the default weight # else { $::s_Ship_nTotalWeight += $DefaultWeight * $::s_Ship_nShipQuantities[$j]; # Use default weight } } return($::s_Ship_nTotalWeight); } ################################################################ # # 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); } ################################################################ # # CalculatePrice - get the total price of products # # Expects: @::s_Ship_sShipProducts - List of product IDs # @::s_Ship_nShipQuantities - List of quantities (to match ProductIDs) # @::s_Ship_nShipPrices - List of prices (to match ProductIDs) # # Returns: Total price of goods # ################################################################ sub CalculatePrice { my $j; if (defined $::s_Ship_nTotalPrice) { return ($::s_Ship_nTotalPrice); } if (defined $::s_Ship_nSubTotal) { return ($::s_Ship_nSubTotal); } $::s_Ship_nTotalPrice = 0; for $j (0 .. $#::s_Ship_sShipProducts) { $::s_Ship_nTotalPrice += ($::s_Ship_nShipPrices[$j] * $::s_Ship_nShipQuantities[$j]); # Add units * price } return($::s_Ship_nTotalPrice); } ####################################################### # # GetBands - retrieve the band for this region # # Returns: 0+ - band list # ####################################################### sub GetBands { if ($::s_sDeliveryRegionCode eq "" || # if the state is undefined $::s_sDeliveryRegionCode eq $UNDEFINED) { if ($#{$ParentZoneTable{$::s_sDeliveryCountryCode}} != -1) # if this parent zone table has any entries { return (@{$ParentZoneTable{$::s_sDeliveryCountryCode}}); # return this list (has invalid entries stripped) } } # # If we have a zone hash entry for the delivery country # if(defined $ZoneTable{$::s_sDeliveryCountryCode}) { # # See if there is an entry for the region code as it is # if(defined $ZoneTable{$::s_sDeliveryCountryCode}{$::s_sDeliveryRegionCode}) { return(@{ $ZoneTable{$::s_sDeliveryCountryCode}{$::s_sDeliveryRegionCode} }); } # # It failed so let's see if the location is a sub-district and try # the parent state/province # my $sParentState = ActinicLocations::GetDeliveryParentRegionCode(); if($sParentState ne '' && # if we have something $sParentState ne $::s_sDeliveryRegionCode && # and it's different from the original code defined $ZoneTable{$::s_sDeliveryCountryCode}{$sParentState}) # and there's an entry for it { return(@{ $ZoneTable{$::s_sDeliveryCountryCode}{$sParentState} }); # return the bands } # # See if there is an entry for the country code with an undefined region # if(defined $ZoneTable{$::s_sDeliveryCountryCode}{$UNDEFINED}) { return(@{ $ZoneTable{$::s_sDeliveryCountryCode}{$UNDEFINED} }); } } # # Return an empty list # my @listEmpty = (); return(@listEmpty); } ####################################################### # # GetSSPProviderList - Get the list of SSP providers for this country # # Input: $sCountryCode - country code # # Returns: 0 - list of providers # ####################################################### sub GetSSPProviderList { my ($sCountryCode) = @_; my @arrReturn; # # If we have supported regions and the delivery country is supported # get the list of providers # if(defined $$::g_pSSPSetupBlob{SupportedRegions} && defined $$::g_pSSPSetupBlob{SupportedRegions}{$sCountryCode}) { my $nProviderID; foreach $nProviderID ($$::g_pSSPSetupBlob{SupportedRegions}{$sCountryCode}) { push(@arrReturn, $nProviderID); } } return (\@arrReturn); } ####################################################### # # GetUS5DigitZipCode - Returns a 5 digit zip code or an # error if format un-recognised # # Input: $sZipCode - zip code # # Returns: 0 - $::SUCCESS or $::FAILURE # 1 - error message # 2 - 5 digit zip code # ####################################################### sub GetUS5DigitZipCode { my ($sZipCode) = @_; # # Check the US and Puerto Rico zip code is in a sensible format # if($sZipCode !~ /^\d{5}$/ && $sZipCode !~ /^\d{5}-\d{4}$/ && $sZipCode !~ /^\d{9}$/) { # # Tell buyer about US and PR zip format # return($::FAILURE, ACTINIC::GetPhrase(-1, 2150)); } # # Use the first 5 digits of the zip code # $sZipCode = substr($sZipCode, 0, 5); return($::SUCCESS, '', $sZipCode); } ################################################################ # # CalculatePackageShipping - calculate the cost of a single package # for a given zone and class # # Input: $nZoneID - the zone ID # $nClassID - the class ID # $dWeight - the weight of a package # # 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, $dWeight) = @_; # # Set up our initial values # my $nCost = 0; my $bWeightOK = $::TRUE; my $dMaxWeight = 0.0; my $nHighestCost = 0; # # 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 $nHighestCost = $$phashBandEntry{cost}; # and the cost for max weight } # # Check the maximum weight defined against our package weight # if($dWeight > $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 = $dWeight - $dMaxWeight; # get the excess weight my ($dWeightIncrement, $nChargeIncrement) = ($$phashExcessAction{'IncrementalWeight'}, $$phashExcessAction{'IncrementalCharge'}); # 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} >= $dWeight) # inside the weight? { $nCost = $$phashBandEntry{cost}; # found our cost last; } } } return($bWeightOK, $nCost); } ################################################################ # # CalculateMultiPackageShipping - a hash of product weights to # quantity and package cost # # 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 # $DefaultWeight - default weight to use # # 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 ($phashWeightToQuantity, $parrSortedWeightKeys, $sWeightList, $parrShipSeparatePackages, $parrMixedPackages) = DivideIntoPackages(); # split into packages # # 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()); } my $parrZoneClass; my @arrShippingHashes; foreach $parrZoneClass (@$parrZonesClasses) # go through all zone/class combinations { my $nTotalCost = 0; my ($nZoneID, $nClassID) = @$parrZoneClass; # split into zone and class my ($bWeightOK, $nPackageCost); foreach $dWeight (@$parrSortedWeightKeys) # go through our sorted weights { ($bWeightOK, $nPackageCost) = CalculatePackageShipping($nZoneID, $nClassID, $dWeight); # calculate the cost for this weight if($bWeightOK) # the weight was OK? { $nTotalCost += $$phashWeightToQuantity{$dWeight} * $nPackageCost; # add quantity * cost to total # # Add to the class to weight/cost hash # $::s_hashClassToWeightCost{$nClassID}{sprintf('%0.03f', $dWeight)} = $nPackageCost; } else # weight was too big { last; # no point going on } } if($bWeightOK) # if all weights were valid for this zone/class { push @arrShippingHashes, { 'ShippingLabel' => $ClassTable{$nClassID}, 'ShippingClass' => $nClassID, 'ShippingZone' => $nZoneID, 'Cost' => $nTotalCost, 'BasisTotal' => GetShippingBasisTotal() }; } } # # 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) { 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 # @::s_arrSortedShippingHashes = sort{$$a{Cost} <=> $$b{Cost}} @arrShippingHashes; # # Store the hashes in descending order of total cost # # @::s_arrSortedShippingHashes = sort{$$b{Cost} <=> $$a{Cost}} @arrShippingHashes; # # Store the hashes in ascending alphabetical order # # @::s_arrSortedShippingHashes = sort{$$a{ShippingLabel} cmp $$b{ShippingLabel}} @arrShippingHashes; # # Store the hashes in descending alphabetical order # # @::s_arrSortedShippingHashes = sort{$$b{ShippingLabel} cmp $$a{ShippingLabel}} @arrShippingHashes; return($::SUCCESS, '', $parrShipSeparatePackages, $parrMixedPackages); } ################################################################ # # 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 # $DefaultWeight - default weight to use # # Input: $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 # # Author: Mike Purnell # ################################################################ sub DivideIntoPackages { my ($bUseIntegralWeights) = @_; my $dWeightRemainder = 0.0; my $nNonSeparateShipCount = 0; my (%hashWeightToQuantity, @arrSortedWeightKeys); my ($i); my (@arrShipSeparatePackages, @arrMixedPackages, $parrPackage); # # We support multi-packaging if we're shipping by weight # if($ShippingBasis ne 'Weight') { my $nBasisTotal = GetShippingBasisTotal(); $hashWeightToQuantity{$nBasisTotal} = 1; # single package # # Now get the array of sorted keys # @arrSortedWeightKeys = ($nBasisTotal); return(\%hashWeightToQuantity, \@arrSortedWeightKeys, $nBasisTotal); } # # Handle multi-packaging # my $dUnitWeight; for $i (0 .. $#::s_Ship_sShipProducts) { if($::s_Ship_sShipProducts[$i] =~ /_/) # filter out components with no associated products { next; } # # If we have a weight specified for that product ID # then we use it # Test for an empty string so that any value - including 0 - can be used for the # product weight - an empty string is default weight # if ("" ne $::s_Ship_OpaqueDataTables{$::s_Ship_sShipProducts[$i]}) # If we have a weight in the opaque data { $dUnitWeight = $::s_Ship_OpaqueDataTables{$::s_Ship_sShipProducts[$i]}; # use the specified weight } else { $dUnitWeight = $DefaultWeight; # Use default weight } # # Now decide whether to ship separately based upon the flag # and the unit weight versus the optimal weight # if($::s_Ship_nShipSeparately[$i] == 1 || # this product ships separately? ($sOptimalWeight > 0 && # or we have an optimal weight? $dUnitWeight >= $sOptimalWeight)) # and this package is greater than or equal to the optimal weight? { if($bUseIntegralWeights) # if we're using integral weights { $dUnitWeight = int($dUnitWeight + 0.9999); # round up to nearest integer } # # We may already have an entry for the weight or it may be a new weight # $hashWeightToQuantity{$dUnitWeight} += $::s_Ship_nShipQuantities[$i]; # add to existing quantity # # Add the package details # my @arrTemp = ($::s_Ship_sShipProducts[$i], $::s_Ship_nShipQuantities[$i], $dUnitWeight); push @arrShipSeparatePackages, \@arrTemp; } else # ship as mixed package { $nNonSeparateShipCount += $::s_Ship_nShipQuantities[$i]; # we have a mixed package $dWeightRemainder += $dUnitWeight * $::s_Ship_nShipQuantities[$i]; # add the weight * quantity # # Add the details to the non-ship separate details # my @arrTemp = ($::s_Ship_sShipProducts[$i], $::s_Ship_nShipQuantities[$i], $dUnitWeight); push @arrMixedPackages, \@arrTemp; } } # # Add the amalgamated weight to the hash if we found any non-separate ship packages # if($nNonSeparateShipCount > 0) { my $nQuantity = 1; # # If they specfied an optimal weight, split the non-separate items into # packages # if($sOptimalWeight ne '' && $dWeightRemainder > $sOptimalWeight) { my $nCalculatedPackages = int(($dWeightRemainder / $sOptimalWeight) + 0.9999); # # If the number of calculated packages is the same as # the number of non-ship separately items, treat all items # as ship-separately # if($nCalculatedPackages == $nNonSeparateShipCount) { foreach $parrPackage (@arrMixedPackages) { $dUnitWeight = $$parrPackage[2]; if($bUseIntegralWeights) # if we're using integral weights { $dUnitWeight = int($dUnitWeight + 0.9999); # round up to nearest integer } # # We may already have an entry for the weight or it may be a new weight # $hashWeightToQuantity{$dUnitWeight} += $$parrPackage[1]; # add to existing quantity # # Add the package details # push @arrShipSeparatePackages, $parrPackage; } # # Empty the mixed packages array # @arrMixedPackages = (); } else { # # We use the minimum of the number of items and the number of calculated packages # $nQuantity = ($nCalculatedPackages < $nNonSeparateShipCount) ? $nCalculatedPackages : $nNonSeparateShipCount; # # Get the average package weight # $dWeightRemainder = $dWeightRemainder / $nQuantity; if($bUseIntegralWeights) # if we're using integral weights { $dWeightRemainder = int($dWeightRemainder + 0.9999); # round up to nearest integer } $hashWeightToQuantity{$dWeightRemainder} += $nQuantity; # add however many packages # # Add the details to the non-ship separate details # my @arrTemp = ('', $nQuantity, $dWeightRemainder); push @arrMixedPackages, \@arrTemp; } } else { if($bUseIntegralWeights) # if we're using integral weights { $dWeightRemainder = int($dWeightRemainder + 0.9999); # round up to nearest integer } $hashWeightToQuantity{$dWeightRemainder} += $nQuantity; # add however many packages # # Add the details to the non-ship separate details # my @arrTemp = ('', $nQuantity, $dWeightRemainder); push @arrMixedPackages, \@arrTemp; } } # # We sort any weights into descending order. That way we know if # a weight is invalid for a class/zone as soon as possible # @arrSortedWeightKeys = sort {$b <=> $a} keys %hashWeightToQuantity; my ($dWeight, $sWeightList); # # Format the weight/quantities as a csv list of 'qty@weight' # foreach $dWeight (@arrSortedWeightKeys) # go through our sorted weights { $sWeightList .= sprintf("%d@%.03f,", $hashWeightToQuantity{$dWeight}, $dWeight); } # # Trim the trailing comma # $sWeightList =~ s/,$//; return(\%hashWeightToQuantity, \@arrSortedWeightKeys, $sWeightList, \@arrShipSeparatePackages, \@arrMixedPackages); } ################################################################ # # 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, }); return($::SUCCESS, ''); } # # Return an error # return($::FAILURE, $$pMessageList[4]); } ################################################################ # # SetFreeShipping - Sets the free ahipping charge # # Returns: 0 - status - always $::SUCCESS # 1 - error - always '' # # Author: Mike Purnell # ################################################################ sub SetFreeShipping { # # Add the free charge hash to our array # AddShippingHash({ 'ShippingLabel' => $$pMessageList[5], 'ShippingClass' => '-1', 'ShippingZone' => -1, 'Cost' => 0, 'BasisTotal' => GetShippingBasisTotal() }); return($::SUCCESS, ''); } ################################################################ # # 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 # # Input: $parrShipSeparatePackages - reference to array of single item parcels (optional) # $parrMixedPackages - reference to array of mixed item parcels (optional) # # Author: Mike Purnell # ################################################################ sub SaveSelectionToOpaqueData { my($parrShipSeparatePackages, $parrMixedPackages) = @_; # # 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 { 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 # # 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}); # # 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 # if($sOptimalWeight ne '' && $sOptimalWeight > 0) { $::s_Ship_sOpaqueShipData .= sprintf('OptimalWeight;%s;', $sOptimalWeight); } # # Set the shipping charge # $::s_Ship_nShipCharges = $$phashSelected{Cost}; # # If this isn't an SSP class, clear the SSP opaque data # if($$phashSelected{ShippingClass} !~ /^\d+_/) { $::s_Ship_sSSPOpaqueShipData = ''; # clear the SSP data } my $sClassID = $$phashSelected{ShippingClass}; # # 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) = DivideIntoPackages($::TRUE); # split into packages # # For each weight ask UPS for the rates # my $nWeight; foreach $nWeight (@$parrSortedWeightKeys) # go through our sorted weights { 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, }; } # # 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} = GetShippingBasisTotal(); # set the weight $$phashShipping{Cost} = $hashClassToTotal{$sClassID}; # adjust the cost 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' => GetShippingBasisTotal(), 'OnlineError' => 'Email' }; # # 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' => GetShippingBasisTotal(), 'OnlineError' => 'BasePlusIncrement' }; $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) (\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_LocationInfo{DELIVERRESIDENTIAL} 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 && (defined $::g_InputHash{LocationDeliveryCountry} || (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('www.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[2]; $sHTTPContent = $Response[3]; $phashHeader = $Response[4]; # # 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 # #------------------------------------------------------ return ($::SUCCESS); # # End of ShippingTemplate.pl #