Business::Shipping::USPS_Online::RateRequest - Business::Shipping::USPS_Online::RateRequest documentation

    All
    EXPRESS
    Priority
    Parcel
    Library
    BPM
    Media

 Global Express Guaranteed
 Global Express Guaranteed Non-Document Rectangular
 Global Express Guaranteed Non-Document Non-Rectangular
 USPS GXG Envelopes
 Express Mail International
 Express Mail International Flat Rate Envelope
 Express Mail International Legal Flat Rate Envelope
 Priority Mail International
 Priority Mail International Large Flat Rate Box
 Priority Mail International Medium Flat Rate Box
 Priority Mail International Small Flat Rate Box
 Priority Mail International DVD Flat Rate Box
 Priority Mail International Large Video Flat Rate Box
 Priority Mail International Flat Rate Envelope
 Priority Mail International Legal Flat Rate Envelope
 Priority Mail International Padded Flat Rate Envelope
 Priority Mail International Gift Card Flat Rate Envelope
 Priority Mail International Small Flat Rate Envelope
 Priority Mail International Window Flat Rate Envelope
 First-Class Mail International Package
 First-Class Mail International Large Envelope

 package_id	: The unique package id in which the error occurred
 error_source	: The component that generated the error

package Business::Shipping::USPS_Online::RateRequest;

use Any::Moose;
use Data::Dumper;
use Carp;
use Business::Shipping::Logging;
use Business::Shipping::USPS_Online::Shipment;
use Business::Shipping::USPS_Online::Package;
use XML::Simple 2.05;
use XML::DOM;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use version; our $VERSION = qv('400');

extends 'Business::Shipping::RateRequest::Online';

has 'domestic' => (is => 'rw', default => 1);

has 'prod_url' => (
    is      => 'rw',
    default => 'http://production.shippingapis.com/ShippingAPI.dll'
);

has 'test_url' => (
    is      => 'rw',
    default => 'http://testing.shippingapis.com/ShippingAPItest.dll',
);

has 'shipment' => (
    is      => 'rw',
    isa     => 'Business::Shipping::USPS_Online::Shipment',
    default => sub { Business::Shipping::USPS_Online::Shipment->new() },
    handles => [
        'ounces', 'pounds',     'weight',    'container',
        'size',   'machinable', 'mail_type', 'shipper',
        'width',  'length',     'height',    'girth',
        'service',
    ]
);

__PACKAGE__->meta()->make_immutable();

sub Required {
    my ($self) = @_;

    my @required;

    if ($self->domestic) {
        @required = qw/ service from_zip /;
    }
    else {
        @required = ();
    }

    my $need_weight = 1;
    for (qw/ weight pounds ounces /) {
        if ($self->$_) {
            $need_weight = 0;
        }
    }
    push @required, 'weight' if $need_weight;

    return ($self->SUPER::Required, @required);
}

sub Optional {
    return ($_[0]->SUPER::Optional,
        qw/ container size machinable mail_type pounds ounces /);
}

# Note that we use 'weight' as the unique value (specified in Parent),
# which should convert automatically from pounds/ounces during uniqueness
# calculations.
sub Unique {
    return ($_[0]->SUPER::Unique, qw/ container size machinable mail_type /);
}

