commit 77f30228c677b48ce8dceb50793ed8f5829c14ab
Author: Tamino Steinert <tamino.steinert@tamino.st>
Date:   Wed Nov 3 09:29:43 2021 +0100

    Workflow: delivery_order ↔ reclamation

diff --git a/SL/Controller/Reclamation.pm b/SL/Controller/Reclamation.pm
index 26b9b995e..9e69441a6 100644
--- a/SL/Controller/Reclamation.pm
+++ b/SL/Controller/Reclamation.pm
@@ -69,6 +69,7 @@ __PACKAGE__->run_before('recalc',
                           save_and_show_email_dialog
                           workflow_save_and_sales_or_purchase_reclamation
                           save_and_order
+                          save_and_delivery_order
                        )]);
 
 __PACKAGE__->run_before('get_unalterable_data',
@@ -77,6 +78,7 @@ __PACKAGE__->run_before('get_unalterable_data',
                           save_and_show_email_dialog
                           workflow_save_and_sales_or_purchase_reclamation
                           save_and_order
+                          save_and_delivery_order
                         )]);
 
 #
@@ -121,6 +123,29 @@ sub action_add_from_order {
   );
 }
 
+sub action_add_from_delivery_order {
+  my ($self) = @_;
+
+  unless ($::form->{from_id}) {
+    $self->js->flash('error', t8("Can't create new reclamation. No 'from_id' was given."));
+    return $self->js->render();
+  }
+
+  require SL::DB::DeliveryOrder;
+  my $delivery_order = SL::DB::DeliveryOrder->new(id => $::form->{from_id})->load;
+  my $reclamation = $delivery_order->convert_to_reclamation();
+
+  $self->reclamation($reclamation);
+
+  $self->reinit_after_new_reclamation();
+
+  $self->render(
+    'reclamation/form',
+    title => $self->get_title_for('add'),
+    %{$self->{template_args}},
+  );
+}
+
 # edit an existing reclamation
 sub action_edit {
   my ($self) = @_;
@@ -515,6 +540,21 @@ sub action_save_and_purchase_reclamation {
   $_[0]->workflow_save_and_sales_or_purchase_reclamation();
 }
 
+# save the reclamation and redirect to the frontend subroutine for a new
+# delivery order
+sub action_save_and_delivery_order {
+  my ($self) = @_;
+
+  my $to_type = $self->reclamation->is_sales ? 'sales_delivery_order'
+                                             : 'purchase_delivery_order';
+  $self->save_and_redirect_to(
+    controller => 'do.pl',
+    action     => 'add_from_reclamation',
+    type       => $to_type,
+    from_id    => $self->reclamation->id,
+  );
+}
+
 # set form elements in respect to a changed customer or vendor
 #
 # This action is called on an change of the customer/vendor picker.
@@ -1617,10 +1657,12 @@ sub _link_to_records {
   my %allowed_linked_records = map {$_ => 1} qw(
     SL::DB::Reclamation
     SL::DB::Order
+    SL::DB::DeliveryOrder
   );
   my %allowed_linked_record_items = map {$_ => 1} qw(
     SL::DB::ReclamationItem
     SL::DB::OrderItem
+    SL::DB::DeliveryOrderItem
   );
 
   my $from_record_id = delete $::form->{converted_from_record_id};
@@ -2133,6 +2175,14 @@ sub _setup_edit_action_bar {
             $::instance_conf->get_reclamation_warn_no_reqdate,
           ],
         ],
+        action => [
+          t8('Save and Delivery Order'),
+          call      => [
+            'kivi.Reclamation.save', 'save_and_delivery_order',
+            $::instance_conf->get_reclamation_warn_duplicate_parts,
+            $::instance_conf->get_reclamation_warn_no_reqdate,
+          ],
+        ],
       ], # end of combobox "Workflow"
 
       combobox => [
diff --git a/SL/DB/DeliveryOrder.pm b/SL/DB/DeliveryOrder.pm
index 45d658876..bb4b35733 100644
--- a/SL/DB/DeliveryOrder.pm
+++ b/SL/DB/DeliveryOrder.pm
@@ -124,68 +124,112 @@ sub _clone_orderitem_cvar {
   return $cloned;
 }
 
+sub convert_to_reclamation {
+  my ($self, %params) = @_;
+
+  $params{destination_type} = $self->is_sales ? 'sales_reclamation'
+                                              : 'purchase_reclamation';
+
+  my $reclamation = SL::DB::Reclamation->new_from($self, %params);
+
+  return $reclamation;
+}
+
 sub new_from {
   my ($class, $source, %params) = @_;
 
-  croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
+  my %allowed_sources = map { $_ => 1 } qw(
+    SL::DB::Reclamation
+    SL::DB::Order
+  );
+  unless( $allowed_sources{ref $source} ) {
+    croak("Unsupported source object type '" . ref($source) . "'");
+  }
 
-  my ($item_parent_id_column, $item_parent_column);
+  my %record_args = (
+    donumber => undef,
+    employee => SL::DB::Manager::Employee->current,
+    closed    => 0,
+    delivered => 0,
+    order_type => $params{type},
+    transdate => DateTime->today_local,
+  );
 
-  if (ref($source) eq 'SL::DB::Order') {
-    $item_parent_id_column = 'trans_id';
-    $item_parent_column    = 'order';
+  if ( ref($source) eq 'SL::DB::Order' ) {
+    map{ ( $record_args{$_} = $source->$_ ) } # {{{ for vim folds
+    qw(
+      billing_address_id
+      cp_id
+      currency_id
+      cusordnumber
+      customer_id
+      delivery_term_id
+      department_id
+      globalproject_id
+      intnotes
+      language_id
+      notes
+      ordnumber
+      payment_id
+      reqdate
+      salesman_id
+      shippingpoint
+      shipvia
+      taxincluded
+      taxzone_id
+      transaction_description
+      vendor_id
+    );
+    # }}} for vim folds
+  } elsif ( ref($source) eq 'SL::DB::Reclamation' ) {
+    map{ ( $record_args{$_} = $source->$_ ) } # {{{ for vim folds
+      #billing_address_id #TODO(Tamino): add billing_address_id to reclamation
+    qw(
+      currency_id
+      customer_id
+      delivery_term_id
+      department_id
+      globalproject_id
+      intnotes
+      language_id
+      notes
+      payment_id
+      reqdate
+      salesman_id
+      shippingpoint
+      shipvia
+      taxincluded
+      taxzone_id
+      transaction_description
+      vendor_id
+    );
+    $record_args{cp_id} = $source->contact_id;
+    $record_args{cusordnumber} = $source->cv_record_number;
+    # }}} for vim folds
   }
 
-  my %args = ( map({ ( $_ => $source->$_ ) } qw(cp_id currency_id customer_id cusordnumber delivery_term_id department_id employee_id globalproject_id intnotes language_id notes
-                                                ordnumber payment_id reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id transaction_description vendor_id billing_address_id
-                                             )),
-               closed    => 0,
-               delivered => 0,
-               order_type => $params{type},
-               transdate => DateTime->today_local,
-            );
-
   # Custom shipto addresses (the ones specific to the sales/purchase
   # record and not to the customer/vendor) are only linked from
   # shipto → delivery_orders. Meaning delivery_orders.shipto_id
   # will not be filled in that case.
   if (!$source->shipto_id && $source->id) {
-    $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
-
+    $record_args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
   } else {
-    $args{shipto_id} = $source->shipto_id;
+    $record_args{shipto_id} = $source->shipto_id;
   }
 
   # infer type from legacy fields if not given
-  $args{order_type} //= $source->customer_id ? 'sales_delivery_order'
+  $record_args{order_type} //= $source->customer_id ? 'sales_delivery_order'
                       : $source->vendor_id   ? 'purchase_delivery_order'
                       : $source->is_sales    ? 'sales_delivery_order'
                       : croak "need some way to set delivery order type from source";
 
-  my $delivery_order = $class->new(%args);
+  my $delivery_order = $class->new(%record_args);
   $delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
-  my $items          = delete($params{items}) || $source->items_sorted;
-  my %item_parents;
-
-  # do not copy items when converting to supplier delivery order
-  my @items = $delivery_order->is_type(SUPPLIER_DELIVERY_ORDER_TYPE) ? () : map {
-    my $source_item      = $_;
-    my $source_item_id   = $_->$item_parent_id_column;
-    my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
-
-    $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
-    my $item_parent                  = $item_parents{$source_item_id};
-
-    my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
-                                         qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
-                                            project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
-                                         )),
-                                   custom_variables => \@custom_variables,
-                                   ordnumber        => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
-                                 );
-    $current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
-    $current_do_item;
-  } @{ $items };
+
+  my $items = delete($params{items}) || $source->items_sorted;
+  my @items = $delivery_order->is_type(SUPPLIER_DELIVERY_ORDER_TYPE) ? ()
+              : map { SL::DB::DeliveryOrderItem->new_from($_) } @{ $items };
 
   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
