t/wh/transfer.t

   1 use strict;
   2 use Test::More;
   3
   4 use lib 't';
   5
   6 use_ok 'Support::TestSetup';
   7 use_ok 'SL::DB::Bin';
   8 use_ok 'SL::DB::Part';
   9 use_ok 'SL::DB::Warehouse';
  10 use_ok 'SL::WH';
  11
  12 use_ok('SL::DB::Inventory');
  13
  14 use constant NAME => 'UnitTestObject';
  15
  16 Support::TestSetup::login();
  17
  18 # Clean up: remove test objects for part, warehouse, bin
  19 my $part = SL::DB::Manager::Part->get_first(partnumber => NAME(), description => NAME());
  20 if ($part) {
  21   SL::DB::Manager::Inventory->delete_all(where => [ parts_id => $part->id ]);
  22   $part->delete;
  23 }
  24
  25 SL::DB::Manager::Bin      ->delete_all(where => [ or => [ description => NAME() . "1", description => NAME() . "2" ] ]);
  26 SL::DB::Manager::Warehouse->delete_all(where => [ description => NAME() ]);
  27
  28 # Create test data
  29 $part = SL::DB::Part->new(unit => 'mg', description => NAME(), partnumber => NAME());
  30 $part->save();
  31
  32 is(ref($part), 'SL::DB::Part', 'loading a part to test with id ' . $part->id);
  33
  34 my $wh = SL::DB::Warehouse->new(description => NAME(), invalid => 0);
  35 $wh->save;
  36 is(ref $wh, 'SL::DB::Warehouse', 'loading a warehouse to test with id ' . $wh->id);
  37
  38 my $bin1 = SL::DB::Bin->new(description => NAME() . "1", warehouse_id => $wh->id);
  39 $bin1->save;
  40 is(ref $bin1, 'SL::DB::Bin', 'getting first bin to test with id ' . $bin1->id);
  41
  42 my $bin2 = SL::DB::Bin->new(description => NAME() . "2", warehouse_id => $wh->id);
  43 $bin2->save;
  44 is(ref $bin2, 'SL::DB::Bin', 'getting another bin to test with id ' . $bin2->id);
  45
  46 my $report = sub {
  47   $::form->{l_warehouseid} = 'Y';
  48   $::form->{l_binid} = 'Y';
  49   my ($result) = WH->get_warehouse_report(
  50     warehouse_id => $wh->id,
  51     bin_id       => $bin1->id,
  52     partsid      => $part->id,
  53     chargenumber => '',
  54   );
  55   $result->{qty} ||= 0;
  56   return $result;
  57 };
  58
  59 sub test (&@) {
  60   my ($arg_sub, @transfers) = @_;
  61   my $before = $report->();
  62
  63   WH->transfer(@transfers);
  64
  65   my $after  = $report->();
  66   my @args   = $arg_sub->($before, $after);
  67
  68   is $args[0], $args[1], $args[2];
  69 }
  70
  71 test { shift->{qty}, shift->{qty} + 4, 'transfer one way' } {
  72    transfer_type    => 'transfer',
  73    parts_id         => $part->id,
  74    src_warehouse_id => $wh->id,
  75    dst_warehouse_id => $wh->id,
  76    src_bin_id       => $bin1->id,
  77    dst_bin_id       => $bin2->id,
  78    qty              => 4,
  79    chargenumber     => '',
  80 };
  81
  82 #################################################
  83
  84 test { shift->{qty}, shift->{qty} - 4, 'and back' } {
  85    transfer_type    => 'transfer',
  86    parts_id         => $part->id,
  87    src_warehouse_id => $wh->id,
  88    dst_warehouse_id => $wh->id,
  89    src_bin_id       => $bin2->id,
  90    dst_bin_id       => $bin1->id,
  91    qty              => 4,
  92    chargenumber     => '',
  93 };
  94
  95 #################################################
  96
  97 test {shift->{qty}, shift->{qty} + 4000000000, 'transfer one way with unit'} {
  98    transfer_type    => 'transfer',
  99    parts_id         => $part->id,
 100    src_warehouse_id => $wh->id,
 101    dst_warehouse_id => $wh->id,
 102    src_bin_id       => $bin1->id,
 103    dst_bin_id       => $bin2->id,
 104    qty              => 4,
 105    unit             => 't',
 106    chargenumber     => '',
 107 };
 108
 109 ##############################################
 110
 111 use_ok 'SL::DB::TransferType';
 112
 113 # object interface test
 114
 115 test { shift->{qty}, shift->{qty} + 6.2, 'object transfer one way' } {
 116    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 117    parts            => $part,
 118    src_bin          => $bin1,
 119    dst_bin          => $bin2,
 120    qty              => 6.2,
 121    chargenumber     => '',
 122 };
 123
 124 #############################################
 125
 126 test { shift->{qty}, shift->{qty} - 6.2, 'full object transfer back' } {
 127    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 128    parts            => $part,
 129    src_bin          => $bin2,
 130    src_warehouse    => $wh,
 131    dst_bin          => $bin1,
 132    dst_warehouse    => $wh,
 133    qty              => 6.2,
 134    chargenumber     => '',
 135 };
 136
 137 #############################################
 138
 139 test { shift->{qty}, shift->{qty}, 'back and forth in one transaction' } {
 140    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 141    parts            => $part,
 142    src_bin          => $bin2,
 143    src_warehouse    => $wh,
 144    dst_bin          => $bin1,
 145    dst_warehouse    => $wh,
 146    qty              => 1,
 147 },
 148 {
 149    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 150    parts            => $part,
 151    src_bin          => $bin1,
 152    src_warehouse    => $wh,
 153    dst_bin          => $bin2,
 154    dst_warehouse    => $wh,
 155    qty              => 1,
 156 };
 157
 158 #############################################
 159
 160 test { shift->{qty}, shift->{qty}, 'warehouse reduced interface' } {
 161    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 162    parts            => $part,
 163    src_bin          => $bin2,
 164    dst_bin          => $bin1,
 165    qty              => 1,
 166 },
 167 {
 168    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 169    parts            => $part,
 170    src_bin          => $bin1,
 171    dst_bin          => $bin2,
 172    qty              => 1,
 173 };
 174
 175
 176 SL::DB::Manager::Inventory->delete_objects(where => [parts_id => $part->id]);
 177
 178 $bin1->delete;
 179 $bin2->delete;
 180 $wh->delete;
 181 $part->delete;
 182
 183 done_testing;
 184
 185 1;