sub _gen_request_xml {
    trace '()';
    my $self = shift;

# Note: The XML::Simple hash-tree-based generation method wont work with USPS,
# because they enforce the order of their parameters (unlike UPS).
    my $rateReqDoc = XML::DOM::Document->new();
    my $rateReqEl  = $rateReqDoc->createElement(
        $self->domestic() ? 'RateV3Request' : 'IntlRateRequest');

    # Note that these are required even for test mode transactions.
    $rateReqEl->setAttribute('USERID',   $self->user_id());
    $rateReqEl->setAttribute('PASSWORD', $self->password());
    $rateReqDoc->appendChild($rateReqEl);

    my $package_count = 0;
    logdie "No packages defined internally."
        unless ref $self->shipment->packages();
    foreach my $package (@{ $self->shipment->packages() }) {
        my $id;
        $id = $package->id();
        $id = $package_count++ unless $id;
        my $packageEl = $rateReqDoc->createElement('Package');
        $packageEl->setAttribute('ID', $id);
        $rateReqEl->appendChild($packageEl);

        if ($self->domestic()) {
            my $serviceEl = $rateReqDoc->createElement('Service');
            my $serviceText
                = $rateReqDoc->createTextNode($self->shipment->service());
            $serviceEl->appendChild($serviceText);
            $packageEl->appendChild($serviceEl);

            my $zipOrigEl = $rateReqDoc->createElement('ZipOrigination');
            my $zipOrigText
                = $rateReqDoc->createTextNode($self->shipment->from_zip());
            $zipOrigEl->appendChild($zipOrigText);
            $packageEl->appendChild($zipOrigEl);

            my $zipDestEl = $rateReqDoc->createElement('ZipDestination');
            my $zipDestText
                = $rateReqDoc->createTextNode($self->shipment->to_zip());
            $zipDestEl->appendChild($zipDestText);
            $packageEl->appendChild($zipDestEl);
        }

        my $poundsEl   = $rateReqDoc->createElement('Pounds');
        my $poundsText = $rateReqDoc->createTextNode($package->pounds());
        $poundsEl->appendChild($poundsText);
        $packageEl->appendChild($poundsEl);

        my $ouncesEl   = $rateReqDoc->createElement('Ounces');
        my $ouncesText = $rateReqDoc->createTextNode($package->ounces());
        $ouncesEl->appendChild($ouncesText);
        $packageEl->appendChild($ouncesEl);

        if ($self->domestic()) {
            if (defined($package->container())) {
                my $containerEl = $rateReqDoc->createElement('Container');
                my $containerText
                    = $rateReqDoc->createTextNode($package->container());
                $containerEl->appendChild($containerText);
                $packageEl->appendChild($containerEl);
            }

            my $oversizeEl   = $rateReqDoc->createElement('Size');
            my $oversizeText = $rateReqDoc->createTextNode($package->size());
            $oversizeEl->appendChild($oversizeText);
            $packageEl->appendChild($oversizeEl);

            my $widthEl   = $rateReqDoc->createElement('Width');
            my $widthText = $rateReqDoc->createTextNode($package->width());
            $widthEl->appendChild($widthText);
            $packageEl->appendChild($widthEl);

            my $lengthEl   = $rateReqDoc->createElement('Length');
            my $lengthText = $rateReqDoc->createTextNode($package->length());
            $lengthEl->appendChild($lengthText);
            $packageEl->appendChild($lengthEl);

            my $heightEl   = $rateReqDoc->createElement('Height');
            my $heightText = $rateReqDoc->createTextNode($package->height());
            $heightEl->appendChild($heightText);
            $packageEl->appendChild($heightEl);

            my $girthEl   = $rateReqDoc->createElement('Girth');
            my $girthText = $rateReqDoc->createTextNode($package->girth());
            $girthEl->appendChild($girthText);
            $packageEl->appendChild($girthEl);

            if ($self->service() =~ /all/i
                and not defined $package->machinable())
            {
                $package->machinable('False');
            }

            if (defined($package->machinable())) {
                my $machineEl = $rateReqDoc->createElement('Machinable');
                my $machineText
                    = $rateReqDoc->createTextNode($package->machinable());
                $machineEl->appendChild($machineText);
                $packageEl->appendChild($machineEl);
            }
        }
        else {
            my $mailTypeEl = $rateReqDoc->createElement('MailType');
            my $mailTypeText
                = $rateReqDoc->createTextNode($package->mail_type());
            $mailTypeEl->appendChild($mailTypeText);
            $packageEl->appendChild($mailTypeEl);

            my $countryEl = $rateReqDoc->createElement('Country');
            my $countryText
                = $rateReqDoc->createTextNode($self->shipment->to_country());
            $countryEl->appendChild($countryText);
            $packageEl->appendChild($countryEl);
        }

    }    #/foreach package
    my $request_xml = $rateReqDoc->toString();

    # We only do this to provide a pretty, formatted XML doc for the debug.
    my $request_xml_tree
        = XML::Simple::XMLin($request_xml, KeepRoot => 1, ForceArray => 1);

    # Large debug
    trace(XML::Simple::XMLout($request_xml_tree, KeepRoot => 1));

    return ($request_xml);
}

