Business-Shipping

 view release on metacpan or  search on metacpan

t/410-UPS_Offline-Rate.t  view on Meta::CPAN

#!/bin/env perl

# UPS_Offline RateRequest - suite of tests. (Compares a lot to UPS_Online.)

use strict;
use warnings;
use Test::More;
use Carp;
use Business::Shipping;
use Data::Dumper;

plan skip_all => 'Required modules for UPS_Offline are not installed'
    unless Business::Shipping::Config::calc_req_mod('UPS_Offline');

plan skip_all => 'DataFiles version 1.02+ is required.'
    unless $Business::Shipping::DataFiles::VERSION >= 1.02;

plan 'no_plan';

$::UPS_Online = 1 if Business::Shipping::Config::calc_req_mod('UPS_Online');

unless ($ENV{UPS_USER_ID} and $ENV{UPS_PASSWORD} and $ENV{UPS_ACCESS_KEY}) {
    $::UPS_Online     = 0;
    $::UPS_Online_msg = 'No credentials. Set three UPS_* variables to run.';
}

if ($ENV{DISABLE_UPS_ONLINE}) {
    $::UPS_Online     = 0;
    $::UPS_Online_msg = 'Comparison to UPS_Online is disabled. '
        . 'Unset DISABLE_UPS_ONLINE to run.';
}

if (not $ENV{TEST_SLOW}) {
    $::UPS_Online = 0;
    $::UPS_Online_msg
        = 'Comparison to UPS_Online is too slow. Set TEST_SLOW to run.';
}

# How to test for performance: time DIABLE_UPS_ONLINE=1 /usr/local/perl/bin/perl t/45_UPS_Offline.t
# Currently 1.8 - 2.2 seconds.

use constant CLOSE_ENOUGH_PERCENT => 10;

my %user = (
    user_id    => $ENV{UPS_USER_ID},
    password   => $ENV{UPS_PASSWORD},
    access_key => $ENV{UPS_ACCESS_KEY},
);

sub test {
    my (%args) = @_;
    my $shipment = Business::Shipping->rate_request(
        from_state => 'Washington',
        shipper    => 'UPS_Offline',
        cache      => 0,
    );

    $shipment->submit(%args) or print STDERR $shipment->user_error();
    return $shipment;
}

sub test_online {
    my (%args) = @_;
    my $shipment = Business::Shipping->rate_request(
        shipper => 'UPS_Online',
        cache   => 0,
        %user
    );

    $shipment->submit(%args) or print STDERR $shipment->user_error();
    return $shipment;
}

sub close_enough {
    my ($n1, $n2, $percent) = @_;

    $percent ||= CLOSE_ENOUGH_PERCENT;

    my ($greater, $lesser) = $n1 > $n2 ? ($n1, $n2) : ($n2, $n1);
    my $percentage_of_difference = 1 - ($lesser / $greater);
    my $required_percentage = $percent * .01;

#print "percentage_of_difference = $percentage_of_difference, required = $required_percentage\n";



( run in 1.969 second using v1.01-cache-2.11-cpan-97f6503c9c8 )