Merge branch 'b-3.6.1' into mebil

[kivitendo-erp.git] / SL / Helper / ShippedQty.pm

diff --git a/SL/Helper/ShippedQty.pm b/SL/Helper/ShippedQty.pm
index 9775570..6b878a9 100644 (file)
--- a/SL/Helper/ShippedQty.pm
+++ b/SL/Helper/ShippedQty.pm
@@ -3,54 +3,30 @@ package SL::Helper::ShippedQty;
 use strict;
 use parent qw(Rose::Object);
 
 use strict;
 use parent qw(Rose::Object);
 

-use SL::AM;
+use Carp;

 use Scalar::Util qw(blessed);
 use Scalar::Util qw(blessed);

-use SL::DBUtils qw(selectall_hashref_query selectall_as_map);

 use List::Util qw(min);
 use List::MoreUtils qw(any all uniq);
 use List::UtilsBy qw(partition_by);
 use List::Util qw(min);
 use List::MoreUtils qw(any all uniq);
 use List::UtilsBy qw(partition_by);

+use SL::AM;
+use SL::DBUtils qw(selectall_hashref_query selectall_as_map);

 use SL::Locale::String qw(t8);
 
 use Rose::Object::MakeMethods::Generic (
 use SL::Locale::String qw(t8);
 
 use Rose::Object::MakeMethods::Generic (

-  'scalar'                => [ qw(objects objects_or_ids shipped_qty ) ],
-  'scalar --get_set_init' => [ qw(oe_ids dbh require_stock_out fill_up item_identity_fields oi2oe oi_qty delivered) ],
+  'scalar'                => [ qw(objects objects_or_ids shipped_qty keep_matches) ],
+  'scalar --get_set_init' => [ qw(oe_ids dbh require_stock_out oi2oe oi_qty delivered matches services_deliverable) ],

 );
 
 my $no_stock_item_links_query = <<'';
 );
 
 my $no_stock_item_links_query = <<'';

-  SELECT oi.trans_id, oi.id AS oi_id, oi.qty AS oi_qty, oi.unit AS oi_unit, doi.qty AS doi_qty, doi.unit AS doi_unit
+  SELECT oi.trans_id, oi.id AS oi_id, oi.qty AS oi_qty, oi.unit AS oi_unit, doi.id AS doi_id, doi.qty AS doi_qty, doi.unit AS doi_unit

   FROM record_links rl
   INNER JOIN orderitems oi            ON oi.id = rl.from_id AND rl.from_table = 'orderitems'
   INNER JOIN delivery_order_items doi ON doi.id = rl.to_id AND rl.to_table = 'delivery_order_items'
   WHERE oi.trans_id IN (%s)
   ORDER BY oi.trans_id, oi.position
 
   FROM record_links rl
   INNER JOIN orderitems oi            ON oi.id = rl.from_id AND rl.from_table = 'orderitems'
   INNER JOIN delivery_order_items doi ON doi.id = rl.to_id AND rl.to_table = 'delivery_order_items'
   WHERE oi.trans_id IN (%s)
   ORDER BY oi.trans_id, oi.position
 

-# oi not item linked. takes about 250ms for 100k hits
-my $fill_up_oi_query = <<'';
-  SELECT oi.id, oi.trans_id, oi.position, oi.parts_id, oi.description, oi.reqdate, oi.serialnumber, oi.qty, oi.unit
-  FROM orderitems oi
-  WHERE oi.trans_id IN (%s)
-  ORDER BY oi.trans_id, oi.position
-
-# doi linked by record, but not by items; 250ms for 100k hits
-my $no_stock_fill_up_doi_query = <<'';
-  SELECT doi.id, doi.delivery_order_id, doi.position, doi.parts_id, doi.description, doi.reqdate, doi.serialnumber, doi.qty, doi.unit
-  FROM delivery_order_items doi
-  WHERE doi.delivery_order_id IN (
-    SELECT to_id
-    FROM record_links
-    WHERE from_id IN (%s)
-      AND from_table = 'oe'
-      AND to_table = 'delivery_orders'
-      AND to_id = doi.delivery_order_id)
-   AND NOT EXISTS (
-    SELECT NULL
-    FROM record_links
-    WHERE from_table = 'orderitems'
-      AND to_table = 'delivery_order_items'
-      AND to_id = doi.id)
-

 my $stock_item_links_query = <<'';
 my $stock_item_links_query = <<'';

