File Coverage

lib/Business/Shipping/UPS_XML.pm

Criterion	Covered	Total	%
statement	12	92	13.0
branch	0	12	0.0
condition	0	6	0.0
subroutine	4	12	33.3
pod	3	7	42.8
total	19	129	14.7

#!/usr/bin/perl
################################################################################
#
#  Script Name : UPS_XML.pm
#  Version     : 1
#  Company     : Down Home Web Design, Inc
#  Author      : Duane Hinkley ( [e-mail] )
#  Website     : www.DownHomeWebDesign.com
#
#  Description: A custom self contained module to calculate UPS rates using the
#               newer XML method.  This module properly calulates rates between
#               and within other non-US countries including Canada.
#
#  Copyright (c) 2003-2004 Down Home Web Design, Inc.  All rights reserved.
#
#  $Header: /home/cvs/interchange_upsxml/lib/Business/Shipping/UPS_XML.pm,v 1.1 2004/06/27 13:59:11 dlhinkley Exp $
#
#  $Log: UPS_XML.pm,v $
#  Revision 1.1  2004/06/27 13:59:11  dlhinkley
#  Rename module
#
#  Revision 1.6  2004/06/27 13:53:20  dlhinkley
#  Rename module to UPS_XML
#
#  Revision 1.5  2004/06/16 00:52:45  dlhinkley
#  Clean up docs and add capability of multiple quantity of packages
#
#  Revision 1.4  2004/06/15 14:56:34  dlhinkley
#  Added sending dimensions for multiple packages
#
#  Revision 1.3  2004/06/10 02:03:16  dlhinkley
#  Fixed bugs from breaking up code and putting in CPAN format
#
#  Revision 1.2  2004/06/01 02:48:25  dlhinkley
#  Changes to make work
#
#  Revision 1.5  2004/05/21 21:28:36  dlhinkley
#  Add Currency
#
#  Revision 1.4  2004/04/20 01:28:00  dlhinkley
#  Added option for dimensions
#
#  Revision 1.3  2004/03/14 18:50:31  dlhinkley
#  Working version
#
#
################################################################################

package Business::Shipping::UPS_XML;
use strict;

use vars qw($VERSION);

$VERSION = "0.07";

use Net::SSLeay qw(post_https make_form make_headers);

use Business::Shipping::UPS_XML::Parser;

sub new {

   my $type  = shift;
   my ($userid,$userid_pass,$access_key,$origin_country) = @_;
   my $self  = {};
   $self->{'_userid'} = $userid;
   $self->{'_userid_pass'} = $userid_pass;
   $self->{'_access_key'} = $access_key;
   $self->{'_from_country'} = $origin_country;
   $self->{'package_type'} = '02';
   $self->{'residential'} = "1";
   $self->{'package_count'} = 0;

   bless $self, $type;
}

sub query_ups {

   my $self  = shift;
   my ($xml) = @_;

   my ($page, $response, %reply_headers) = post_https('www.ups.com', '443', '/ups.app/xml/Rate',

			           make_headers(

					                'content-type' => 'application/x-www-form-urlencoded',
									),

                       $xml
                       );

    return ($page,$response);
}
sub set_dimensions {

   my $self  = shift;
   my ( $width, $height, $length, $unit_of_measure, $weight) = @_;

   $self->{'package_count'}++;

   $self->{'length'}->[ $self->{'package_count'} ]		= $length;
   $self->{'width'}->[ $self->{'package_count'} ]			= $width;
   $self->{'height'}->[ $self->{'package_count'} ]		= $height;
   $self->{'unit_of_measure'}->[ $self->{'package_count'} ] = $unit_of_measure;
   $self->{'weight'}->[ $self->{'package_count'} ] = $weight;
}
sub clr_dimensions {

   my $self  = shift;

   $self->{'length'} = undef;
   $self->{'width'}  = undef;
   $self->{'height'} = undef;
   $self->{'unit_of_measure'} = undef;
   $self->{'package_count'} = 0;
}
sub getUPS {

   my $self  = shift;
	my ( $service_code, $from_zip, $to_zip, $to_country, $weight) = @_;

    my $access_key = $self->{'_access_key'};
    my $userid = $self->{'_userid'};
    my $userid_pass = $self->{'_userid_pass'};
	my $from_country = $self->{'_from_country'};
	my $package_type = $self->{'package_type'};
	my $residential = $self->{'residential'};
	$self->{'single_weight'} = $weight;
	my $error = "";
	my $maxcost;
	my $response;
	my $zone;
	my $x;
	my $currency;
	$self->{'send_xml'} = undef;
	$self->{'rcv_xml'} = undef;




	my $xml = "

   $access_key
   $userid
   $userid_pass





      Rating and Service
      1.0001

    Rate
    Rate


  01





        $from_zip
        $from_country





        $to_zip
        $to_country
        $residential



      $service_code

	  " . $self->_packages() . "


";

    #print "$xml\n";
	$self->{'send_xml'} = $xml;
    ($xml,$response) = $self->query_ups($xml);
	$self->{'rcv_xml'} = $xml;


     #print "$response\n\n";

    $x = new Business::Shipping::UPS_XML::Parser($xml);
    $x->parse();

	my ($method,$return,$status) = split(/ /,$response);

	# Check for error
	#
	if ( $return ne "200" ) {

	    $error = "HTML $return '$response'";
	}
	elsif ( $x->{'RatingServiceSelectionResponse'}->{'Response'}->{'ResponseStatusDescription'} eq 'Failure' ) {

         $error = "UPS XML Error: " . $x->{'RatingServiceSelectionResponse'}->{'Response'}->{'Error'}->{'ErrorDescription'};
	}
	else {

		 $maxcost  = $x->{'RatingServiceSelectionResponse'}->{'RatedShipment'}->{'TotalCharges'}->{'MonetaryValue'};
		 $currency = $x->{'RatingServiceSelectionResponse'}->{'RatedShipment'}->{'TotalCharges'}->{'CurrencyCode'};
	}

    $self->clr_dimensions();

	return ($maxcost, $zone, $error,$currency);
}
sub _packages {

   my $self  = shift;
   my $xml;
   my $l;

   # Do packages with dimensions
   #
   if ( $self->{'package_count'} > 0 ) {


      for ($l = 1; $l <= $self->{'package_count'}; $l++) {

        $xml .= "


        " . $self->{'package_type'} . "
        Package
      ";

        if ( $self->{'length'}->[ $l ] && $self->{'width'}->[ $l ] && $self->{'height'}->[ $l ] ) {

	      $xml .= "


           " . $self->{'unit_of_measure'}->[ $l ] . "

         " . $self->{'length'}->[ $l ] . "
         " . $self->{'width'}->[ $l ] . "
         " . $self->{'height'}->[ $l ] . "
      ";
        }

	    $xml .= "
      Rate Shopping";

        if (  $self->{'weight'}->[ $l ]  ) {

	      $xml .= "

        ". $self->{'weight'}->[ $l ]  . "
      ";
        }

        $xml .= "

		";

      }

   }
   else {  # A single package no dimensions

        $xml .= "


        " . $self->{'package_type'} . "
        Package
      ";

	    $xml .= "
      Rate Shopping";

        if ( $self->{'single_weight'} > 0 ) {

	      $xml .= "

        ". $self->{'single_weight'} . "
      ";
        }

        $xml .= "

		";

   }

   return $xml;
}
sub send_xml {

   my $self  = shift;

   return $self->{'send_xml'};
}
sub rcv_xml {

   my $self  = shift;

   return $self->{'rcv_xml'};
}
#########################################################################################33
# End of class

1;
__END__