site/cgi-bin/modules/BSE/Shipping.pm

   1 package BSE::Shipping;
   2 use strict;
   3 use Carp qw(confess);
   4 use BSE::CfgInfo qw(load_class);
   5
   6 our $VERSION = "1.003";
   7
   8 sub get_couriers {
   9     my ($class, $cfg, $wanted) = @_;
  10
  11     my @enabled = split /\s+/, $cfg->entry("shipping", "couriers");
  12     push @enabled, "Null" if $cfg->entry("shipping", "quoted", 1);
  13
  14     my @couriers;
  15     foreach my $name (@enabled) {
  16         $name = "Courier::$name";
  17
  18         my $courier;
  19         eval {
  20             load_class($name, $cfg);
  21             $courier = $name->new(config => $cfg);
  22         };
  23         if ($@) {
  24             warn "Unable to load $courier: $@\n";
  25             next;
  26         }
  27         next if defined $wanted and $wanted ne $courier->name();
  28         push @couriers, $courier;
  29     }
  30     return @couriers;
  31 }
  32
  33 # returns one or more parcels to be delivered by a courier
  34 # currently always returns a single parcel
  35 sub package_order {
  36     my ($class, $cfg, $order, $items) = @_;
  37
  38     require BSE::TB::Products;
  39     my $total_weight = 0;
  40     my $total_length = 0;
  41     my $total_width = 0;
  42     my $total_height = 0;
  43     foreach my $item (@$items) {
  44         my $product = BSE::TB::Products->getByPkey($item->{productId});
  45         my $number = $item->{units};
  46
  47         my $weight = $product->{weight};
  48         $weight == 0
  49           and next;
  50
  51         $total_weight += $weight*$number;
  52
  53         # Calculate dimensions for the given number of items. We keep
  54         # filling a stack of n*n squares with products, and measure the
  55         # stack.
  56
  57         my ($L, $W, $H) =
  58             @{$product}{qw(length width height)};
  59         my ($length, $width, $height) = ($L, $W, $H);
  60
  61         $number--;
  62         my $i = 0;
  63         while ($number > 0) {
  64             my $n = $i++ % 3;
  65             if ($n == 0) { $length += $L; }
  66             elsif ($n == 1) { $width += $W; }
  67             elsif ($n == 2) { $height += $H; }
  68             $number >>= 1;
  69         }
  70
  71         # Store the longest length and width of any group of items in
  72         # the order, but keep adding up the heights. Represents
  73         # something like a worst-case packing.
  74
  75         if ($length != 0 && $length > $total_length) {
  76             $total_length = $length;
  77         }
  78
  79         if ($width != 0 && $width > $total_width) {
  80             $total_width = $width;
  81         }
  82
  83         $total_height += $height;
  84     }
  85
  86     wantarray
  87       or confess "package_order() may return multiple packages in the future";
  88
  89     return BSE::Shipping::Parcel->new
  90       (
  91        length => $total_length,
  92        width => $total_width,
  93        height => $total_height,
  94        weight => $total_weight
  95       );
  96 }
  97
  98 package BSE::Shipping::Parcel;
  99 use strict;
 100 use Carp qw(confess);
 101
 102 # simple wrapper around length/width/height/weight
 103
 104 sub new {
 105   my ($class, %opts) = @_;
 106
 107   defined $opts{length}
 108     or confess "Missing length option";
 109   defined $opts{width}
 110     or confess "Missing width option";
 111   defined $opts{height}
 112     or confess "Missing height option";
 113   defined $opts{weight}
 114     or confess "Missing weight option";
 115
 116   return bless \%opts, $class;
 117 }
 118
 119 # calcuate "cubic weight" as per Australia Post
 120 # as volume in cubic metres * 250
 121 # length/width/height in millimetres
 122 # result is in grams
 123 sub cubic_weight {
 124   my $self = shift;
 125   $self->length / 1000 * $self->width / 1000 * $self->height / 1000 * 250_000;
 126 }
 127
 128 sub length {
 129   $_[0]{length};
 130 }
 131
 132 sub width {
 133   $_[0]{width};
 134 }
 135
 136 sub height {
 137   $_[0]{height};
 138 }
 139
 140 sub weight {
 141   $_[0]{weight};
 142 }
 143
 144 1;
 145