############################################################ # UPS-LIB.PL # # Created by Jeff Walters # Date Created: 12-01-1999 # Date Last Modified: 12-20-1999 # # Copyright Info: This library was written by Jeff Walters # having been inspired by countless other Perl authors, # such as Gunther Birznieks, Selena Sol and countless # others. Feel free to copy, cite, reference, sample, # borrow, resell or plagiarize the contents. Information # wants to be free, support public domain freware. # ############################################################ ############################################################ # # subroutine: display_ups_cost_table # Usage: # &display_ups_cost_table($sc_reason_to_display_ups_cost); # # Parameters: # $sc_reason_to_display_ups_cost - equal to "" for a general # display or "order form" (or ne "") for selection options. # # %ups_services_to_display - possible UPS Service codes to use, # defined in setup file. 'Keys' such as: # GNDRES, 1DM, 1DA, 1DP, 2DM, 2DA, 3DS, GNDCOM (US); # STD (Canada); XPR, XPD (Worldwide) and the # text names as the 'Values'. # # Output: # This routine displays a Table of UPS Service Costs for the # UPS Service codes defined in %sc_ups_services_to_display. The # routine also displays the table with or without 'radio' type # selections to be used in the confirm process FORM. # # Each selection has a value which is in the following # Format: "Sevice Code|Service Text|Service Cost" # Example: "2DA|2nd Day Air|10.55" # This information is used further in &calculate_shipping. # ############################################################ sub display_ups_cost_table { local ($sc_reason_to_display_ups_cost) = @_; local (@services, $service, $service_code, $tmp, $checked); $checked = "CHECKED"; @services = sort(keys(%sc_ups_services_to_display)); if ($ups_shipping_msg eq "" && $ups_socket_msg eq "") { print qq!
\n\n
| Select | !; } print qq!UPS Shipping Service | Cost \$ |
|---|---|---|
| \n!; $checked = ""; } print qq! |
$sc_ups_services_to_display{$service}!;
if ($ups_warning_msg{$service_code} ne "") {
print qq!
$ups_warning_msg{$service_code}!; } print qq! | \$$ups_cost{$service_code} | !; print qq!
!; print qq!$ups_shipping_msg\n\n
!; print qq~There seems to have been an error while trying to calculate your UPS shipping cost!
\n~;
} # End of if else
} # End of display_ups_cost_table
############################################################
#
# subroutine: get_ups_cost
# Usage:
# &get_ups_cost ($OriginPostalCode, $DestPostalCode, $DestCountry,
# $PackageWeight, $Value);
#
# Parameters:
# $OriginPostalCode - the five digit postal code for the origin.
# $DestPostalCode - the one to six alphanumeric-character postal
# code for the destination country.
# $DestCountry - the country code for the shipment destination.
# $PackageWeight - the weight of the package.
# $Value - the declared value of the package.
#
# Output:
# This routine defines an associative array called %ups_cost
# which holds the different UPS service shipping costs
# which are available for a given destination.
#
# Defines an associative array called %ups_warning_msg
# which holds any warning messages which are received for
# each service type.
#
# Defines $ups_socket_msg if there is a problem making
# a socket connection to www.ups.com and/or defines
# $ups_error_msg if there are any error messages
# returned from www.ups.com and updates the Error Log.
#
# ups_shipping_msg - is set to a general error message
# if no UPS services are available.
#
# ==================================
# Receiving Rating Information - UPS Quick Cost Calculator
#
# Rating information is returned in newline terminated strings,
# with each piece of information separated by a percent sign, as follows:
#
# 3%$product%$orig_postal%$orig_country%$dest_postal%$dest_country%
# $zone %$weight%$productchrg%$accs_surcharge%$totalchrg%$time%$\n
#
# Rating information for a single product, specified by $product.
#
# $product UPS product code
# $orig_postal Shipment origin postal code
# $orig_country Shipment origin country code
# $dest_postal Shipment destination postal code
# $dest_country Shipment destination country code
# $zone UPS zone identifier
# $weight Package weight (empty if package is UPS Letter)
# $productchrg Charge for base service without additional charges
# $accs_surcharge Charge for accessories and surcharges
# $totalchrg Total charge for shipping package
# $time Commit time (-1 if no commit time, EOD if end-of-day commit)
#
# 4%$product%$orig_postal%$orig_country%$dest_postal%$dest_country%
# $zone %$weight%$productchrg%$accs_surcharge%$totalchrg%$time%$\n
#
# Rating information for all UPS products, starting with specified product.
# Information as above for each UPS product rated.
#
# 5%$errmsg%$errorCode%\n or 5%$errmsg%\n
#
# Error message if package could not be rated. No rating information follows.
#
# $errmsg Error message
# $errorCode Error code
#
# 6%$message%[followed by 3 or 4, as above]
#
# Warning message if UPS product, specified by $product,
# might not be valid for this particular shipment.
# Rating information follows immediately.
#
# $message Warning message
#
############################################################
sub get_ups_cost {
local($OriginPostalCode, $DestPostalCode, $DestCountry,
$PackageWeight, $Value) = @_;
local($upsAction, $upsProduct, $function, $workFile, $versionInfo,
$workString, $request, $line, $begin, $tmp, $service_yes_or_no);
# Check for two part postal codes if destination
# country is US and split() keeping the first part.
if ($DestCountry eq "US") {
if ($OriginPostalCode =~ /\-/)
{($OriginPostalCode,$tmp) = split(/\-/, $OriginPostalCode)}
if ($DestPostalCode =~ /\-/)
{($DestPostalCode,$tmp) = split(/\-/, $DestPostalCode)}
}
# Build the $workString based on input values and
# define the $request to be made to www.ups.com
$upsAction = "4"; # Shop Entire UPS Product Range!
# Determine US Service, Canada Standard
# or Worldwide Service. I'm not sure if this works!
# More information is needed for other Countries!
if ($DestCountry eq "MX") # Mexico
{ $upsProduct = "XPR" }
elsif ($DestCountry eq "CA") # Canada
{ $upsProduct = "STD" }
elsif ($DestCountry eq "PR") # Puerto Rico
{ $upsProduct = "XPR" }
else
{ $upsProduct = "GND" } # US
$function = "GET";
$workFile = "/using/services/rave/qcostcgi.cgi";
$versionInfo = "HTTP/1.0\n\n";
$workString = "?accept_UPS_license_agreement=yes";
$workString .= "&10_action=$upsAction";
$workString .= "&13_product=$upsProduct";
$workString .= "&15_origPostal=$OriginPostalCode";
$workString .= "&19_destPostal=$DestPostalCode";
$workString .= "&22_destCountry=$DestCountry";
$workString .= "&49_residential=1";
$workString .= "&23_weight=$PackageWeight";
$workString .= "&24_value=$Value";
$request = "$function $workFile$workString $versionInfo";
# Use the IO::Socket package in Perl
# to open a socket connection to www.ups.com
# or define $ups_error_msg if error occurs.
# Other Library files such as http_lib.pl
# could be used instead of IO::Socket
use IO::Socket;
$socket = IO::Socket::INET->new(PeerAddr => "www.ups.com",
PeerPort => 80,
Proto => "tcp",
Type => SOCK_STREAM)
or $ups_socket_msg = "COULDN'T CONNECT TO WWW.UPS.COM: $@\n";
print $socket "$request";
# While the socket is open we read each $line.
while (<$socket>) { push (@lines, $_) }
close($socket);
# If there was a socket error, then update
# the error log.
if ($ups_socket_msg ne "") {
&update_error_log($ups_socket_msg, __FILE__, __LINE__);
}
# Next, we find the $begin-ning of the UPS product info.
# For each UPS product we define part of associative
# array %ups_cost. Example: $ups_cost{'GNDRES'}=5.34
$service_yes_or_no = "no";
foreach $line (@lines) {
# print "$line
\n\n";
if ($line =~ /^UPSOnLine/ || $begin eq "on") {
if ($begin ne "on") { $line =~ s/^UPSOnLine//i }
$begin = "on";
if ($line =~ /\n$/) { chop ($line) } # remove newline
if ($line =~ /%$/) { chop ($line) } # remove trailing %
@ups = split(/\%/, $line);
if (@ups[0] eq "5") { # Error Message "5"
$ups_error_msg .= "$ups[1]\, Error Code: $ups[2]\n";
}
elsif (@ups[0] eq "6") { # Warning Message "6"
shift(@ups);
$tmp = shift(@ups);
$ups_warning_msg{$ups[1]} = $tmp;
$ups_cost{$ups[1]} = $ups[10]; # Cost Information
$service_yes_or_no = "yes";
}
else { # Cost Information "4"
$ups_cost{$ups[1]} = $ups[10];
$service_yes_or_no = "yes";
}
} # end of if
} # end of foreach $line
# Define Error Message Text which will be
# displayed to the customer.
if ($ups_socket_msg ne "") {
$ups_socket_msg = "Error: There was a problem trying to connect to the UPS Server!";
}
if ($service_yes_or_no eq "no") {
$ups_shipping_msg = "Error: No UPS shipping services are available to your area!";
}
# For Testing Purposes Only
print qq~\n\n\n\n~;
} # End of get_ups_cost subroutine
1;