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 Support::TestSetup::login();
  12
  13 my $part = SL::DB::Manager::Part->get_first;
  14 is(ref $part, 'SL::DB::Part', 'loading a part to test with id ' . $part->id);
  15
  16 my $wh = SL::DB::Manager::Warehouse->get_first;
  17 is(ref $wh, 'SL::DB::Warehouse', 'loading a warehouse to test with id ' . $wh->id);
  18
  19 my $bin1 = $wh->bins->[0];
  20 is(ref $bin1, 'SL::DB::Bin', 'getting first bin to test with id ' . $bin1->id);
  21
  22 my $bin2 = $wh->bins->[1];
  23 is(ref $bin2, 'SL::DB::Bin', 'getting another bin to test with id ' . $bin2->id);
  24
  25 my $report = sub {
  26   $::form->{l_warehouseid} = 'Y';
  27   $::form->{l_binid} = 'Y';
  28   my ($result) = WH->get_warehouse_report(
  29     warehouse_id => $wh->id,
  30     bin_id       => $bin1->id,
  31     partsid      => $part->id,
  32     chargenumber => '',
  33   );
  34   $result->{qty} ||= 0;
  35   return $result;
  36 };
  37
  38 sub test (&@) {
  39   my ($arg_sub, @transfers) = @_;
  40   my $before = $report->();
  41
  42   WH->transfer(@transfers);
  43
  44   my $after  = $report->();
  45   my @args   = $arg_sub->($before, $after);
  46
  47   is $args[0], $args[1], $args[2];
  48 }
  49
  50 test { shift->{qty}, shift->{qty} + 4, 'transfer one way' } {
  51    transfer_type    => 'transfer',
  52    parts_id         => $part->id,
  53    src_warehouse_id => $wh->id,
  54    dst_warehouse_id => $wh->id,
  55    src_bin_id       => $bin1->id,
  56    dst_bin_id       => $bin2->id,
  57    qty              => 4,
  58    chargenumber     => '',
  59 };
  60
  61 #################################################
  62
  63 test { shift->{qty}, shift->{qty} - 4, 'and back' } {
  64    transfer_type    => 'transfer',
  65    parts_id         => $part->id,
  66    src_warehouse_id => $wh->id,
  67    dst_warehouse_id => $wh->id,
  68    src_bin_id       => $bin2->id,
  69    dst_bin_id       => $bin1->id,
  70    qty              => 4,
  71    chargenumber     => '',
  72 };
  73
  74 ##############################################
  75
  76 use_ok 'SL::DB::TransferType';
  77
  78 # object interface test
  79
  80 test { shift->{qty}, shift->{qty} + 6.2, 'object transfer one way' } {
  81    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
  82    parts            => $part,
  83    src_bin          => $bin1,
  84    dst_bin          => $bin2,
  85    qty              => 6.2,
  86    chargenumber     => '',
  87 };
  88
  89 #############################################
  90
  91 test { shift->{qty}, shift->{qty} - 6.2, 'full object transfer back' } {
  92    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
  93    parts            => $part,
  94    src_bin          => $bin2,
  95    src_warehouse    => $wh,
  96    dst_bin          => $bin1,
  97    dst_warehouse    => $wh,
  98    qty              => 6.2,
  99    chargenumber     => '',
 100 };
 101
 102 #############################################
 103
 104 test { shift->{qty}, shift->{qty}, 'back and forth in one transaction' } {
 105    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 106    parts            => $part,
 107    src_bin          => $bin2,
 108    src_warehouse    => $wh,
 109    dst_bin          => $bin1,
 110    dst_warehouse    => $wh,
 111    qty              => 1,
 112 },
 113 {
 114    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
 115    parts            => $part,
 116    src_bin          => $bin1,
 117    src_warehouse    => $wh,
 118    dst_bin          => $bin2,
 119    dst_warehouse    => $wh,
 120    qty              => 1,
 121 };
 122
 123
 124 done_testing;
 125
 126 1;