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