Revision 83bfd1e6
Von Sven Schöling vor etwa 13 Jahren hinzugefügt
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 |
WH->transfer({ |
|
56 |
transfer_type => 'transfer', |
|
57 |
parts_id => $part->id, |
|
58 |
src_warehouse_id => $wh->id, |
|
59 |
dst_warehouse_id => $wh->id, |
|
60 |
src_bin_id => $bin2->id, |
|
61 |
dst_bin_id => $bin1->id, |
|
62 |
qty => 4, |
|
63 |
chargenumber => '', |
|
64 |
}); |
|
65 |
|
|
66 |
|
|
67 |
my $r3 = $report->(); |
|
68 |
|
|
69 |
is $r2->{qty}, $r3->{qty} - 4, 'and back'; |
|
70 |
|
|
71 |
done_testing; |
|
72 |
|
|
73 |
|
|
74 |
|
|
75 |
|
|
76 |
|
|
77 |
1; |
Auch abrufbar als: Unified diff
wh/transfer test
2 warnings noch drin, die aber im moment schlecht fixbar sind.