]> wagnertech.de Git - mfinanz.git/blobdiff - SL/Helper/Inventory.pm
kivitendo 3.9.2-0.2
[mfinanz.git] / SL / Helper / Inventory.pm
index 944a41019897fdae0bb15461911504d0cbb24750..88a64ebbc98bed8957e9991de6f40ccc873b9a46 100644 (file)
@@ -6,8 +6,9 @@ use DateTime;
 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);
@@ -17,7 +18,7 @@ use SL::Helper::Number qw(_format_number _round_number);
 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 {
@@ -196,9 +197,12 @@ sub allocate {
     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}) {
@@ -228,20 +232,41 @@ sub allocate_for_assembly {
     $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;
@@ -303,6 +328,8 @@ sub produce_assembly {
 
   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}) ];
@@ -327,15 +354,10 @@ sub produce_assembly {
 
   # 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;
@@ -378,6 +400,96 @@ sub produce_assembly {
   @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
 }
@@ -434,12 +546,13 @@ SL::WH - Warehouse and Inventory API
 
   # 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,
   );
 
@@ -627,6 +740,56 @@ compute the required amount for each assembly part and allocate all of them.
 
 =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
 
@@ -703,6 +866,8 @@ each of the following attributes to be set at creation time:
 
 =item * bestbefore
 
+=item * comment
+
 =item * for_object_id
 
 If set the allocations will be marked as allocated for the given object.