6 use SL::Dev::Part qw(new_part);
8 use_ok 'Support::TestSetup';
10 use_ok 'SL::DB::Part';
11 use_ok 'SL::DB::Warehouse';
14 use_ok('SL::DB::Inventory');
16 use constant NAME => 'UnitTestObject';
18 Support::TestSetup::login();
20 # Clean up: remove test objects for part, warehouse, bin
21 my $part = SL::DB::Manager::Part->get_first(partnumber => NAME(), description => NAME());
23 SL::DB::Manager::Inventory->delete_all(where => [ parts_id => $part->id ]);
27 SL::DB::Manager::Bin ->delete_all(where => [ or => [ description => NAME() . "1", description => NAME() . "2" ] ]);
28 SL::DB::Manager::Warehouse->delete_all(where => [ description => NAME() ]);
31 $part = new_part(unit => 'mg', description => NAME(), partnumber => NAME())->save();
33 is(ref($part), 'SL::DB::Part', 'loading a part to test with id ' . $part->id);
35 my $wh = SL::DB::Warehouse->new(description => NAME(), invalid => 0);
37 is(ref $wh, 'SL::DB::Warehouse', 'loading a warehouse to test with id ' . $wh->id);
39 my $bin1 = SL::DB::Bin->new(description => NAME() . "1", warehouse_id => $wh->id);
41 is(ref $bin1, 'SL::DB::Bin', 'getting first bin to test with id ' . $bin1->id);
43 my $bin2 = SL::DB::Bin->new(description => NAME() . "2", warehouse_id => $wh->id);
45 is(ref $bin2, 'SL::DB::Bin', 'getting another bin to test with id ' . $bin2->id);
48 $::form->{l_warehouseid} = 'Y';
49 $::form->{l_binid} = 'Y';
50 my ($result) = WH->get_warehouse_report(
51 warehouse_id => $wh->id,
61 my ($arg_sub, @transfers) = @_;
62 my $before = $report->();
64 WH->transfer(@transfers);
66 my $after = $report->();
67 my @args = $arg_sub->($before, $after);
69 is $args[0], $args[1], $args[2];
72 test { shift->{qty}, shift->{qty} + 4, 'transfer one way' } {
73 transfer_type => 'transfer',
74 parts_id => $part->id,
75 src_warehouse_id => $wh->id,
76 dst_warehouse_id => $wh->id,
77 src_bin_id => $bin1->id,
78 dst_bin_id => $bin2->id,
83 #################################################
85 test { shift->{qty}, shift->{qty} - 4, 'and back' } {
86 transfer_type => 'transfer',
87 parts_id => $part->id,
88 src_warehouse_id => $wh->id,
89 dst_warehouse_id => $wh->id,
90 src_bin_id => $bin2->id,
91 dst_bin_id => $bin1->id,
96 #################################################
98 test {shift->{qty}, shift->{qty} + 4000000000, 'transfer one way with unit'} {
99 transfer_type => 'transfer',
100 parts_id => $part->id,
101 src_warehouse_id => $wh->id,
102 dst_warehouse_id => $wh->id,
103 src_bin_id => $bin1->id,
104 dst_bin_id => $bin2->id,
110 ##############################################
112 use_ok 'SL::DB::TransferType';
114 # object interface test
116 test { shift->{qty}, shift->{qty} + 6.2, 'object transfer one way' } {
117 transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
125 #############################################
127 test { shift->{qty}, shift->{qty} - 6.2, 'full object transfer back' } {
128 transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
131 src_warehouse => $wh,
133 dst_warehouse => $wh,
138 #############################################
140 test { shift->{qty}, shift->{qty}, 'back and forth in one transaction' } {
141 transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
144 src_warehouse => $wh,
146 dst_warehouse => $wh,
150 transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
153 src_warehouse => $wh,
155 dst_warehouse => $wh,
159 #############################################
161 test { shift->{qty}, shift->{qty}, 'warehouse reduced interface' } {
162 transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
169 transfer_type => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
177 SL::DB::Manager::Inventory->delete_objects(where => [parts_id => $part->id]);