t/110-courier/020-auspost.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 27;
   4
   5 use Courier::AustraliaPost::Standard;
   6 use Courier::AustraliaPost::Air;
   7 use Courier::AustraliaPost::Sea;
   8 use BSE::Shipping;
   9
  10 my %cfg_work =
  11   (
  12    shipping =>
  13    {
  14     sourcepostcode => "4350",
  15    },
  16    debug =>
  17    {
  18     auspost => 0
  19    },
  20   );
  21
  22 my $cfg = bless \%cfg_work, "Test::Cfg";
  23
  24 my $std = Courier::AustraliaPost::Standard->new(config => $cfg);
  25 my $air = Courier::AustraliaPost::Air->new(config => $cfg);
  26 my $sea = Courier::AustraliaPost::Sea->new(config => $cfg);
  27
  28 ok($std, "make standard courier object");
  29 ok($std->can_deliver(country => "AU",
  30                       suburb => "Westmead",
  31                       postcode => "2145"), "can deliver to australia");
  32 ok(!$std->can_deliver(country => "NZ"),
  33    "can't deliver to NZ");
  34
  35 my $tiny_parcel = BSE::Shipping::Parcel->new
  36   (
  37    length => 50,
  38    width => 20,
  39    height => 20,
  40    weight => 200
  41   );
  42 my $small_parcel = BSE::Shipping::Parcel->new
  43   (
  44    length => 100,
  45    width => 200,
  46    height => 200,
  47    weight => 800
  48   );
  49
  50 my $medium_parcel = BSE::Shipping::Parcel->new
  51   (
  52    length => 500,
  53    width => 400,
  54    height => 300,
  55    weight => 6000
  56   );
  57
  58 my $local_tiny_cost = $std->calculate_shipping
  59   (
  60    parcels => [ $tiny_parcel ],
  61    postcode => 4405,
  62    suburb => "Dalby",
  63    country => "AU"
  64   );
  65 ok($local_tiny_cost, "got a local tiny parcel cost")
  66   or diag $std->error_message;
  67 like($local_tiny_cost, qr/^\d+$/, "it's an integer");
  68 print "# $local_tiny_cost\n";
  69
  70 my $local_small_cost = $std->calculate_shipping
  71   (
  72    parcels => [ $small_parcel ],
  73    postcode => 4405,
  74    suburb => "Dalby",
  75    country => "AU"
  76   );
  77 ok($local_small_cost, "got a local small parcel cost")
  78   or diag $std->error_message;
  79 like($local_small_cost, qr/^\d+$/, "it's an integer");
  80 print "# $local_small_cost\n";
  81
  82 my $local_medium_cost = $std->calculate_shipping
  83   (
  84    parcels => [ $medium_parcel ],
  85    postcode => 4405,
  86    suburb => "Dalby",
  87    country => "AU"
  88   );
  89 ok($local_medium_cost, "got a local medium cost")
  90   or diag $std->error_message;
  91 like($local_medium_cost, qr/^\d+$/, "it's an integer");
  92 print "# $local_medium_cost\n";
  93 cmp_ok($local_tiny_cost, "<=", $local_small_cost, "tiny < small");
  94 cmp_ok($local_small_cost, "<=", $local_medium_cost, "small < medium");
  95
  96 # longer distance
  97 my $nsw_medium_cost = $std->calculate_shipping
  98   (
  99    parcels => [ $medium_parcel ],
 100    postcode => 2145,
 101    suburb => "Westmead",
 102    country => "AU"
 103   );
 104
 105 ok($nsw_medium_cost, "got a nsw medium cost");
 106 like($nsw_medium_cost, qr/^\d+$/, "it's an integer");
 107 print "# $nsw_medium_cost\n";
 108 cmp_ok($local_medium_cost, "<=", $nsw_medium_cost, "local <= nsw");
 109
 110 # longest
 111 my $perth_medium_cost = $std->calculate_shipping
 112   (
 113    parcels => [ $medium_parcel ],
 114    postcode => 6000,
 115    suburb => "Perth",
 116    country => "AU"
 117   );
 118
 119 ok($perth_medium_cost, "got a perth medium cost");
 120 like($perth_medium_cost, qr/^\d+$/, "it's an integer");
 121 print "# $perth_medium_cost\n";
 122 cmp_ok($nsw_medium_cost, "<=", $perth_medium_cost, "nsw <= perth");
 123
 124 # international
 125 my $us_medium_cost_air = $air->calculate_shipping
 126   (
 127    parcels => [ $medium_parcel ],
 128    postcode => 6000,
 129    suburb => "Perth",
 130    country => "US"
 131   );
 132
 133 ok($us_medium_cost_air, "got a US medium cost");
 134 like($us_medium_cost_air, qr/^\d+$/, "it's an integer");
 135 print "# $us_medium_cost_air\n";
 136 cmp_ok($perth_medium_cost, "<=", $us_medium_cost_air, "perth <= us air");
 137
 138 my $us_medium_cost_sea = $sea->calculate_shipping
 139   (
 140    parcels => [ $medium_parcel ],
 141    postcode => 6000,
 142    suburb => "Perth",
 143    country => "US"
 144   );
 145
 146 ok($us_medium_cost_sea, "got a US medium cost");
 147 like($us_medium_cost_sea, qr/^\d+$/, "it's an integer");
 148 print "# $us_medium_cost_sea\n";
 149 cmp_ok($perth_medium_cost, "<=", $us_medium_cost_air, "perth <= us air");
 150
 151 # too big
 152 my $too_long = BSE::Shipping::Parcel->new
 153   (
 154    length => 1060,
 155    width => 100,
 156    height => 100,
 157    weight => 200
 158   );
 159 my $too_long_cost = $std->calculate_shipping
 160   (
 161    parcels => [ $too_long ],
 162    postcode => 2145,
 163    suburb => "Westmead",
 164    country => "AU",
 165   );
 166 is($too_long_cost, undef, "too long returns undef");
 167 ok($std->error_message, "some error set");
 168
 169 my $big_girth = BSE::Shipping::Parcel->new
 170   (
 171    length => 4000,
 172    width => 300,
 173    height => 500,
 174    weight => 200
 175   );
 176
 177 my $big_girth_cost = $std->calculate_shipping
 178   (
 179    parcels => [ $big_girth ],
 180    postcode => 2145,
 181    suburb => "Westmead",
 182    country => "AU",
 183   );
 184 is($too_long_cost, undef, "big girth returns undef");
 185 ok($std->error_message, "some error set");
 186
 187 package Test::Cfg;
 188
 189 sub entry {
 190   my ($self, $section, $key, $def) = @_;
 191
 192   exists $self->{$section} or return $def;
 193   exists $self->{$section}{$key} or return $def;
 194   return $self->{$section}{$key};
 195 }