diff --git a/SL/DB/DeliveryOrderItem.pm b/SL/DB/DeliveryOrderItem.pm
index 62ebaa681..091d0c6fe 100644
--- a/SL/DB/DeliveryOrderItem.pm
+++ b/SL/DB/DeliveryOrderItem.pm
@@ -36,6 +36,94 @@ __PACKAGE__->configure_acts_as_list(group_by => [qw(delivery_order_id)]);
 
 # methods
 
+sub new_from {
+  my ($class, $source, %params) = @_;
+
+  my %allowed_sources = map { $_ => 1 } qw(
+      SL::DB::ReclamationItem
+      SL::DB::OrderItem
+  );
+  unless( $allowed_sources{ref $source} ) {
+    croak("Unsupported source object type '" . ref($source) . "'");
+  }
+
+  my @custom_variables = map { _clone_cvar_for_delivery_order_item($_) } @{ $source->custom_variables };
+
+  my %item_args;
+  if (ref($source) eq 'SL::DB::ReclamationItem') {
+    map { $item_args{$_} = $source->$_ } # {{{ for vim folds
+    qw(
+      active_discount_source
+      active_price_source
+      base_qty
+      description
+      discount
+      lastcost
+      longdescription
+      parts_id
+      position
+      price_factor
+      price_factor_id
+      pricegroup_id
+      project_id
+      qty
+      reqdate
+      sellprice
+      serialnumber
+      unit
+    );
+    $item_args{custom_variables} = \@custom_variables;
+    # }}} for vim folds
+  } elsif (ref($source) eq 'SL::DB::OrderItem') {
+    map { $item_args{$_} = $source->$_ } # {{{ for vim folds
+    qw(
+      active_discount_source
+      active_price_source
+      base_qty
+      cusordnumber
+      description
+      discount
+      lastcost
+      longdescription
+      marge_price_factor
+      parts_id
+      price_factor
+      price_factor_id
+      project_id
+      qty
+      reqdate
+      sellprice
+      serialnumber
+      transdate
+      unit
+    );
+    $item_args{custom_variables} = \@custom_variables;
+    $item_args{ordnumber}        = ref($source->record) eq 'SL::DB::Order' ? $source->record->ordnumber : $source->ordnumber;
+    # }}} for vim folds
+  }
+
+  my $item = $class->new(%item_args);
+
+  my $source_table = '';
+  if( ref($source) eq 'SL::DB::OrderItem' ) {
+    $source_table = 'orderitems';
+  } elsif ( ref($source) eq 'SL::DB::ReclamationItem' ) {
+    $source_table = 'reclamation_items';
+  }
+  $item->{"converted_from_". $source_table ."_id"} = $_->{id};
+
+  return $item;
+}
+
+sub _clone_cvar_for_delivery_order_item {
+  my ($cvar) = @_;
+
+  my $cloned = $_->clone_and_reset;
+  $cloned->sub_module('delivery_order_items');
+
+  return $cloned;
+}
+
 sub record { goto &delivery_order }
 sub record_id { goto &delivery_order_id }
 
