1 package SL::Dev::Inventory;
6 create_warehouse_and_bins set_stock transfer_stock
7 transfer_sales_delivery_order transfer_purchase_delivery_order
8 transfer_delivery_order_item transfer_in transfer_out
11 use SL::DB::Warehouse;
13 use SL::DB::Inventory;
14 use SL::DB::TransferType;
16 use SL::DB::DeliveryOrderItemsStock;
22 sub create_warehouse_and_bins {
25 my $number_of_bins = $params{number_of_bins} || 5;
26 my $wh = SL::DB::Warehouse->new(description => $params{warehouse_description} || "Warehouse", invalid => 0);
27 for my $i ( 1 .. $number_of_bins ) {
28 $wh->add_bins( SL::DB::Bin->new(description => ( $params{bin_description} || "Bin" ) . " $i" ) );
31 return ($wh, $wh->bins->[0]);
37 die "param part is missing or not an SL::DB::Part object" unless ref($params{part}) eq 'SL::DB::Part';
38 my $part = delete $params{part};
39 die "qty is missing" unless $params{qty} or $params{abs_qty};
40 die "need a bin or default bin" unless $part->warehouse_id or $part->bin_id or $params{bin} or $params{bin_id};
42 my ($warehouse_id, $bin_id);
45 die "illegal param bin: " . Dumper($params{bin}) unless ref($params{bin}) eq 'SL::DB::Bin';
46 my $bin = delete $params{bin};
48 $warehouse_id = $bin->warehouse_id;
49 } elsif ( $params{bin_id} ) {
50 my $bin = SL::DB::Manager::Bin->find_by(id => delete $params{bin_id});
52 $warehouse_id = $bin->warehouse_id;
53 } elsif ( $part->bin_id ) {
54 $bin_id = $part->bin_id;
55 $warehouse_id = $part->warehouse_id;
57 die "can't determine bin and warehouse";
60 my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
61 die "Can't determine employee" unless $employee_id;
63 my $qty = delete $params{qty};
65 my $transfer_type_description;
67 if ( $params{abs_qty} ) {
68 # determine the current qty and calculate the qty diff that needs to be applied
69 # if abs_qty is set then any value that was in $params{qty} is ignored/overwritten
71 $get_stock_params{bin_id} = $bin_id if $bin_id;
72 # $get_stock_params{warehouse_id} = $warehouse_id if $warehouse_id; # redundant
73 my $current_qty = $part->get_stock(%get_stock_params);
74 $qty = $params{abs_qty} - $current_qty;
78 $transfer_type_description = delete $params{transfer_type} // 'stock';
79 $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'in' );
81 $transfer_type_description = delete $params{transfer_type} // 'shipped';
82 $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'out' );
84 die "can't determine transfer_type" unless $transfer_type;
87 if ( $params{shippingdate} ) {
88 $shippingdate = delete $params{shippingdate};
89 $shippingdate = $::locale->parse_date_to_object($shippingdate) unless ref($shippingdate) eq 'DateTime';
91 $shippingdate = DateTime->today;
95 if ( $params{unit} ) {
96 $unit = delete $params{unit};
97 $unit = SL::DB::Manager::Unit->find_by( name => $unit ) unless ref($unit) eq 'SL::DB::Unit';
98 $qty = $unit->convert_to($qty, $part->unit_obj);
101 my ($trans_id) = $part->db->dbh->selectrow_array("select nextval('id')", {});
103 SL::DB::Inventory->new(
104 parts_id => $part->id,
106 warehouse_id => $warehouse_id,
107 employee_id => $employee_id,
108 trans_type_id => $transfer_type->id,
109 comment => $params{comment},
110 shippingdate => $shippingdate,
112 trans_id => $trans_id,
120 die "missing params" unless ( $params{parts_id} or $params{part} ) and $params{from_bin} and $params{to_bin};
123 if ( $params{parts_id} ) {
124 $part = SL::DB::Manager::Part->find_by( id => delete $params{parts_id} ) or die "illegal parts_id";
126 $part = delete $params{part};
128 die "illegal part" unless ref($part) eq 'SL::DB::Part';
130 my $from_bin = delete $params{from_bin};
131 my $to_bin = delete $params{to_bin};
132 die "illegal bins" unless ref($from_bin) eq 'SL::DB::Bin' and ref($to_bin) eq 'SL::DB::Bin';
134 my $qty = delete($params{qty});
135 die "qty must be > 0" unless $qty > 0;
138 my $transfer_type = SL::DB::Manager::TransferType->find_by(description => 'transfer') or die "can't determine transfer type";
139 my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
142 'bestbefore' => undef,
143 'change_default_bin' => undef,
144 'chargenumber' => '',
145 'comment' => delete $params{comment} // '',
146 'dst_bin_id' => $to_bin->id,
147 'dst_warehouse_id' => $to_bin->warehouse_id,
148 'parts_id' => $part->id,
150 'src_bin_id' => $from_bin->id,
151 'src_warehouse_id' => $from_bin->warehouse_id,
152 'transfer_type_id' => $transfer_type->id,
155 WH->transfer($WH_params);
159 # do it manually via rose:
162 # my $db = SL::DB::Inventory->new->db;
163 # $db->with_transaction(sub{
164 # ($trans_id) = $db->dbh->selectrow_array("select nextval('id')", {});
165 # die "no trans_id" unless $trans_id;
168 # shippingdate => delete $params{shippingdate} // DateTime->today,
169 # employee_id => $employee_id,
170 # trans_id => $trans_id,
171 # trans_type_id => $transfer_type->id,
172 # parts_id => $part->id,
173 # comment => delete $params{comment} || 'Umlagerung',
176 # SL::DB::Inventory->new(
177 # warehouse_id => $from_bin->warehouse_id,
178 # bin_id => $from_bin->id,
183 # SL::DB::Inventory->new(
184 # warehouse_id => $to_bin->warehouse_id,
185 # bin_id => $to_bin->id,
189 # }) or die $@ . "\n";
196 my $transfer_type = delete $params{transfer_type};
198 die "param transfer_type is not a SL::DB::TransferType object: " . Dumper($transfer_type) unless ref($transfer_type) eq 'SL::DB::TransferType';
200 my $shippingdate = delete $params{shippingdate} // DateTime->today;
202 my $part = delete($params{part}) or croak 'part missing';
203 my $qty = delete($params{qty}) or croak 'qty missing';
205 # distinguish absolute qty in inventory depending on transfer type direction
206 $qty *= -1 if $transfer_type->direction eq 'out';
208 # use defaults for unit/wh/bin is they exist and nothing else is specified
209 my $unit = delete($params{unit}) // $part->unit or croak 'unit missing';
210 my $bin = delete($params{bin}) // $part->bin or croak 'bin missing';
211 # if bin is given, we don't need a warehouse param
212 my $wh = $bin->warehouse or croak 'wh missing';
215 parts_id => $part->id,
219 transfer_type => $transfer_type,
221 comment => delete $params{comment},
222 shippingdate => $shippingdate,
229 my $transfer_type = delete $params{transfer_type} // 'stock';
231 my $transfer_type_obj = SL::DB::Manager::TransferType->find_by( direction => 'in', description => $transfer_type ) or die "Can't find transfer_type with direction in and descriptin " . $params{transfer_type};
233 $params{transfer_type} = $transfer_type_obj;
241 my $transfer_type = delete $params{transfer_type} // 'shipped';
243 my $transfer_type_obj = SL::DB::Manager::TransferType->find_by( direction => 'out', description => $transfer_type ) or die "Can't find transfer_type with direction in and descriptin " . $params{transfer_type};
245 $params{transfer_type} = $transfer_type_obj;
250 sub transfer_sales_delivery_order {
251 my ($sales_delivery_order) = @_;
252 die "first argument must be a sales delivery order Rose DB object" unless ref($sales_delivery_order) eq 'SL::DB::DeliveryOrder' and $sales_delivery_order->is_sales;
254 die "the delivery order has already been delivered" if $sales_delivery_order->delivered;
256 my ($wh, $bin, $trans_type);
258 $sales_delivery_order->db->with_transaction(sub {
260 foreach my $doi ( @{ $sales_delivery_order->items } ) {
261 next if $doi->part->is_service or $doi->part->is_assortment;
262 my $trans_type = SL::DB::Manager::TransferType->find_by(direction => 'out', description => 'shipped');
263 transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
265 $sales_delivery_order->delivered(1);
266 $sales_delivery_order->save(changes_only=>1);
268 }) or die "error while transferring sales_delivery_order: " . $sales_delivery_order->db->error;
271 sub transfer_purchase_delivery_order {
272 my ($purchase_delivery_order) = @_;
273 die "first argument must be a purchase delivery order Rose DB object" unless ref($purchase_delivery_order) eq 'SL::DB::DeliveryOrder' and not $purchase_delivery_order->is_sales;
275 my ($wh, $bin, $trans_type);
277 $purchase_delivery_order->db->with_transaction(sub {
279 foreach my $doi ( @{ $purchase_delivery_order->items } ) {
280 my $trans_type = SL::DB::Manager::TransferType->find_by(direction => 'in', description => 'stock');
281 transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
284 }) or die "error while transferring purchase_Delivery_order: " . $purchase_delivery_order->db->error;
287 sub transfer_delivery_order_item {
288 my ($doi, $wh, $bin, $trans_type) = @_;
290 unless ( defined $trans_type and ref($trans_type eq 'SL::DB::TransferType') ) {
291 if ( $doi->record->is_sales ) {
292 $trans_type //= SL::DB::Manager::TransferType->find_by(direction => 'out', description => 'shipped');
294 $trans_type //= SL::DB::Manager::TransferType->find_by(direction => 'in', description => 'stock');
298 $bin //= $doi->part->bin;
299 $wh //= $doi->part->warehouse;
301 die "no bin and wh specified and part has no default bin or wh" unless $bin and $wh;
303 my $employee = SL::DB::Manager::Employee->current || die "No employee";
305 # dois are converted to base_qty, which is qty
306 # AM->convert_unit( 'g' => 'kg') * 1000; # 1
307 # $doi->unit $doi->part->unit $doi->qty
308 my $dois = SL::DB::DeliveryOrderItemsStock->new(
309 delivery_order_item => $doi,
310 qty => AM->convert_unit($doi->unit => $doi->part->unit) * $doi->qty,
311 unit => $doi->part->unit,
312 warehouse_id => $wh->id,
316 my $inventory = SL::DB::Inventory->new(
317 parts => $dois->delivery_order_item->part,
318 qty => $dois->delivery_order_item->record->is_sales ? $dois->qty * -1 : $dois->qty,
320 warehouse_id => $dois->warehouse_id,
321 bin_id => $dois->bin_id,
322 trans_type_id => $trans_type->id,
323 delivery_order_items_stock => $dois,
324 trans_id => $dois->id,
325 employee_id => $employee->id,
326 shippingdate => $doi->record->transdate,
336 SL::Dev::Inventory - create inventory-related objects for testing, with minimal
341 =head2 C<create_warehouse_and_bins %PARAMS>
343 Creates a new warehouse and bins, and immediately saves them. Returns the
344 warehouse and the first bin object.
346 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
348 Create named warehouse with 10 bins:
350 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(
351 warehouse_description => 'Test warehouse',
352 bin_description => 'Test bin',
353 number_of_bins => 10,
356 To access the second bin:
358 my $bin2 = $wh->bins->[1];
360 =head2 C<set_stock %PARAMS>
362 Change the stock level of a certain part by creating an inventory event.
363 To access the updated onhand the part object needs to be loaded afterwards.
371 Mandatory. An SL::DB::Part object or a parts_id.
375 The qty to increase of decrease the stock level by.
377 Exactly one of C<qty> and C<abs_qty> is mandatory.
381 Sets stock level for a certain part to abs_qty by creating a stock event with
382 the current difference.
384 Exactly one of C<qty> and C<abs_qty> is mandatory.
390 Optional. The bin for inventory entry.
392 If no bin is passed the default bin of the part is used, if that doesn't exist
393 either there will be an error.
395 =item C<shippingdate>
397 Optional. May be a DateTime object or a string that needs to be parsed by
398 parse_date_to_object.
402 Optional. SL::DB::Unit object, or the name of an SL::DB::Unit object.
406 C<set_stock> creates the SL::DB::Inventory object from scratch, rather
407 than passing params to WH->transfer_in or WH->transfer_out.
411 my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
412 SL::Dev::Inventory::set_stock(part => $part, abs_qty => 5);
413 SL::Dev::Inventory::set_stock(part => $part, qty => -2);
417 Set stock level of a part in a certain bin_id to 10:
419 SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
421 Create 10 warehouses with 5 bins each, then create 100 parts and increase the
422 stock qty in a random bin by a random positive qty for each of the parts:
424 SL::Dev::Inventory::create_warehouse_and_bins(
425 warehouse_description => "Test Warehouse $_"
427 SL::Dev::Part::create_part(
428 description => "Test Part $_"
429 )->save for 1 .. 100;
430 my $bins = SL::DB::Manager::Bin->get_all;
431 SL::Dev::Inventory::set_stock(
433 qty => int(rand(99))+1,
434 bin => $bins->[ rand @{$bins} ],
435 ) for @{ SL::DB::Manager::Part->get_all };
437 =head2 C<transfer_stock %PARAMS>
439 Transfers parts from one bin to another.
449 Mandatory. An SL::DB::Part object or a parts_id.
455 Mandatory. SL::DB::Bin objects.
461 =item C<shippingdate>
467 The unit is always base_unit and there is no check for negative stock values.
469 Example: Create a warehouse and bins, a part, stock the part and then move some
470 of the stock to a different bin inside the same warehouse:
472 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
473 my $part = SL::Dev::Part::create_part->save;
474 SL::Dev::Inventory::set_stock(
476 bin_id => $wh->bins->[2]->id,
479 SL::Dev::Inventory::transfer_stock(
481 from_bin => $wh->bins->[2],
482 to_bin => $wh->bins->[4],
485 $part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
486 $part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
488 =head2 C<transfer_sales_delivery_order %PARAMS>
490 Takes a SL::DB::DeliveryOrder object as its first argument and transfers out
491 all the items via their default bin, creating the delivery_order_stock and
494 Assumes a fresh delivery order where nothing has been transferred out yet.
496 Should work like the functions in do.pl transfer_in/transfer_out and DO.pm
497 transfer_in_out, except that those work on the current form where as this just
498 works on database objects.
500 As this is just Dev it doesn't check for negative stocks etc.
504 my $sales_delivery_order = SL::DB::Manager::DeliveryOrder->find_by(donumber => 112);
505 SL::Dev::Inventory::transfer_sales_delivery_order($sales_delivery_order1);
507 =head2 C<transfer_purchase_delivery_order %PARAMS>
509 Transfer in all the items in a purchase order.
511 Behaves like C<transfer_sales_delivery_order>.
513 =head2 C<transfer_delivery_order_item @PARAMS>
515 Transfers a delivery order item from a delivery order. The whole qty is transferred.
516 Doesn't check for available qty.
520 SL::Dev::Inventory::transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
522 =head2 C<transfer_in %PARAMS>
524 Create stock in event for a part. Ideally the interface should mirror how data
525 is entered via the web interface.
527 Does some param checking, sets some defaults, but otherwise uses WH->transfer.
535 Mandatory. An SL::DB::Part object.
543 Optional. An SL::DB::Bin object, defaults to $part->bin.
547 Optional. An SL::DB::Bin object, defaults to $part->warehouse.
551 Optional. A string such as 't', 'Stck', defaults to $part->unit->name.
553 =item C<shippingdate>
555 Optional. A DateTime object, defaults to today.
557 =item C<transfer_type>
559 Optional. A string such as 'correction', defaults to 'stock'.
567 Example minimal usage using part default warehouse and bin:
569 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
570 my $part = SL::Dev::Part::create_part(
575 SL::Dev::Inventory::transfer_in(
579 comment => '900 kg in t',
582 Example with specific transfer_type and warehouse and bin and shipping_date:
584 my $shipping_date = DateTime->today->subtract( days => 20 );
585 SL::Dev::Inventory::transfer_in(
588 transfer_type => 'correction',
590 shipping_date => $shipping_date,
593 =head2 C<transfer_out %PARAMS>
595 Create stock out event for a part. See C<transfer_in>.
603 G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>