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
10 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
12 use SL::DB::Warehouse;
14 use SL::DB::Inventory;
15 use SL::DB::TransferType;
17 use SL::DB::DeliveryOrderItemsStock;
23 sub create_warehouse_and_bins {
26 my $number_of_bins = $params{number_of_bins} || 5;
27 my $wh = SL::DB::Warehouse->new(description => $params{warehouse_description} || "Warehouse", invalid => 0);
28 for my $i ( 1 .. $number_of_bins ) {
29 $wh->add_bins( SL::DB::Bin->new(description => ( $params{bin_description} || "Bin" ) . " $i" ) );
32 return ($wh, $wh->bins->[0]);
38 die "param part is missing or not an SL::DB::Part object"
39 unless ref($params{part}) eq 'SL::DB::Part';
41 my $part = delete $params{part};
42 die "qty is missing" unless $params{qty} or $params{abs_qty};
43 die "need a bin or default bin" unless $part->warehouse_id or $part->bin_id or $params{bin} or $params{bin_id};
45 my ($warehouse_id, $bin_id);
48 die "illegal param bin: " . Dumper($params{bin}) unless ref($params{bin}) eq 'SL::DB::Bin';
49 my $bin = delete $params{bin};
51 $warehouse_id = $bin->warehouse_id;
52 } elsif ( $params{bin_id} ) {
53 my $bin = SL::DB::Manager::Bin->find_by(id => delete $params{bin_id});
55 $warehouse_id = $bin->warehouse_id;
56 } elsif ( $part->bin_id ) {
57 $bin_id = $part->bin_id;
58 $warehouse_id = $part->warehouse_id;
60 die "can't determine bin and warehouse";
63 my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
64 die "Can't determine employee" unless $employee_id;
66 my $qty = delete $params{qty};
68 my $transfer_type_description;
70 if ( $params{abs_qty} ) {
71 # determine the current qty and calculate the qty diff that needs to be applied
72 # if abs_qty is set then any value that was in $params{qty} is ignored/overwritten
74 $get_stock_params{bin_id} = $bin_id if $bin_id;
75 # $get_stock_params{warehouse_id} = $warehouse_id if $warehouse_id; # redundant
76 my $current_qty = $part->get_stock(%get_stock_params);
77 $qty = $params{abs_qty} - $current_qty;
81 $transfer_type_description = delete $params{transfer_type} // 'stock';
82 $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'in' );
84 $transfer_type_description = delete $params{transfer_type} // 'shipped';
85 $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'out' );
87 die "can't determine transfer_type" unless $transfer_type;
90 if ( $params{shippingdate} ) {
91 $shippingdate = delete $params{shippingdate};
92 $shippingdate = $::locale->parse_date_to_object($shippingdate) unless ref($shippingdate) eq 'DateTime';
94 $shippingdate = DateTime->today;
98 if ( $params{unit} ) {
99 $unit = delete $params{unit};
100 $unit = SL::DB::Manager::Unit->find_by( name => $unit ) unless ref($unit) eq 'SL::DB::Unit';
101 $qty = $unit->convert_to($qty, $part->unit_obj);
104 my ($trans_id) = $part->db->dbh->selectrow_array("select nextval('id')", {});
106 SL::DB::Inventory->new(
107 parts_id => $part->id,
109 warehouse_id => $warehouse_id,
110 employee_id => $employee_id,
111 trans_type_id => $transfer_type->id,
112 comment => $params{comment},
113 shippingdate => $shippingdate,
115 trans_id => $trans_id,
123 die "missing params" unless ( $params{parts_id} or $params{part} ) and $params{from_bin} and $params{to_bin};
126 if ( $params{parts_id} ) {
127 $part = SL::DB::Manager::Part->find_by( id => delete $params{parts_id} ) or die "illegal parts_id";
129 $part = delete $params{part};
131 die "illegal part" unless ref($part) eq 'SL::DB::Part';
133 my $from_bin = delete $params{from_bin};
134 my $to_bin = delete $params{to_bin};
135 die "illegal bins" unless ref($from_bin) eq 'SL::DB::Bin' and ref($to_bin) eq 'SL::DB::Bin';
137 my $qty = delete($params{qty});
138 die "qty must be > 0" unless $qty > 0;
141 my $transfer_type = SL::DB::Manager::TransferType->find_by(description => 'transfer') or die "can't determine transfer type";
142 my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
145 'bestbefore' => undef,
146 'change_default_bin' => undef,
147 'chargenumber' => '',
148 'comment' => delete $params{comment} // '',
149 'dst_bin_id' => $to_bin->id,
150 'dst_warehouse_id' => $to_bin->warehouse_id,
151 'parts_id' => $part->id,
153 'src_bin_id' => $from_bin->id,
154 'src_warehouse_id' => $from_bin->warehouse_id,
155 'transfer_type_id' => $transfer_type->id,
158 WH->transfer($WH_params);
162 # do it manually via rose:
165 # my $db = SL::DB::Inventory->new->db;
166 # $db->with_transaction(sub{
167 # ($trans_id) = $db->dbh->selectrow_array("select nextval('id')", {});
168 # die "no trans_id" unless $trans_id;
171 # shippingdate => delete $params{shippingdate} // DateTime->today,
172 # employee_id => $employee_id,
173 # trans_id => $trans_id,
174 # trans_type_id => $transfer_type->id,
175 # parts_id => $part->id,
176 # comment => delete $params{comment} || 'Umlagerung',
179 # SL::DB::Inventory->new(
180 # warehouse_id => $from_bin->warehouse_id,
181 # bin_id => $from_bin->id,
186 # SL::DB::Inventory->new(
187 # warehouse_id => $to_bin->warehouse_id,
188 # bin_id => $to_bin->id,
192 # }) or die $@ . "\n";
199 my $transfer_type = delete $params{transfer_type};
201 die "param transfer_type is not a SL::DB::TransferType object: " . Dumper($transfer_type)
202 unless ref($transfer_type) eq 'SL::DB::TransferType';
204 my $shippingdate = delete $params{shippingdate} // DateTime->today;
206 my $part = delete($params{part}) or croak 'part missing';
207 my $qty = delete($params{qty}) or croak 'qty missing';
209 # distinguish absolute qty in inventory depending on transfer type direction
210 $qty *= -1 if $transfer_type->direction eq 'out';
212 # use defaults for unit/wh/bin is they exist and nothing else is specified
213 my $unit = delete($params{unit}) // $part->unit or croak 'unit missing';
214 my $bin = delete($params{bin}) // $part->bin or croak 'bin missing';
215 # if bin is given, we don't need a warehouse param
216 my $wh = $bin->warehouse or croak 'wh missing';
219 parts_id => $part->id,
223 transfer_type => $transfer_type,
225 comment => delete $params{comment},
226 shippingdate => $shippingdate,
233 my $transfer_type = delete $params{transfer_type} // 'stock';
235 my $transfer_type_obj = SL::DB::Manager::TransferType->find_by(
237 description => $transfer_type,
238 ) or die "Can't find transfer_type with direction in and description " . $params{transfer_type};
240 $params{transfer_type} = $transfer_type_obj;
248 my $transfer_type = delete $params{transfer_type} // 'shipped';
250 my $transfer_type_obj = SL::DB::Manager::TransferType->find_by(
252 description => $transfer_type,
253 ) or die "Can't find transfer_type with direction in and description " . $params{transfer_type};
255 $params{transfer_type} = $transfer_type_obj;
260 sub transfer_sales_delivery_order {
261 my ($sales_delivery_order) = @_;
262 die "first argument must be a sales delivery order Rose DB object"
263 unless ref($sales_delivery_order) eq 'SL::DB::DeliveryOrder'
264 and $sales_delivery_order->is_sales;
266 die "the delivery order has already been delivered" if $sales_delivery_order->delivered;
268 my ($wh, $bin, $trans_type);
270 $sales_delivery_order->db->with_transaction(sub {
272 foreach my $doi ( @{ $sales_delivery_order->items } ) {
273 next if $doi->part->is_service or $doi->part->is_assortment;
274 my $trans_type = SL::DB::Manager::TransferType->find_by(direction => 'out', description => 'shipped');
275 transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
277 $sales_delivery_order->delivered(1);
278 $sales_delivery_order->save(changes_only=>1);
280 }) or die "error while transferring sales_delivery_order: " . $sales_delivery_order->db->error;
283 sub transfer_purchase_delivery_order {
284 my ($purchase_delivery_order) = @_;
285 die "first argument must be a purchase delivery order Rose DB object"
286 unless ref($purchase_delivery_order) eq 'SL::DB::DeliveryOrder'
287 and not $purchase_delivery_order->is_sales;
289 my ($wh, $bin, $trans_type);
291 $purchase_delivery_order->db->with_transaction(sub {
293 foreach my $doi ( @{ $purchase_delivery_order->items } ) {
294 my $trans_type = SL::DB::Manager::TransferType->find_by(direction => 'in', description => 'stock');
295 transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
298 }) or die "error while transferring purchase_Delivery_order: " . $purchase_delivery_order->db->error;
301 sub transfer_delivery_order_item {
302 my ($doi, $wh, $bin, $trans_type) = @_;
304 unless ( defined $trans_type and ref($trans_type eq 'SL::DB::TransferType') ) {
305 if ( $doi->record->is_sales ) {
306 $trans_type //= SL::DB::Manager::TransferType->find_by(direction => 'out', description => 'shipped');
308 $trans_type //= SL::DB::Manager::TransferType->find_by(direction => 'in', description => 'stock');
312 $bin //= $doi->part->bin;
313 $wh //= $doi->part->warehouse;
315 die "no bin and wh specified and part has no default bin or wh" unless $bin and $wh;
317 my $employee = SL::DB::Manager::Employee->current || die "No employee";
319 # dois are converted to base_qty, which is qty
320 # AM->convert_unit( 'g' => 'kg') * 1000; # 1
321 # $doi->unit $doi->part->unit $doi->qty
322 my $dois = SL::DB::DeliveryOrderItemsStock->new(
323 delivery_order_item => $doi,
324 qty => AM->convert_unit($doi->unit => $doi->part->unit) * $doi->qty,
325 unit => $doi->part->unit,
326 warehouse_id => $wh->id,
330 my $inventory = SL::DB::Inventory->new(
331 parts => $dois->delivery_order_item->part,
332 qty => $dois->delivery_order_item->record->is_sales ? $dois->qty * -1 : $dois->qty,
334 warehouse_id => $dois->warehouse_id,
335 bin_id => $dois->bin_id,
336 trans_type_id => $trans_type->id,
337 delivery_order_items_stock => $dois,
338 trans_id => $dois->id,
339 employee_id => $employee->id,
340 shippingdate => $doi->record->transdate,
350 SL::Dev::Inventory - create inventory-related objects for testing, with minimal
355 =head2 C<create_warehouse_and_bins %PARAMS>
357 Creates a new warehouse and bins, and immediately saves them. Returns the
358 warehouse and the first bin object.
360 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
362 Create named warehouse with 10 bins:
364 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(
365 warehouse_description => 'Test warehouse',
366 bin_description => 'Test bin',
367 number_of_bins => 10,
370 To access the second bin:
372 my $bin2 = $wh->bins->[1];
374 =head2 C<set_stock %PARAMS>
376 Change the stock level of a certain part by creating an inventory event.
377 To access the updated onhand the part object needs to be loaded afterwards.
385 Mandatory. An SL::DB::Part object or a parts_id.
389 The qty to increase of decrease the stock level by.
391 Exactly one of C<qty> and C<abs_qty> is mandatory.
395 Sets stock level for a certain part to abs_qty by creating a stock event with
396 the current difference.
398 Exactly one of C<qty> and C<abs_qty> is mandatory.
404 Optional. The bin for inventory entry.
406 If no bin is passed the default bin of the part is used, if that doesn't exist
407 either there will be an error.
409 =item C<shippingdate>
411 Optional. May be a DateTime object or a string that needs to be parsed by
412 parse_date_to_object.
416 Optional. SL::DB::Unit object, or the name of an SL::DB::Unit object.
420 C<set_stock> creates the SL::DB::Inventory object from scratch, rather
421 than passing params to WH->transfer_in or WH->transfer_out.
425 my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
426 SL::Dev::Inventory::set_stock(part => $part, abs_qty => 5);
427 SL::Dev::Inventory::set_stock(part => $part, qty => -2);
431 Set stock level of a part in a certain bin_id to 10:
433 SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
435 Create 10 warehouses with 5 bins each, then create 100 parts and increase the
436 stock qty in a random bin by a random positive qty for each of the parts:
438 SL::Dev::Inventory::create_warehouse_and_bins(
439 warehouse_description => "Test Warehouse $_"
441 SL::Dev::Part::create_part(
442 description => "Test Part $_"
443 )->save for 1 .. 100;
444 my $bins = SL::DB::Manager::Bin->get_all;
445 SL::Dev::Inventory::set_stock(
447 qty => int(rand(99))+1,
448 bin => $bins->[ rand @{$bins} ],
449 ) for @{ SL::DB::Manager::Part->get_all };
451 =head2 C<transfer_stock %PARAMS>
453 Transfers parts from one bin to another.
463 Mandatory. An SL::DB::Part object or a parts_id.
469 Mandatory. SL::DB::Bin objects.
475 =item C<shippingdate>
481 The unit is always base_unit and there is no check for negative stock values.
483 Example: Create a warehouse and bins, a part, stock the part and then move some
484 of the stock to a different bin inside the same warehouse:
486 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
487 my $part = SL::Dev::Part::create_part->save;
488 SL::Dev::Inventory::set_stock(
490 bin_id => $wh->bins->[2]->id,
493 SL::Dev::Inventory::transfer_stock(
495 from_bin => $wh->bins->[2],
496 to_bin => $wh->bins->[4],
499 $part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
500 $part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
502 =head2 C<transfer_sales_delivery_order %PARAMS>
504 Takes a SL::DB::DeliveryOrder object as its first argument and transfers out
505 all the items via their default bin, creating the delivery_order_stock and
508 Assumes a fresh delivery order where nothing has been transferred out yet.
510 Should work like the functions in do.pl transfer_in/transfer_out and DO.pm
511 transfer_in_out, except that those work on the current form where as this just
512 works on database objects.
514 As this is just Dev it doesn't check for negative stocks etc.
518 my $sales_delivery_order = SL::DB::Manager::DeliveryOrder->find_by(donumber => 112);
519 SL::Dev::Inventory::transfer_sales_delivery_order($sales_delivery_order1);
521 =head2 C<transfer_purchase_delivery_order %PARAMS>
523 Transfer in all the items in a purchase order.
525 Behaves like C<transfer_sales_delivery_order>.
527 =head2 C<transfer_delivery_order_item @PARAMS>
529 Transfers a delivery order item from a delivery order. The whole qty is transferred.
530 Doesn't check for available qty.
534 SL::Dev::Inventory::transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
536 =head2 C<transfer_in %PARAMS>
538 Create stock in event for a part. Ideally the interface should mirror how data
539 is entered via the web interface.
541 Does some param checking, sets some defaults, but otherwise uses WH->transfer.
549 Mandatory. An SL::DB::Part object.
557 Optional. An SL::DB::Bin object, defaults to $part->bin.
561 Optional. An SL::DB::Bin object, defaults to $part->warehouse.
565 Optional. A string such as 't', 'Stck', defaults to $part->unit->name.
567 =item C<shippingdate>
569 Optional. A DateTime object, defaults to today.
571 =item C<transfer_type>
573 Optional. A string such as 'correction', defaults to 'stock'.
581 Example minimal usage using part default warehouse and bin:
583 my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
584 my $part = SL::Dev::Part::create_part(
589 SL::Dev::Inventory::transfer_in(
593 comment => '900 kg in t',
596 Example with specific transfer_type and warehouse and bin and shipping_date:
598 my $shipping_date = DateTime->today->subtract( days => 20 );
599 SL::Dev::Inventory::transfer_in(
602 transfer_type => 'correction',
604 shipping_date => $shipping_date,
607 =head2 C<transfer_out %PARAMS>
609 Create stock out event for a part. See C<transfer_in>.
617 G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>