sub _gen_request {
    my ($self) = shift;
    trace('called');

    my $request = $self->SUPER::_gen_request();

    # This is how USPS slightly varies from Business::Shipping
    my $new_content
        = 'API='
        . ($self->domestic() ? 'RateV3' : 'IntlRate') . '&XML='
        . $request->content();
    $request->content($new_content);
    $request->header('content-length' => CORE::length($request->content()));

    # Large debug
    trace('HTTP Request: ' . $request->as_string());

    return ($request);
}

sub _massage_values {
    my $self = shift;

    $self->_domestic_or_intl();

    return;
}

sub _handle_response {
    trace '()';
    my $self = shift;

    ### Keep the root element, because USPS might
    ### return an error and 'Error' will be the root element
    my $response_tree = XML::Simple::XMLin(
        $self->response()->content(),
        ForceArray => 0,
        KeepRoot   => 1
    );
    ### Discard the root element if it is RateV3Response
    $response_tree = $response_tree->{RateV2Response}
        if (exists($response_tree->{RateV2Response}));
    $response_tree = $response_tree->{RateV3Response}
        if (exists($response_tree->{RateV3Response}));

    ### Discard the root element if it is IntlRateResponse
    $response_tree = $response_tree->{IntlRateResponse}
        if (exists($response_tree->{IntlRateResponse}));

    #use Data::Dumper; trace(Dumper($response_tree));

    # Handle errors
    ### Get all errors
    my $errors = [];
    push(@$errors, $response_tree->{Error})
        if (exists($response_tree->{Error}));
    if (ref $response_tree->{Package} eq 'HASH') {
        if (exists($response_tree->{Package}{Error})) {
            push(@$errors, $response_tree->{Package}{Error});
            $errors->[$#{$errors}]{PackageID} = $response_tree->{Package}{ID};
        }
    }
    elsif (ref $response_tree->{Package} eq 'ARRAY') {
        foreach my $pkg (@{ $response_tree->{Package} }) {
            if (exists($pkg->{Error})) {
                push(@$errors, $pkg->{Error});
                $errors->[$#{$errors}]{PackageID} = $pkg->{ID};
            }
        }
    }
    if (@$errors > 0) {
        ### Loop through the errors, gathering the details and
        ### create a simple error message string
        my (@errorDetails, $errorMsg);
        foreach my $errorHash (@$errors) {
            ### Get some of the error details
            my $code    = $errorHash->{Number};
            my $error   = $errorHash->{Description};
            my $source  = $errorHash->{Source};
            my $pkg_src = $errorHash->{PackageID};

            push(
                @errorDetails,
                {   error_code   => $code,
                    error_msg    => $error,
                    package_id   => $pkg_src,
                    error_source => $source
                }
            );
            if (!defined($errorMsg) && $error) {
                $errorMsg = "$source: $error ($code)";
            }
        }    # foreach error

        $self->user_error($errorMsg);
        $self->error_details(@errorDetails);

        return $self->is_success(0);
    }    # if errors

    # This is a "large" debug.
    trace('response = ' . $self->response->content);

    #

    my $charges;
    my @services_results = ();

    # TODO: Get the pricing routines to work for multi-packages (not just
    # the default_package()
    #
    # Domestic *does* tell you the price of all services if you ask for
    # service "ALL". If you ask for a specific service, it still might send
    # more then one price. For example, if you ask for "Flat Rate Box"
    # service, it will send you two prices, one for
    # 'Priority Mail Flat Rate Box (11.25" x 8.75" x 6")' and the other for
    # 'Priority Mail Flat Rate Box (14" x 12" x 3.5")'
    if ($self->domestic()) {
        if (ref($response_tree->{Package}) eq 'ARRAY') {
            $self->user_error("Sorry, multiple packages not supported yet.");
            return $self->is_success(0);
        }

        $charges = $response_tree->{Package}->{Postage};

        #info('response_tree = ' . Dumper($response_tree));
        if (defined($charges)) {
            $charges = [$charges] if (ref $charges ne 'ARRAY');
            foreach my $chg (@$charges) {
                next if (ref $chg ne 'HASH');
                my $service_hash = {
                    code       => undef,
                    nick       => service_to_nick($chg->{MailService}),
                    name       => $chg->{MailService},
                    deliv_days => undef,
                    deliv_date => undef,
                    charges    => $chg->{Rate},
                    charges_formatted =>
                        Business::Shipping::Util::currency({}, $chg->{Rate}),
                    deliv_date_formatted => undef,
                };
                push(@services_results, $service_hash);
            }
        }
    }

    # International with service 'all'
    elsif (defined($self->service()) && lc($self->service()) eq 'all') {

   # International *does* tell you the price of all services for each package
   # If caller asked for All services, then lets give them All services.  Will
   # pass back service name as-is.  Let caller try to distinguish it.

        # Set charges to returned services, since charges needs to be set to
        # something.
        $charges = $response_tree->{Package}->{Service};

        if (defined($charges)) {
            $charges = [$charges] if (ref $charges ne 'ARRAY');
            foreach my $service (@$charges) {
                my $service_hash = {
                    code       => undef,
                    nick       => service_to_nick($service->{SvcDescription}),
                    name       => $service->{SvcDescription},
                    deliv_days => undef,
                    deliv_date => undef,
                    charges    => $service->{Postage},
                    charges_formatted => Business::Shipping::Util::currency(
                        {}, $service->{Postage},
                    ),
                    deliv_date_formatted => undef,
                };
                push(@services_results, $service_hash);
            }    # foreach service
        }    # if services defined
    }

    # International with one specific service. International *does* tell you
    # the price of all services for each package
    else {
        my $desired_service = $self->service();

        # Handle difference between "Flat-Rate" and "Flat Rate" automatically.
        $desired_service =~ s/Flat[-_]Rate/Flat Rate/i;
        my $service_description;

        if (is_trace()) {
            trace('Service part of response tree: '
                    . Dumper($response_tree->{Package}->{Service}));
        }
        info("Requested service is '$desired_service'");
        foreach my $service (@{ $response_tree->{Package}->{Service} }) {
            my $remove_reg = quotemeta('<sup>®</sup>');
            my $remove_tm  = quotemeta('<sup>™</sup>');
            my $compare_service = $service->{SvcDescription};
            $compare_service =~ s/\*//g;
            $compare_service =~ s/$remove_reg//gi;
            $compare_service =~ s/$remove_tm//gi;
            my $postage_formatted
                = Business::Shipping::Util::currency({}, $service->{Postage});

            debug(    "Checking for matching service in description:\n"
                    . $compare_service
                    . " ($postage_formatted)");
            if ($desired_service
                and lc $compare_service eq lc $desired_service)
            {
                info(     "Found match: $compare_service "
                        . "($postage_formatted)");
                $charges             = $service->{'Postage'};
                $service_description = $compare_service;
                last;
            }
        }

        # Still can't find the right service...
        if (not defined $charges) {
            my $error_msg
                = "The requested service ("
                . ($self->service() || 'none entered by user')
                . ") did not match any services that were available for that country.";

            $self->user_error($error_msg);
        }

        my $service_hash = {
            code       => undef,
            nick       => service_to_nick($service_description),
            name       => undef,
            deliv_days => undef,
            deliv_date => undef,
            charges    => $charges,
            charges_formatted =>
                Business::Shipping::Util::currency({}, $charges),
            deliv_date_formatted => undef,
        };
        push(@services_results, $service_hash);
    }

    if (!$charges) {
        $self->user_error('charges are 0, error out');
        return $self->is_success(0);
    }
    info('Setting charges to: ' . $charges);

    my $results = [
        {   name => $self->shipper() || 'USPS_Online',
            rates => \@services_results,
        }
    ];

    $self->results($results);

    trace 'returning success';
    return $self->is_success(1);
}

sub service_to_nick {
    my ($service_description) = @_;
    return $service_description unless $service_description;
    my %services_codes = (
        'Express Mail'                     => 'EXPRESS',
        'Priority Mail'                    => 'PRIORITY',
        'Express Mail International (EMS)' => 'EXPRESS',
        'Priority Mail International'      => 'PRIORITY',
    );

    return $services_codes{$service_description} || $service_description;
}

sub _domestic_or_intl {
    my $self = shift;
    trace '()';

    #info('to_country = ' . $self->shipment->to_country());
    if (    $self->shipment->to_country()
        and $self->shipment->to_country() !~ /(US)|(United States)/)
    {
        $self->domestic(0);
    }
    else {
        $self->domestic(1);
    }
    info($self->domestic() ? 'Domestic' : 'International');
    return;
}

sub to_residential { return 0; }

1;

__END__