The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;

use Test::More tests => 28;

BEGIN { use_ok('Algorithm::BinPack') };

my $bp = Algorithm::BinPack->new(binsize => 4);

isa_ok($bp, "Algorithm::BinPack");
is($bp->{binsize}, 4);

$bp->add_item(label => 'one',   size => 1);
$bp->add_item(label => 'two',   size => 2);
$bp->add_item(label => 'three', size => 3, misc => "This item is the best");
$bp->add_item(label => 'four',  size => 4, desc => "The fourth item");

my @bins = $bp->pack_bins;

# check pack order
is($bins[0]{items}[0]{label}, "four");
is($bins[1]{items}[0]{label}, "three");
is($bins[1]{items}[1]{label}, "one");
is($bins[2]{items}[0]{label}, "two");

# add items manually
$bp->prefill_bin(bin => 2, size => 3, label => 'manual',
                 manual => 'Item was added manually');
$bp->add_item(bin => 3, size => 4, label => 'another', meta => 'data');

@bins = $bp->pack_bins;

# check pack order
is($bins[0]{items}[0]{label}, "four");
is($bins[1]{items}[0]{label}, "three");
is($bins[1]{items}[1]{label}, "one");
is($bins[2]{items}[0]{label}, "manual");
is($bins[3]{items}[0]{label}, "another");
is($bins[4]{items}[0]{label}, "two");

# check extra keys
is($bins[0]{items}[0]{desc},   "The fourth item");
is($bins[1]{items}[0]{misc},   "This item is the best");
is($bins[2]{items}[0]{manual}, "Item was added manually");
is($bins[3]{items}[0]{meta},   "data");

# capture and test warning messages
my $warning;
$SIG{__WARN__} = sub { $warning = $_[0] };

# check for missing arguments
my @add_items = (
    [qw(label five)],
    [qw(size 5)],
);
my @prefill_bins = (
    [qw(      label Manual size 4)],
    [qw(bin 0              size 4)],
    [qw(bin 0 label Manual       )],
);

for (@add_items) {
    $warning = "";
    $bp->add_item(@$_);
    like($warning, qr/Missing argument/);
}

for (@prefill_bins) {
    $warning = "";
    $bp->prefill_bin(@$_);
    like($warning, qr/Missing argument/);
}

# check for too-big items
$warning = "";
$bp->prefill_bin(bin => 0, label => "Manual", size => 5);
like($warning, qr/too big/);

$warning = "";
$bp->add_item(bin => 0, label => "Manual", size => 5);
like($warning, qr/too big/);

$warning = "";
$bp->prefill_bin(bin => 0, label => "Manual", size => 4); # fill the bin up
$bp->prefill_bin(bin => 0, label => "Manual", size => 1); # try to add an item to go past full
like($warning, qr/too big/);

$warning = "";
$bp->add_item(bin => 0, label => "Manual", size => 1); # try to add an item to go past full
like($warning, qr/too big/);

$warning = "";
$bp->add_item(label => 'five', size  => 5);
$bp->pack_bins;
like($warning, qr/too big/);

# check for non-numeric bin
$warning = "";
$bp->prefill_bin(bin => 'a', label => "Manual", size => 4);
like($warning, qr/must be numeric/);