implement shipping costs based on a price per unit with a base price
authorTony Cook <tony@develop-help.com>
Wed, 22 Aug 2012 00:40:25 +0000 (10:40 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 22 Aug 2012 00:40:25 +0000 (10:40 +1000)
MANIFEST
site/cgi-bin/modules/Courier/ByUnitAU.pm [new file with mode: 0644]
t/courier/by-unit.t [new file with mode: 0644]

index 17c2841..082ccc2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -295,6 +295,7 @@ site/cgi-bin/modules/Courier/AustraliaPost/Air.pm
 site/cgi-bin/modules/Courier/AustraliaPost/Express.pm
 site/cgi-bin/modules/Courier/AustraliaPost/Sea.pm
 site/cgi-bin/modules/Courier/AustraliaPost/Standard.pm
+site/cgi-bin/modules/Courier/ByUnitAU.pm
 site/cgi-bin/modules/Courier/Fastway.pm
 site/cgi-bin/modules/Courier/Fastway/Road.pm
 site/cgi-bin/modules/Courier/Fastway/Satchel.pm
@@ -844,6 +845,7 @@ t/cfg/cfg/00start.cfg
 t/cfg/cfg/99end.cfg
 t/cfg/isafile.cfg
 t/cfg/t/varinc.cfg
+t/courier/by-unit.t
 t/data/govhouse.jpg
 t/data/known_pod_issues.txt
 t/data/t101.jpg
diff --git a/site/cgi-bin/modules/Courier/ByUnitAU.pm b/site/cgi-bin/modules/Courier/ByUnitAU.pm
new file mode 100644 (file)
index 0000000..d6ff5a9
--- /dev/null
@@ -0,0 +1,126 @@
+package Courier::ByUnitAU;
+
+our $VERSION = "1.000";
+
+use strict;
+use Courier;
+
+our @ISA = qw(Courier);
+
+sub _config {
+  my ($self, $key, $def) = @_;
+
+  return $self->{config}->entry("by unit au shipping", $key, $def);
+}
+
+sub name {
+  my ($self) = @_;
+
+  return $self->_config("name", "by-unit-au");
+}
+
+sub description {
+  my ($self) = @_;
+
+  return $self->_config("description", "no description set in [by unit au shipping]");
+}
+
+sub can_deliver {
+  my ($self, %opts) = @_;
+
+  return $opts{country} && $opts{country} eq "AU";
+}
+
+sub calculate_shipping {
+  my ($self, %opts) = @_;
+
+  my $base = $self->_config("base");
+
+  unless (defined $base) {
+    $self->{error} = "No base set in [by unit au shipping]";
+    return;
+  }
+
+  my $perunit = $self->_config("perunit");
+
+  unless (defined $perunit) {
+    $self->{error} = "No perunit set in [by unit au shipping]";
+    return;
+  }
+
+  my $units = 0;
+  for my $item (@{$opts{items}}) {
+    $units += $item->{units};
+  }
+
+  return $base + ($units - 1) * $perunit;;
+}
+
+1;
+
+=head1 NAME
+
+Courier::ByUnitAU - cost per unit shipping within Australia
+
+=head1 SYNOPSIS
+
+  [shipping]
+  couriers=ByUnitAU
+
+  [by unit au shipping]
+  description=your description here
+  base=1000
+  perunit=100
+
+=head1 DESCRIPTION
+
+Courier::ByUnitAU provides a common cost per unit to Australia shipping
+option for BSE.
+
+=head1 SHIPPING CALCULATION
+
+The shipping cost is calculated based on the number of units in the
+order, ie. the sum of the unit value in the line items.  It is
+calculated as:
+
+=over
+
+price = base + (units - 1) * perunit
+
+=back
+
+So an order with a single item costs I<base> to send.
+
+=head1 CONFIGURATION
+
+Configuration is done within the C<[by unit au shipping]> section:
+
+=over
+
+=item *
+
+name - internal id of the shipper.  Default: C<by-unit-au>.  Typically
+does not need to be set.
+
+=item *
+
+description - the description of the shipping option displayed to the
+customer.  Default: "no description set in [by unit au shipping]"
+
+=item *
+
+base - the base cost of shipping in cents.  Must be set.
+
+=item *
+
+perunit - the cost in cents of extra units in the order.  Must be set.
+May be zero in which case this becomes equivalent to the Courier::FixedAU
+module.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
diff --git a/t/courier/by-unit.t b/t/courier/by-unit.t
new file mode 100644 (file)
index 0000000..abf2d9b
--- /dev/null
@@ -0,0 +1,49 @@
+#!perl -w
+use strict;
+use Test::More tests => 8;
+use BSE::Cfg;
+use Courier::ByUnitAU;
+
+my $cfg = BSE::Cfg->new_from_text(text => <<EOS, path => ".");
+[by unit au shipping]
+description=testing
+base=1000
+perunit=100
+EOS
+
+my $c = Courier::ByUnitAU->new
+  (
+   config => $cfg,
+  );
+
+ok($c, "create courier object");
+is($c->description, "testing", "test description");
+is($c->name, "by-unit-au", "check name");
+ok($c->can_deliver(country => "AU"), "can deliver to australia");
+ok(!$c->can_deliver(country => "US"), "Can't deliver to US");
+is($c->calculate_shipping
+   (
+    country => "AU",
+    items =>
+    [
+     { units => 1 }
+    ]
+   ), 1000, "one unit order");
+is($c->calculate_shipping
+   (
+    country => "AU",
+    items =>
+    [
+     { units => 2 }
+    ]
+   ), 1100, "two unit order");
+is($c->calculate_shipping
+   (
+    country => "AU",
+    items =>
+    [
+     { units => 2 },
+     { units => 1 },
+     { units => 1 }
+    ]
+   ), 1300, "four unit order");