diff --git a/SL/DB/Reclamation.pm b/SL/DB/Reclamation.pm
index c2721ff91..f72c4e590 100644
--- a/SL/DB/Reclamation.pm
+++ b/SL/DB/Reclamation.pm
@@ -216,12 +216,48 @@ sub convert_to_order {
   return $order;
 }
 
+sub convert_to_delivery_order {
+  my ($self, %params) = @_;
+
+  my $delivery_order;
+  if (!$self->db->with_transaction(sub {
+    require SL::DB::DeliveryOrder;
+    $delivery_order = SL::DB::DeliveryOrder->new_from($self, %params);
+    $delivery_order->save;
+    $self->link_to_record($delivery_order);
+    # TODO extend link_to_record for items, otherwise long-term no d.r.y.
+    foreach my $item (@{ $delivery_order->items }) {
+      foreach (qw(reclamation_items)) {
+        if ($item->{"converted_from_${_}_id"}) {
+          die unless $item->{id};
+          RecordLinks->create_links('dbh'        => $self->db->dbh,
+                                    'mode'       => 'ids',
+                                    'from_table' => $_,
+                                    'from_ids'   => $item->{"converted_from_${_}_id"},
+                                    'to_table'   => 'delivery_order_items',
+                                    'to_id'      => $item->{id},
+          ) || die;
+          delete $item->{"converted_from_${_}_id"};
+        }
+      }
+    }
+
+    $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
+    1;
+  })) {
+    return undef, $self->db->error->db_error->db_error;
+  }
+
+  return $delivery_order, undef;
+}
+
 #TODO(Werner): überprüfen ob alle Felder richtig gestetzt werden
 sub new_from {
   my ($class, $source, %params) = @_;
   my %allowed_sources = map { $_ => 1 } qw(
     SL::DB::Reclamation
     SL::DB::Order
+    SL::DB::DeliveryOrder
   );
   unless( $allowed_sources{ref $source} ) {
     croak("Unsupported source object type '" . ref($source) . "'");
@@ -239,6 +275,9 @@ sub new_from {
     #Order
     { from => 'sales_order',             to => 'sales_reclamation',    abbr => 'sosr', },
     { from => 'purchase_order',          to => 'purchase_reclamation', abbr => 'popr', },
+    #Delivery Order
+    { from => 'sales_delivery_order',    to => 'sales_reclamation',    abbr => 'sdsr', },
+    { from => 'purchase_delivery_order', to => 'purchase_reclamation', abbr => 'pdpr', },
   );
   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
   if (!$from_to) {
@@ -310,6 +349,30 @@ sub new_from {
     $record_args{contact_id} = $source->cp_id;
     $record_args{cv_record_number} = $source->cusordnumber;
     # }}} for vim folds
+  } elsif ( $is_abbr_any->(qw(sdsr pdpr)) ) { #DeliveryOrder
+    map { $record_args{$_} = $source->$_ } # {{{ for vim folds
+    qw(
+      currency_id
+      customer_id
+      delivery_term_id
+      department_id
+      globalproject_id
+      intnotes
+      language_id
+      notes
+      payment_id
+      salesman_id
+      shippingpoint
+      shipvia
+      tax_point
+      taxincluded
+      taxzone_id
+      transaction_description
+      vendor_id
+    );
+    $record_args{contact_id} = $source->cp_id;
+    $record_args{cv_record_number} = $source->cusordnumber;
+    # }}} for vim folds
   }
 
   if ( ($from_to->{from} =~ m{sales}) && ($from_to->{to} =~ m{purchase}) ) {
diff --git a/SL/DB/ReclamationItem.pm b/SL/DB/ReclamationItem.pm
index 04bb81402..7b8d83093 100644
--- a/SL/DB/ReclamationItem.pm
+++ b/SL/DB/ReclamationItem.pm
@@ -54,6 +54,7 @@ sub new_from {
     qw(
       SL::DB::ReclamationItem
       SL::DB::OrderItem
+      SL::DB::DeliveryOrderItem
     )
   ) {
     croak("Unsupported source object type '" . ref($source) . "'");
@@ -78,6 +79,13 @@ sub new_from {
       pricegroup_id project_id qty reqdate sellprice serialnumber unit
     );
     $item_args{custom_variables} = \@custom_variables;
+  } elsif (ref($source) eq 'SL::DB::DeliveryOrderItem') {
+    map { $item_args{$_} = $source->$_ } qw(
+      active_discount_source active_price_source base_qty description discount
+      lastcost longdescription parts_id position price_factor price_factor_id
+      pricegroup_id project_id qty reqdate sellprice serialnumber unit
+    );
+    $item_args{custom_variables} = \@custom_variables;
   }
 
   my $item = $class->new(%item_args);
diff --git a/bin/mozilla/do.pl b/bin/mozilla/do.pl
index e0b4dbc54..0a133d963 100644
--- a/bin/mozilla/do.pl
+++ b/bin/mozilla/do.pl
@@ -118,6 +118,20 @@ sub add {
   $main::lxdebug->leave_sub();
 }
 
+sub add_from_reclamation {
+
+  require SL::DB::Reclamation;
+  my $reclamation = SL::DB::Reclamation->new(id => $::form->{from_id})->load;
+  my ($delivery_order, $error) = $reclamation->convert_to_delivery_order();
+  if($error) {
+    croak("Error while converting: " . $error);
+  }
+
+  # edit new saved delivery order
+  $::form->{id} = $delivery_order->id;
+  edit();
+}
+
 sub edit {
   $main::lxdebug->enter_sub();
 
@@ -366,14 +380,21 @@ sub setup_do_action_bar {
 
       'separator',
 
-      action => [
-        t8('Invoice'),
-        submit => [ '#form', { action => "invoice" } ],
-        disabled => !$::form->{id} ? t8('This record has not been saved yet.') : undef,
-        confirm  => $::form->{delivered}                                                                         ? undef
-                  : ($::form->{vc} eq 'customer' && $::instance_conf->get_sales_delivery_order_check_stocked)    ? t8('This record has not been stocked out. Proceed?')
-                  : ($::form->{vc} eq 'vendor'   && $::instance_conf->get_purchase_delivery_order_check_stocked) ? t8('This record has not been stocked in. Proceed?')
-                  :                                                                                                undef,
+      combobox => [
+        action => [ t8('Workflow') ],
+        action => [
+          t8('Invoice'),
+          submit => [ '#form', { action => "invoice" } ],
+          disabled => !$::form->{id} ? t8('This record has not been saved yet.') : undef,
+          confirm  => $::form->{delivered}                                                                         ? undef
+                    : ($::form->{vc} eq 'customer' && $::instance_conf->get_sales_delivery_order_check_stocked)    ? t8('This record has not been stocked out. Proceed?')
+                    : ($::form->{vc} eq 'vendor'   && $::instance_conf->get_purchase_delivery_order_check_stocked) ? t8('This record has not been stocked in. Proceed?')
+                    :                                                                                                undef,
+        ],
+        action => [
+          t8('Save and Reclamation'),
+          submit => [ '#form', { action => "save_and_reclamation" } ],
+        ],
       ],
 
       combobox => [
@@ -1303,6 +1324,23 @@ sub invoice_multi {
   $main::lxdebug->leave_sub();
 }
 
+sub save_and_reclamation {
+  my $form     = $main::form;
+  my $type     = $form->{type};
+
+  # save the delivery order
+  save(no_redirect => 1);
+
+  my $to_reclamation_type =
+    $type eq 'sales_delivery_order' ? 'sales_reclamation'
+                                    : 'purchase_reclamation';
+  $form->{callback} =
+    'controller.pl?action=Reclamation/add_from_delivery_order' .
+    '&type=' . $to_reclamation_type .
+    '&from_id=' . $form->escape($form->{id});
+  $form->redirect;
+}
+
 sub save_as_new {
   $main::lxdebug->enter_sub();
 