-  SELECT oi.trans_id, oi.id AS oi_id, oi.qty AS oi_qty, oi.unit AS oi_unit,
+  SELECT oi.trans_id, oi.id AS oi_id, oi.qty AS oi_qty, oi.unit AS oi_unit, doi.id AS doi_id,

     (CASE WHEN doe.customer_id > 0 THEN -1 ELSE 1 END) * i.qty AS doi_qty, p.unit AS doi_unit
   FROM record_links rl
   INNER JOIN orderitems oi                   ON oi.id = rl.from_id AND rl.from_table = 'orderitems'
     (CASE WHEN doe.customer_id > 0 THEN -1 ELSE 1 END) * i.qty AS doi_qty, p.unit AS doi_unit
   FROM record_links rl
   INNER JOIN orderitems oi                   ON oi.id = rl.from_id AND rl.from_table = 'orderitems'


@@ -62,56 +38,16 @@ my $stock_item_links_query = <<'';
   WHERE oi.trans_id IN (%s)
   ORDER BY oi.trans_id, oi.position
 
   WHERE oi.trans_id IN (%s)
   ORDER BY oi.trans_id, oi.position
 

-my $stock_fill_up_doi_query = <<'';
-  SELECT doi.id, doi.delivery_order_id, doi.position, doi.parts_id, doi.description, doi.reqdate, doi.serialnumber,
-    (CASE WHEN doe.customer_id > 0 THEN -1 ELSE 1 END) * i.qty, p.unit
-  FROM delivery_order_items doi
-  INNER JOIN parts p                         ON p.id = doi.parts_id
-  INNER JOIN delivery_order_items_stock dois ON dois.delivery_order_item_id = doi.id
-  INNER JOIN delivery_orders doe             ON doe.id = doi.delivery_order_id
-  INNER JOIN inventory i                     ON dois.id = i.delivery_order_items_stock_id
-  WHERE doi.delivery_order_id IN (
-    SELECT to_id
-    FROM record_links
-    WHERE from_id IN (%s)
-      AND from_table = 'oe'
-      AND to_table = 'delivery_orders'
-      AND to_id = doi.delivery_order_id)
-   AND NOT EXISTS (
-    SELECT NULL
-    FROM record_links
-    WHERE from_table = 'orderitems'
-      AND to_table = 'delivery_order_items'
-      AND to_id = doi.id)
-
-my $oe_do_record_links = <<'';
-  SELECT from_id, to_id
-  FROM record_links
-  WHERE from_id IN (%s)
-    AND from_table = 'oe'
-    AND to_table = 'delivery_orders'
-
-my @known_item_identity_fields = qw(parts_id description reqdate serialnumber);
-my %item_identity_fields = (
-  parts_id     => t8('Part'),
-  description  => t8('Description'),
-  reqdate      => t8('Reqdate'),
-  serialnumber => t8('Serial Number'),
-);
-

 sub calculate {
   my ($self, $data) = @_;
 
 sub calculate {
   my ($self, $data) = @_;
 

-  die 'Need exactly one argument, either id, object or arrayref of ids or objects.' unless 2 == @_;
-
-  return $self if !$data || ('ARRAY' eq ref $data && !@$data);
+  croak 'Need exactly one argument, either id, object or arrayref of ids or objects.' unless 2 == @_;

 
   $self->normalize_input($data);
 
   return $self unless @{ $self->oe_ids };
 
   $self->calculate_item_links;
 
   $self->normalize_input($data);
 
   return $self unless @{ $self->oe_ids };
 
   $self->calculate_item_links;

-  $self->calculate_fill_up if $self->fill_up;

 
   $self;
 }
 
   $self;
 }


