############################################################ # UPS-LIB.PL # # Created by Jeffrey J. Walters # Email: design@jjw.cc # Web Site: http://www.jjw.cc/ # Date Created: 10-15-1999 # Date Last Modified: 05-13-2000 # # 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 freeware. # ############################################################ # # 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 radio selection options. # # %sc_ups_services_to_display - possible UPS Service codes to use, # defined in setup file: # %sc_ups_services_to_display = ( # '7-1DM','Next Day Air Early AM', # '6-1DA','Next Day Air', # '5-1DP','Next Day Air Saver', # '4-2DM','2nd Day Air AM', # '3-2DA','2nd Day Air', # '2-3DS','3 Day Select', # '1-GNDRES','Ground Residential', # '8-STD','Canada Standard', # '9-XPR','Worldwide Express', # '10-XDM','Worldwide Express Plus', # '11-XPD','Worldwide Expedited' # ); # # $sc_ups_shipping_field = the shipping FORM field to be used to # hold the selection information. # # $sc_background_color1 = 6 digit color code for the table # background color. # # 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 the Web Store subroutine # &calculate_shipping. # # ############################################################ sub display_ups_cost_table { local ($sc_reason_to_display_ups_cost) = @_; local (@services, $service, $service_code, $tmp, $checked); local ($checked) = "CHECKED"; # First we sort the keys from the user defined # $sc_ups_services_to_display (setup file). # We use the prefix numbers to do this # (1-1DM, 2-1DA, 3-1DP, etc). @services = sort(keys(%sc_ups_services_to_display)); # We then check for any error messages which # might have been defined from the get_ups_cost # subroutine. if ($ups_shipping_msg eq "" && $ups_socket_msg eq "") { # Start of the HTML TABLE. print qq!

\n\n

\n\n\n!; # If the reason to display is for the final checkout # procedure, then we display the "Selection" heading. if ($sc_reason_to_display_ups_cost ne "") { print qq!!; } # Next, we display the heading HTML # for the UPS Shipping Service and Cost (US $) print qq! !; # Now for the fun part! We build the HTML TABLE # for each available service defined by subroutine # get_ups_cost: associative arrarys %ups_cost and # $ups_warning_msg. foreach $service (@services) { # Cut off the sorting numbers. ($tmp, $service_code) = split(/\-/, $service); # If the service was defined in the setup file # (%sc_ups_services_to_display) and the service # is available to the user (%ups_cost), then # we will display it as a radio selection. if ($sc_ups_services_to_display{$service} ne "" && $ups_cost{$service_code} ne "") { print qq!!; # Display with radio selection if the reason # to display is for the final checkout. The # FORM NAME used is defined in the setup file # as $sc_ups_shipping_field. The format of the # VALUE is "service code|service text|service cost". if ($sc_reason_to_display_ups_cost ne "") { print qq! \n!; $checked = ""; } # Display the Service Text print qq!!; print qq!\n!; } # End of if } # End of foreach # Close up TABLE print qq!
SelectUPS Shipping Service Cost \(US\$\)
$sc_ups_services_to_display{$service}!; # Display any warning messages in small # bold red (#AD0000) text. if ($ups_warning_msg{$service_code} ne "") { print qq!
$ups_warning_msg{$service_code}!; } # Display the Service Cost print qq!		 \$$ups_cost{$service_code}

\n!; } else { # Print any error messages to user. print qq!

\n\n

\n\n\n \n\n
\n\n!; print qq!$ups_socket_msg\n\n

!; print qq!$ups_shipping_msg\n\n

!; print qq~There seems to have been an error while trying to calculate your UPS shipping cost! Please, continue with your order. We will notify you of the shipping cost within 24 hours!\n~; print qq!

\n
\n

\n\n!; } # End of if else } # End of display_ups_cost_table ############################################################ # # subroutine: get_ups_cost # Usage: # &get_ups_cost ($OriginPostalCode, $OriginCountry, $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. # # $sc_weight_multiplier # Example: "1.20" would be a 20% increase. # $sc_weight_addition # Measured in Pounds (lbs.) # # Output: # 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, $OriginCountry, $DestPostalCode, $DestCountry, $PackageWeight, $Value) = @_; local($upsAction, $upsProduct, $function, $workFile, $versionInfo, $workString, $request, $line, $begin, $tmp, $service_yes_or_no); # Check for two part postal zip codes # and split() keeping the first part. if ($OriginCountry eq "US" || $OriginCountry eq "PR") { if ($OriginPostalCode =~ /\-/) {($OriginPostalCode,$tmp) = split(/\-/, $OriginPostalCode)} } if ($DestCountry eq "US" || $DestCountry eq "PR") { if ($DestPostalCode =~ /\-/) {($DestPostalCode,$tmp) = split(/\-/, $DestPostalCode)} } # Remove any white space characters. $OriginPostalCode =~ s/\s/_/g; $DestPostalCode =~ s/\s/_/g; # $PackageWeight adjustment based on the Setup Variables # $sc_weight_multiplier and $sc_weight_addition. if ($sc_weight_multiplier eq "") { $sc_weight_multiplier = 1 } if ($sc_weight_addition eq "") { $sc_weight_addition = 0 } if ($sc_weight_multiplier =~ /\%/ ) { $sc_weight_multiplier =~ s/\%//; $PackageWeight= $PackageWeight*($sc_weight_multiplier/100+1)+$sc_weight_addition; } else { $PackageWeight = $PackageWeight*$sc_weight_multiplier+$sc_weight_addition; } # Shop the entire UPS product range (4) # starting at the first service type (1DM). $upsAction = "4"; $upsProduct = "1DM"; # Build the $workString based on input values and # define the $request to be made to www.ups.com $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 .= "&14_origCountry=$OriginCountry"; $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"; # print "\n\n

$request

\n\n"; # Used for testing! # 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, Timeout => 20) or $ups_socket_msg = "COULDN'T CONNECT TO WWW.UPS.COM: $@\n"; # While/If the socket is open we read each line into @lines. if ($ups_socket_msg eq "") { print $socket "$request"; while (<$socket>) { push (@lines, $_) } close($socket); } else { # If there was a socket error, then update # the Web Store Error Log! &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 # If necessary we define associative array # %ups_warning_msg to hold any warning messages. $service_yes_or_no = "no"; foreach $line (@lines) { # print "\n\n$line
\n\n"; # Used for testing! 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_socket_msg eq "") { $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;