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 my $r1 = $report->();
  39
  40 WH->transfer({
  41    transfer_type    => 'transfer',
  42    parts_id         => $part->id,
  43    src_warehouse_id => $wh->id,
  44    dst_warehouse_id => $wh->id,
  45    src_bin_id       => $bin1->id,
  46    dst_bin_id       => $bin2->id,
  47    qty              => 4,
  48    chargenumber     => '',
  49 });
  50
  51 my $r2 = $report->();
  52
  53 is $r1->{qty}, $r2->{qty} + 4, 'transfer one way';
  54
  55 #################################################
  56
  57 WH->transfer({
  58    transfer_type    => 'transfer',
  59    parts_id         => $part->id,
  60    src_warehouse_id => $wh->id,
  61    dst_warehouse_id => $wh->id,
  62    src_bin_id       => $bin2->id,
  63    dst_bin_id       => $bin1->id,
  64    qty              => 4,
  65    chargenumber     => '',
  66 });
  67
  68
  69 my $r3 = $report->();
  70
  71 is $r2->{qty}, $r3->{qty} - 4, 'and back';
  72
  73 ##############################################
  74
  75 use_ok 'SL::DB::TransferType';
  76
  77 # object interface test
  78
  79 WH->transfer({
  80    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
  81    parts            => $part,
  82    src_bin          => $bin1,
  83    dst_bin          => $bin2,
  84    qty              => 6.2,
  85    chargenumber     => '',
  86 });
  87
  88 my $r4 = $report->();
  89
  90 is $r3->{qty}, $r4->{qty} + 6.2, 'object transfer one way';
  91
  92 #############################################
  93
  94 WH->transfer({
  95    transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
  96    parts            => $part,
  97    src_bin          => $bin2,
  98    src_warehouse    => $wh,
  99    dst_bin          => $bin1,
 100    dst_warehouse    => $wh,
 101    qty              => 6.2,
 102    chargenumber     => '',
 103 });
 104
 105 my $r5 = $report->();
 106
 107 is $r4->{qty}, $r5->{qty} - 6.2, 'full object transfer back';
 108
 109 done_testing;
 110
 111
 112
 113
 114
 115 1;