use Exporter qw(import);
use List::Util qw(min sum);
use List::UtilsBy qw(sort_by);
-use List::MoreUtils qw(any);
+use List::MoreUtils qw(any none);
use POSIX qw(ceil);
+use Scalar::Util qw(blessed);
use SL::Locale::String qw(t8);
use SL::MoreCommon qw(listify);
use SL::Helper::Inventory::Allocation;
use SL::X;
-our @EXPORT_OK = qw(get_stock get_onhand allocate allocate_for_assembly produce_assembly check_constraints);
+our @EXPORT_OK = qw(get_stock get_onhand allocate allocate_for_assembly produce_assembly check_constraints check_allocations_for_assembly);
our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
sub _get_stock_onhand {
last if $rest_qty == 0;
}
if ($rest_qty > 0) {
- die SL::X::Inventory::Allocation->new(
- code => 'not enough to allocate',
- message => t8("can not allocate #1 units of #2, missing #3 units", _format_number($qty), $part->displayable_name, _format_number($rest_qty)),
+ die SL::X::Inventory::Allocation::MissingQty->new(
+ code => 'not enough to allocate',
+ message => t8("can not allocate #1 units of #2, missing #3 units", _format_number($qty), $part->displayable_name, _format_number($rest_qty)),
+ part_description => $part->displayable_name,
+ to_allocate_qty => $qty,
+ missing_qty => $rest_qty,
);
} else {
if ($params{constraints}) {
$parts_to_allocate{ $assembly->part->id } += $assembly->qty * $qty;
}
- my @allocations;
+ my (@allocations, @errors);
for my $part_id (keys %parts_to_allocate) {
my $part = SL::DB::Part->load_cached($part_id);
- push @allocations, allocate(%params, part => $part, qty => $parts_to_allocate{$part_id});
- if ($wh_strict) {
- die SL::X::Inventory::Allocation->new(
- code => "wrong warehouse for part",
- message => t8('Part #1 exists in warehouse #2, but not in warehouse #3 ',
- $part->partnumber . ' ' . $part->description,
- SL::DB::Manager::Warehouse->find_by(id => $allocations[-1]->{warehouse_id})->description,
- $wh->description),
- ) unless $allocations[-1]->{warehouse_id} == $wh->id;
- }
+
+ eval {
+ push @allocations, allocate(%params, part => $part, qty => $parts_to_allocate{$part_id});
+ if ($wh_strict) {
+ die SL::X::Inventory::Allocation->new(
+ code => "wrong warehouse for part",
+ message => t8('Part #1 exists in warehouse #2, but not in warehouse #3 ',
+ $part->partnumber . ' ' . $part->description,
+ SL::DB::Manager::Warehouse->find_by(id => $allocations[-1]->{warehouse_id})->description,
+ $wh->description),
+ ) unless $allocations[-1]->{warehouse_id} == $wh->id;
+ }
+ 1;
+ } or do {
+ my $ex = $@;
+ die $ex unless blessed($ex) && $ex->can('rethrow');
+
+ if ($ex->isa('SL::X::Inventory::Allocation')) {
+ push @errors, $@;
+ } else {
+ $ex->rethrow;
+ }
+ };
+ }
+
+ if (@errors) {
+ die SL::X::Inventory::Allocation::Multi->new(
+ code => "multiple errors during allocation",
+ message => "multiple errors during allocation",
+ errors => \@errors,
+ );
}
@allocations;
my $allocations = $params{allocations};
my $strict_wh = $::instance_conf->get_produce_assembly_same_warehouse ? $bin->warehouse : undef;
+ my $consume_service = $::instance_conf->get_produce_assembly_transfer_service;
+
if ($params{auto_allocate}) {
Carp::croak("produce_assembly: can't have both allocations and auto_allocate") if $params{allocations};
$allocations = [ allocate_for_assembly(part => $part, qty => $qty, warehouse => $strict_wh, chargenumber => $params{chargenumber}) ];
# check whether allocations are sane
if (!$params{no_check_allocations} && !$params{auto_allocate}) {
- my %allocations_by_part = map { $_->parts_id => $_->qty } @$allocations;
- for my $assembly ($part->assemblies) {
- $allocations_by_part{ $assembly->parts_id } -= $assembly->qty * $qty;
- }
-
die SL::X::Inventory::Allocation->new(
code => "allocations are insufficient for production",
message => t8('can not allocate enough resources for production'),
- ) if any { $_ < 0 } values %allocations_by_part;
+ ) if !check_allocations_for_assembly(part => $part, qty => $qty, allocations => $allocations);
}
my @transfers;
@transfers;
}
+sub check_allocations_for_assembly {
+ my (%params) = @_;
+
+ my $part = $params{part} or Carp::croak('check_allocations_for_assembly needs a part');
+ my $qty = $params{qty} or Carp::croak('check_allocations_for_assembly needs a qty');
+
+ my $check_overfulfilment = !!$params{check_overfulfilment};
+ my $allocations = $params{allocations};
+
+ my $consume_service = $::instance_conf->get_produce_assembly_transfer_service;
+
+ my %allocations_by_part;
+ for (@{ $allocations || []}) {
+ $allocations_by_part{$_->parts_id} //= 0;
+ $allocations_by_part{$_->parts_id} += $_->qty;
+ }
+
+ for my $assembly ($part->assemblies) {
+ next if $assembly->part->type eq 'service' && !$consume_service;
+ $allocations_by_part{ $assembly->parts_id } -= $assembly->qty * $qty;
+ }
+
+ return (none { $_ < 0 } values %allocations_by_part) && (!$check_overfulfilment || (none { $_ > 0 } values %allocations_by_part));
+}
+
+sub check_stock_out_transfer_requests {
+ my (%params) = @_;
+
+ my $transfer_requests = $params{transfer_requests} or Carp::croak('check_stock_out_transfer_requests needs transfer_requests');
+ my $default_transfer = $params{default_transfer} || 0;
+
+ my $grouped_qtys; # part_id -> bin_id -> chargenumber -> bestbefore -> qty;
+ my %part_ids;
+ my %bin_ids;
+ my %chargenumbers;
+ foreach my $request (@$transfer_requests) {
+ $grouped_qtys
+ ->{$request->parts_id}
+ ->{$request->bin_id}
+ ->{$request->chargenumber}
+ ->{$request->bestbefore} += -$request->qty; # qty is negative
+ $bin_ids{$request->bin_id} = 1;
+ $chargenumbers{$request->chargenumber} = 1;
+ }
+
+ my $stocks = get_stock(
+ by => [qw(part bin chargenumber bestbefore)],
+ part => [keys %$grouped_qtys],
+ bin => [keys %bin_ids],
+ chargenumber => [keys %chargenumbers],
+ );
+
+ # make stock searchable
+ my $available_qty;
+ foreach my $stock (@$stocks) {
+ $available_qty
+ ->{$stock->{parts_id}}
+ ->{$stock->{bin_id}}
+ ->{$stock->{chargenumber}}
+ ->{DateTime->from_kivitendo($stock->{bestbefore}) || undef} = $stock->{qty};
+ }
+
+ my @missing_qtys;
+ foreach my $p_id (keys %{$grouped_qtys}) {
+ foreach my $b_id (keys %{$grouped_qtys->{$p_id}}) {
+ next if $default_transfer
+ && $::instance_conf->get_transfer_default_ignore_onhand
+ && $::instance_conf->get_bin_id_ignore_onhand eq $b_id;
+ foreach my $cn (keys %{$grouped_qtys->{$p_id}->{$b_id}}) {
+ foreach my $bb (keys %{$grouped_qtys->{$p_id}->{$b_id}->{$cn}}) {
+ my $available_stock = $available_qty->{$p_id}->{$b_id}->{$cn}->{$bb};
+ if ($available_stock < $grouped_qtys->{$p_id}->{$b_id}->{$cn}->{$bb}) {
+ my $part = SL::DB::Manager::Part->find_by(id => $p_id);
+ my $bin = SL::DB::Manager::Bin->find_by(id => $b_id);
+ push @missing_qtys, {
+ missing_qty => $grouped_qtys->{$p_id}->{$b_id}->{$cn}->{$bb} - $available_stock,
+ part => $part,
+ bin => $bin,
+ chargenumber => $cn,
+ bestbefore => $bb
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return @missing_qtys;
+}
+
sub default_show_bestbefore {
$::instance_conf->get_show_bestbefore
}
# create allocation manually, bypassing checks. all of these need to be passed, even undefs
my $allocation = SL::Helper::Inventory::Allocation->new(
- part_id => $part->id,
+ parts_id => $part->id,
qty => 15,
bin_id => $bin_obj->id,
warehouse_id => $bin_obj->warehouse_id,
chargenumber => '1823772365',
bestbefore => undef,
+ comment => undef,
for_object_id => $order->id,
);
=item * produce_assembly
+=item * check_allocations_for_assembly PARAMS
+
+Checks if enough quantity is allocated for production. Returns a trueish
+value if there is enough allocated, a falsish one otherwise (but see the
+parameter C<check_overfulfilment>).
+
+Accepted parameters:
+
+=over 4
+
+=item * part
+
+The part object to be assembled. Mandatory.
+
+=item * qty
+
+The quantity of the part to be assembled. Mandatory.
+
+=item * allocations
+
+An array ref of the allocations.
+
+=item * check_overfulfilment
+
+Whether or not overfulfilment should be checked. If more quantity is allocated
+than needed for production a falsish value is returned. Optional.
+
+=back
+
+=item * check_stock_out_transfer_requests PARAMS
+
+Checks if enough stock is availbale for the transfer requests. Returns a list
+of missing quantities as hashref with the keys C<part>, C<bin>, C<missing_qty>, C<chargenumber>
+and C<bestbefore>. C<chargenumber> and C<bestbefore> can be C<undef> if not set
+in the transfer requests.
+
+Accepted parameters:
+
+=over 4
+
+=item * transfer_requests
+
+Transfer requests to stock out as arrayref. Mandatory.
+
+=item * default_transfer
+
+Has to be trueish if the transfer requests are for a delivery order called with
+'Transfer out via default'. Optional, Default 0.
+
+=back
=back
=item * bestbefore
+=item * comment
+
=item * for_object_id
If set the allocations will be marked as allocated for the given object.