############################################################ # 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

\n\n\n!; if ($sc_reason_to_display_ups_cost ne "") { print qq!!; } print qq! !; foreach $service (@services) { ($tmp, $service_code) = split(/\-/, $service); if ($sc_ups_services_to_display{$service} ne "" && $ups_cost{$service_code} ne "") { print qq!!; if ($sc_reason_to_display_ups_cost ne "") { print qq! \n!; $checked = ""; } print qq!!; print qq!\n!; } # End of if } # End of foreach print qq!
SelectUPS Shipping Service Cost \$
$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}

\n!; } else { 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!

\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;