@@ -128,84 +64,20 @@ sub calculate_item_links {
   my $data = selectall_hashref_query($::form, $self->dbh, $query, @oe_ids);
 
   for (@$data) {
   my $data = selectall_hashref_query($::form, $self->dbh, $query, @oe_ids);
 
   for (@$data) {

+    my $qty = $_->{doi_qty} * AM->convert_unit($_->{doi_unit} => $_->{oi_unit});

     $self->shipped_qty->{$_->{oi_id}} //= 0;
     $self->shipped_qty->{$_->{oi_id}} //= 0;

-    $self->shipped_qty->{$_->{oi_id}} += $_->{doi_qty} * AM->convert_unit($_->{doi_unit} => $_->{oi_unit});
+    $self->shipped_qty->{$_->{oi_id}} += $qty;

     $self->oi2oe->{$_->{oi_id}}        = $_->{trans_id};
     $self->oi_qty->{$_->{oi_id}}       = $_->{oi_qty};
     $self->oi2oe->{$_->{oi_id}}        = $_->{trans_id};
     $self->oi_qty->{$_->{oi_id}}       = $_->{oi_qty};

-  }
-}

 
 

-sub _intersect {
-  my ($a1, $a2) = @_;
-  my %seen;
-  grep { $seen{$_}++ } @$a1, @$a2;
-}
-
-sub calculate_fill_up {
-  my ($self) = @_;
-
-  my @oe_ids = @{ $self->oe_ids };
-
-  my $fill_up_doi_query = $self->require_stock_out ? $stock_fill_up_doi_query : $no_stock_fill_up_doi_query;
-
-  my $oi_query  = sprintf $fill_up_oi_query,   join (', ', ('?')x@oe_ids);
-  my $doi_query = sprintf $fill_up_doi_query,  join (', ', ('?')x@oe_ids);
-  my $rl_query  = sprintf $oe_do_record_links, join (', ', ('?')x@oe_ids);
-
-  my $oi  = selectall_hashref_query($::form, $self->dbh, $oi_query,  @oe_ids);
-
-  return unless @$oi;
-
-  my $doi = selectall_hashref_query($::form, $self->dbh, $doi_query, @oe_ids);
-  my $rl  = selectall_hashref_query($::form, $self->dbh, $rl_query,  @oe_ids);
-
-  my %oi_by_identity  = partition_by { $self->item_identity($_) } @$oi;
-  my %doi_by_id       = partition_by { $_->{delivery_order_id} } @$doi;
-  my %doi_by_trans_id;
-  push @{ $doi_by_trans_id{$_->{from_id}} //= [] }, @{ $doi_by_id{$_->{to_id}} }
-    for grep { exists $doi_by_id{$_->{to_id}} } @$rl;
-
-  my %doi_by_identity = partition_by { $self->item_identity($_) } @$doi;
-
-  for my $match (sort keys %oi_by_identity) {
-    next unless exists $doi_by_identity{$match};
-
-    my %oi_by_oe = partition_by { $_->{trans_id} } @{ $oi_by_identity{$match} };
-    for my $trans_id (sort { $a <=> $b } keys %oi_by_oe) {
-      next unless my @sorted_doi = _intersect($doi_by_identity{$match}, $doi_by_trans_id{$trans_id});
-
-      # sorting should be quite fast here, because there are usually only a handful of matches
-      next unless my @sorted_oi  = sort { $a->{position} <=> $b->{position} } @{ $oi_by_oe{$trans_id} };
-
-      # parallel walk through sorted oi/doi entries
-      my $oi_i = my $doi_i = 0;
-      my ($oi, $doi) = ($sorted_oi[$oi_i], $sorted_doi[$doi_i]);
-      while ($oi_i < @sorted_oi && $doi_i < @sorted_doi) {
-        $oi =  $sorted_oi[++$oi_i],   next if $oi->{qty} <= $self->shipped_qty->{$oi->{id}};
-        $doi = $sorted_doi[++$doi_i], next if 0 == $doi->{qty};
-
-        my $factor  = AM->convert_unit($doi->{unit} => $oi->{unit});
-        my $min_qty = min($oi->{qty} - $self->shipped_qty->{$oi->{id}}, $doi->{qty} * $factor);
-
-        # min_qty should never be 0 now. the first part triggers the first next,
-        # the second triggers the second next and factor must not be 0
-        # but it would lead to an infinite loop, so catch that.
-        die 'panic! invalid shipping quantity' unless $min_qty;
-
-        $self->shipped_qty->{$oi->{id}} += $min_qty;
-        $doi->{qty}                     -= $min_qty / $factor;  # TODO: find a way to avoid float rounding
-      }
-    }
+    push @{ $self->matches }, [ $_->{oi_id}, $_->{doi_id}, $qty, 1 ] if $self->keep_matches;

   }
   }

-
-  $self->oi2oe->{$_->{id}}  = $_->{trans_id} for @$oi;
-  $self->oi_qty->{$_->{id}} = $_->{qty}      for @$oi;

 }
 
 sub write_to {
   my ($self, $objects) = @_;
 
 }
 
 sub write_to {
   my ($self, $objects) = @_;
 

-  die 'expecting array of objects' unless 'ARRAY' eq ref $objects;
+  croak 'expecting array of objects' unless 'ARRAY' eq ref $objects;

 
   my $shipped_qty = $self->shipped_qty;
 
 
   my $shipped_qty = $self->shipped_qty;
 


@@ -214,12 +86,13 @@ sub write_to {
       $obj->{shipped_qty} = $shipped_qty->{$obj->id} //= 0;
       $obj->{delivered}   = $shipped_qty->{$obj->id} == $obj->qty;
     } elsif ('SL::DB::Order' eq ref $obj) {
       $obj->{shipped_qty} = $shipped_qty->{$obj->id} //= 0;
       $obj->{delivered}   = $shipped_qty->{$obj->id} == $obj->qty;
     } elsif ('SL::DB::Order' eq ref $obj) {

-      if (exists $obj->{orderitems}) {
-        $self->write_to($obj->{orderitems});
-        $obj->{delivered} = all { $_->{delivered} } @{ $obj->{orderitems} };
+      # load all orderitems unless not already loaded
+      $obj->orderitems unless (defined $obj->{orderitems});
+      $self->write_to($obj->{orderitems});
+      if ($self->services_deliverable) {
+        $obj->{delivered} = all { $_->{delivered} } grep { !$_->{optional} } @{ $obj->{orderitems} };

       } else {
       } else {

-        # don't force a load on items. just compute by oe_id directly
-        $obj->{delivered} = $self->delivered->{$obj->id};
+        $obj->{delivered} = all { $_->{delivered} } grep { !$_->{optional} && !$_->part->is_service } @{ $obj->{orderitems} };

       }
     } else {
       die "unknown reference '@{[ ref $obj ]}' for @{[ __PACKAGE__ ]}::write_to";
       }
     } else {
       die "unknown reference '@{[ ref $obj ]}' for @{[ __PACKAGE__ ]}::write_to";


@@ -231,15 +104,11 @@ sub write_to {
 sub write_to_objects {
   my ($self) = @_;
 
 sub write_to_objects {
   my ($self) = @_;
 

-  die 'Can only use write_to_objects, when calculate was called with objects. Use write_to instead.' unless $self->objects_or_ids;
+  return unless @{ $self->oe_ids };

 
 

-  $self->write_to($self->objects);
-}
+  croak 'Can only use write_to_objects, when calculate was called with objects. Use write_to instead.' unless $self->objects_or_ids;

 
 

-sub item_identity {
-  my ($self, $row) = @_;
-
-  join $;, map $row->{$_}, @{ $self->item_identity_fields };
+  $self->write_to($self->objects);

 }
 
 sub normalize_input {
 }
 
 sub normalize_input {


@@ -250,26 +119,24 @@ sub normalize_input {
   $self->objects_or_ids(!!blessed($data->[0]));
 
   if ($self->objects_or_ids) {
   $self->objects_or_ids(!!blessed($data->[0]));
 
   if ($self->objects_or_ids) {

-    die 'unblessed object in data while expecting object' if any { !blessed($_) } @$data;
+    croak 'unblessed object in data while expecting object' if any { !blessed($_) } @$data;

     $self->objects($data);
   } else {
     $self->objects($data);
   } else {

-    die 'object or reference in data while expecting ids' if any { ref($_) } @$data;
+    croak 'object or reference in data while expecting ids' if any { ref($_) } @$data;
+    croak 'ids need to be numbers'                          if any { ! ($_ * 1) } @$data;

     $self->oe_ids($data);
   }
 
   $self->shipped_qty({});
 }
 
     $self->oe_ids($data);
   }
 
   $self->shipped_qty({});
 }
 

-sub available_item_identity_fields {
-  map { [ $_ => $item_identity_fields{$_} ] } @known_item_identity_fields;
-}

 
 sub init_oe_ids {
   my ($self) = @_;
 
 
 sub init_oe_ids {
   my ($self) = @_;
 

-  die 'oe_ids not initialized in id mode'            if !$self->objects_or_ids;
-  die 'objects not initialized before accessing ids' if $self->objects_or_ids && !defined $self->objects;
-  die 'objects need to be Order or OrderItem'        if any  {  ref($_) !~ /^SL::DB::Order(?:Item)?$/ } @{ $self->objects };
+  croak 'oe_ids not initialized in id mode'            if !$self->objects_or_ids;
+  croak 'objects not initialized before accessing ids' if $self->objects_or_ids && !defined $self->objects;
+  croak 'objects need to be Order or OrderItem'        if any  {  ref($_) !~ /^SL::DB::Order(?:Item)?$/ } @{ $self->objects };

 
   [ uniq map { ref($_) =~ /Item/ ? $_->trans_id : $_->id } @{ $self->objects } ]
 }
 
   [ uniq map { ref($_) =~ /Item/ ? $_->trans_id : $_->id } @{ $self->objects } ]
 }


@@ -278,8 +145,10 @@ sub init_dbh { SL::DB->client->dbh }
 
 sub init_oi2oe { {} }
 sub init_oi_qty { {} }
 
 sub init_oi2oe { {} }
 sub init_oi_qty { {} }

+sub init_matches { [] }

 sub init_delivered {
   my ($self) = @_;
 sub init_delivered {
   my ($self) = @_;

+

   my $d = { };
   for (keys %{ $self->oi_qty }) {
     my $oe_id = $self->oi2oe->{$_};
   my $d = { };
   for (keys %{ $self->oi_qty }) {
     my $oe_id = $self->oi2oe->{$_};


@@ -290,8 +159,17 @@ sub init_delivered {
 }
 
 sub init_require_stock_out    { $::instance_conf->get_shipped_qty_require_stock_out }
 }
 
 sub init_require_stock_out    { $::instance_conf->get_shipped_qty_require_stock_out }

-sub init_item_identity_fields { [ grep $item_identity_fields{$_}, @{ $::instance_conf->get_shipped_qty_item_identity_fields } ] }
-sub init_fill_up              { $::instance_conf->get_shipped_qty_fill_up  }
+
+sub init_services_deliverable  {
+  my ($self) = @_;
+  if (($::form->{type}//'') =~ m/^sales_/ || $self->{objects}->[0]->{customer_id}) {
+    $::instance_conf->get_sales_delivery_order_check_service;
+  } elsif (($::form->{type}//'') =~ m/^purchase_/ || $self->{objects}->[0]->{vendor_id}) {
+    $::instance_conf->get_purchase_delivery_order_check_service;
+  } else {
+    croak "wrong call, no customer or vendor object referenced";
+  }
+}

 
 1;
 
 
 1;
 


@@ -308,7 +186,6 @@ SL::Helper::ShippedQty - Algorithmic module for calculating shipped qty
   use SL::Helper::ShippedQty;
 
   my $helper = SL::Helper::ShippedQty->new(
   use SL::Helper::ShippedQty;
 
   my $helper = SL::Helper::ShippedQty->new(

-    fill_up              => 0,

     require_stock_out    => 0,
     item_identity_fields => [ qw(parts_id description reqdate serialnumber) ],
   );
     require_stock_out    => 0,
     item_identity_fields => [ qw(parts_id description reqdate serialnumber) ],
   );


@@ -320,7 +197,7 @@ SL::Helper::ShippedQty - Algorithmic module for calculating shipped qty
   $helper->calculate($oe_id);
   $helper->calculate(\@oe_ids);
 
   $helper->calculate($oe_id);
   $helper->calculate(\@oe_ids);
 

-  # if these are items set elivered and shipped_qty
+  # if these are items set delivered and shipped_qty

   # if these are orders, iterate through their items and set delivered on order
   $helper->write_to($objects);
 
   # if these are orders, iterate through their items and set delivered on order
   $helper->write_to($objects);
 


@@ -360,30 +237,13 @@ inventory it will mean when the delivery order is saved.
 
 =item *
 
 
 =item *
 

-How to find the correct matching elements. After the changes
-to record item links it's natural to assume that each position is linked, but
-for various reasons this might not be the case. Positions that are not linked
-in the database need to be matched by marching.
-
-=item *
-
-Double links need to be accounted for (these can stem from buggy code).
-
-=item *
-

 orderitems and oe entries may link to many of their counterparts in
 orderitems and oe entries may link to many of their counterparts in

-delivery_orders. delivery_orders my be created from multiple orders. The
+delivery_orders. delivery_orders may be created from multiple orders. The

 only constant is that a single entry in delivery_order_items has at most one
 link from an orderitem.
 
 =item *
 
 only constant is that a single entry in delivery_order_items has at most one
 link from an orderitem.
 
 =item *
 

-For the fill up case the identity of positions is not clear. The naive approach
-is just the same part, but description, charge number, reqdate and qty can all
-be part of the identity of a position for finding shipped matches.
-
-=item *
-

 Certain delivery orders might not be eligible for qty calculations if delivery
 orders are used for other purposes.
 
 Certain delivery orders might not be eligible for qty calculations if delivery
 orders are used for other purposes.
 


@@ -410,7 +270,9 @@ include a bulk mode to speed up multiple objects.
 
 =item C<new PARAMS>
 
 
 =item C<new PARAMS>
 

-Creates a new helper object. PARAMS may include:
+Creates a new helper object, $::form->{type} is mandatory.
+
+PARAMS may include:

 
 =over 4
 
 
 =over 4
 


@@ -419,28 +281,15 @@ Creates a new helper object. PARAMS may include:
 Boolean. If set, delivery orders must be stocked out to be considered
 delivered. The default is a client setting.
 
 Boolean. If set, delivery orders must be stocked out to be considered
 delivered. The default is a client setting.
 

-=item * C<fill_up>
-
-Boolean. If set, unlinked delivery order items will be used to fill up
-undelivered order items. Not needed in newer installations. The default is a
-client setting.
-
-=item * C<item_identity_fields ARRAY>
-
-If set, the fields are used to compute the identity of matching positions. The
-default is a client setting. Possible values include:
-
-=over 4

 
 

-=item * C<parts_id>
+=item * C<keep_matches>

 
 

-=item * C<description>
+Boolean. If set to true the internal matchings of OrderItems and
+DeliveryOrderItems will be kept for later postprocessing, in case you need more
+than this modules provides.

 
 

-=item * C<reqdate>
+See C<matches> for the returned format.

 
 

-=item * C<serialnumber>
-
-=back

 
 =back
 
 
 =back
 


@@ -472,6 +321,13 @@ was found it will be set to zero.
 C<delivered> is guaranteed only to be the correct boolean value, but not
 any specific value.
 
 C<delivered> is guaranteed only to be the correct boolean value, but not
 any specific value.
 

+Note: C<write_to> will avoid loading unnecessary objects. This means if it is
+called with an Order object that has not loaded its orderitems yet, only
+C<delivered> will be set in the Order object. A subsequent C<<
+$order->orderitems->[0]->{delivered} >> will return C<undef>, and C<<
+$order->orderitems->[0]->shipped_qty >> will invoke another implicit
+calculation.
+

 =item C<shipped_qty>
 
 Valid after L</calculate>. Returns a hasref with shipped qtys by orderitems id.
 =item C<shipped_qty>
 
 Valid after L</calculate>. Returns a hasref with shipped qtys by orderitems id.


@@ -483,6 +339,32 @@ linked elements were found.
 
 Valid after L</calculate>. Returns a hashref with a delivered flag by order id.
 
 
 Valid after L</calculate>. Returns a hashref with a delivered flag by order id.
 

+=item C<matches>
+
+Valid after L</calculate> with C<with_matches> set. Returns an arrayref of
+individual matches. Each match is an arrayref with these fields:
+
+=over 4
+
+=item *
+
+The id of the OrderItem.
+
+=item *
+
+The id of the DeliveryOrderItem.
+
+=item *
+
+The qty that was matched between the two converted to the unit of the OrderItem.
+
+=item *
+
+A boolean flag indicating if this match was found with record_item links. If
+false, the match was made in the fill up stage.
+
+=back
+

 =back
 
 =head1 REPLACED FUNCTIONALITY
 =back
 
 =head1 REPLACED FUNCTIONALITY