commit 471af251c02dc9b72fc44d4de661dba56586a4d5
Author: Sven Schöling <s.schoeling@googlemail.com>
Date:   Fri Sep 2 14:33:49 2016 +0200

    WH::transfer_assembly: single-dbh

diff --git a/SL/WH.pm b/SL/WH.pm
index af66e3bac..007283570 100644
--- a/SL/WH.pm
+++ b/SL/WH.pm
@@ -163,167 +163,169 @@ sub transfer_assembly {
 
   my $myconfig = \%main::myconfig;
   my $form     = $main::form;
-  my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
-
-
-  # Ablauferklärung
-  #
-  # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
-  # select parts_id,qty from assembly where id=1064;
-  # Erweiterung für bug 935 am 23.4.09 -
-  # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
-  # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
-  # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
-  #
-  # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
-  # wenn assembly nicht überprüft wird ...
-  # patch von joachim eingespielt 24.4.2009:
-  # my $query    = qq|select parts_id,qty from assembly inner join parts
-  # on assembly.parts_id = parts.id  where assembly.id = ? and
-  # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
-
-  # Lager in dem die Bestandteile gesucht werden kann entweder das Ziellager sein oder ist per Mandantenkonfig
-  # auf das Standardlager des Bestandteiles schaltbar
-
-  my $use_default_warehouse = $::instance_conf->get_transfer_default_warehouse_for_assembly;
-
-  my $query = qq|SELECT assembly.parts_id, assembly.qty, parts.warehouse_id
-                 FROM assembly INNER JOIN parts ON assembly.parts_id = parts.id
-                 WHERE assembly.id = ? AND (inventory_accno_id IS NOT NULL OR parts.assembly = TRUE)|;
-
-  my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
-
-  # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
-  my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
-                           trans_id, trans_type_id, shippingdate)
-                           VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
-                           (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
-                           (SELECT current_date))|;
-  my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
-
-  # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
-
   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
-  my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
-  while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
-    $schleife_durchlaufen=1;  # Erzeugnis definiert
-
-    my $partsQTY          = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
-    my $currentPart_ID    = $hash_ref->{parts_id};
-
-    my $currentPart_WH_ID = $use_default_warehouse && $hash_ref->{warehouse_id} ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
-    my $no_check = 0;
-
-    # Prüfen ob Erzeugnis-Teile Standardlager haben.
-    if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {
-      # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.
-      if ($::instance_conf->get_transfer_default_ignore_onhand) {
-        $currentPart_WH_ID = $::instance_conf->get_warehouse_id_ignore_onhand;
-        $no_check = 1;
-      } else {
-        $kannNichtFertigen .= "Kein Standardlager: " .
-                            " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .
-                            " hat kein Standardlager definiert " .
-                            ", um das Erzeugnis herzustellen. <br>";
-        next;
+
+  SL::DB->client->with_transaction(sub {
+    my $dbh      = $params{dbh} || SL::DB->client->dbh;
+
+    # Ablauferklärung
+    #
+    # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
+    # select parts_id,qty from assembly where id=1064;
+    # Erweiterung für bug 935 am 23.4.09 -
+    # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
+    # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
+    # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
+    #
+    # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
+    # wenn assembly nicht überprüft wird ...
+    # patch von joachim eingespielt 24.4.2009:
+    # my $query    = qq|select parts_id,qty from assembly inner join parts
+    # on assembly.parts_id = parts.id  where assembly.id = ? and
+    # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
+
+    # Lager in dem die Bestandteile gesucht werden kann entweder das Ziellager sein oder ist per Mandantenkonfig
+    # auf das Standardlager des Bestandteiles schaltbar
+
+    my $use_default_warehouse = $::instance_conf->get_transfer_default_warehouse_for_assembly;
+
+    my $query = qq|SELECT assembly.parts_id, assembly.qty, parts.warehouse_id
+                   FROM assembly INNER JOIN parts ON assembly.parts_id = parts.id
+                   WHERE assembly.id = ? AND (inventory_accno_id IS NOT NULL OR parts.assembly = TRUE)|;
+
+    my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
+
+    # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
+    my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
+                             trans_id, trans_type_id, shippingdate)
+                             VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
+                             (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
+                             (SELECT current_date))|;
+    my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
+
+    # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
+
+    my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
+    while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
+      $schleife_durchlaufen=1;  # Erzeugnis definiert
+
+      my $partsQTY          = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
+      my $currentPart_ID    = $hash_ref->{parts_id};
+
+      my $currentPart_WH_ID = $use_default_warehouse && $hash_ref->{warehouse_id} ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
+      my $no_check = 0;
+
+      # Prüfen ob Erzeugnis-Teile Standardlager haben.
+      if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {
+        # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.
+        if ($::instance_conf->get_transfer_default_ignore_onhand) {
+          $currentPart_WH_ID = $::instance_conf->get_warehouse_id_ignore_onhand;
+          $no_check = 1;
+        } else {
+          $kannNichtFertigen .= "Kein Standardlager: " .
+                              " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .
+                              " hat kein Standardlager definiert " .
+                              ", um das Erzeugnis herzustellen. <br>";
+          next;
+        }
       }
-    }
-    my $warehouse_info    = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
-    my $warehouse_desc    = $warehouse_info->{"warehouse_description"};
-
-    # Fertigen ohne Prüfung nach Bestand
-    if ($no_check) {
-      my $temppart_bin_id       = $::instance_conf->get_bin_id_ignore_onhand;
-      my $temppart_chargenumber = "";
-      my $temppart_bestbefore   = localtime();
-      my $temppart_qty          = $partsQTY * -1;
-
-      do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
-                     $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
-                     $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
-      next;
-    }
-    # Überprüfen, ob diese Anzahl gefertigt werden kann
-    my $max_parts = $self->get_max_qty_parts(parts_id     => $currentPart_ID, # $self->method() == this.method()
-                                             warehouse_id => $currentPart_WH_ID);
-
-    if ($partsQTY  > $max_parts){
-      # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
-      # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
-
-      $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
-                            " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
-                            " im Lager: " . $warehouse_desc .
-                            ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
-      next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
-    }
+      my $warehouse_info    = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
+      my $warehouse_desc    = $warehouse_info->{"warehouse_description"};
+
+      # Fertigen ohne Prüfung nach Bestand
+      if ($no_check) {
+        my $temppart_bin_id       = $::instance_conf->get_bin_id_ignore_onhand;
+        my $temppart_chargenumber = "";
+        my $temppart_bestbefore   = localtime();
+        my $temppart_qty          = $partsQTY * -1;
 
-    # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
-    # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
-    # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
-    # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
-    # und lösen den Rest dann so wie bei xplace im Barcode-Programm
-    # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
-
-    my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
-                       WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
-    my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
-
-    # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
-    my $tmpPartsQTY = $partsQTY;
-
-    while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
-      my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
-      my $temppart_chargenumber = $temphash_ref->{chargenumber};
-      my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
-      my $temppart_qty          = $temphash_ref->{sum};
-
-      if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
-                                           # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
-        $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
-        $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
-                                            # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
-                                            # Dieser Wert IST und BLEIBT positiv!! Hilfe.
-                                            # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
-        do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
-                     $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
-                     $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
-
-        # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
-        # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
-        # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
-        # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
-      } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
-        $tmpPartsQTY *=-1;
         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
-                     $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
-                     $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
-        last; # beendet die schleife (springt zum letzten element)
+                       $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
+                       $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
+        next;
+      }
+      # Überprüfen, ob diese Anzahl gefertigt werden kann
+      my $max_parts = $self->get_max_qty_parts(parts_id     => $currentPart_ID, # $self->method() == this.method()
+                                               warehouse_id => $currentPart_WH_ID);
+
+      if ($partsQTY  > $max_parts){
+        # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
+        # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
+
+        $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
+                              " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
+                              " im Lager: " . $warehouse_desc .
+                              ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
+        next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
       }
-    }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
-  } #ende while select parts_id,qty from assembly where id = ?
-
-  if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
-                                  # keine einzelteile definiert
-      $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
-                           Dementsprechend kann auch nichts hergestellt werden";
- }
-  # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
-  #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
-  if ($kannNichtFertigen) {
-    return $kannNichtFertigen;
-  }
 
-  # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
-  my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
-                                                      comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
-                               VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
-                               (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
-                               (select current_date))|;
-  my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
-  do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
-               $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
-  $dbh->commit();
+      # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
+      # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
+      # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
+      # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
+      # und lösen den Rest dann so wie bei xplace im Barcode-Programm
+      # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
+
+      my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
+                         WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
+      my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
+
+      # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
+      my $tmpPartsQTY = $partsQTY;
+
+      while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
+        my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
+        my $temppart_chargenumber = $temphash_ref->{chargenumber};
+        my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
+        my $temppart_qty          = $temphash_ref->{sum};
+
+        if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
+                                             # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
+          $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
+          $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
+                                              # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
+                                              # Dieser Wert IST und BLEIBT positiv!! Hilfe.
+                                              # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
+          do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
+                       $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
+                       $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
+
+          # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
+          # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
+          # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
+          # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
+        } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
+          $tmpPartsQTY *=-1;
+          do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
+                       $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
+                       $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
+          last; # beendet die schleife (springt zum letzten element)
+        }
+      }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
+    } #ende while select parts_id,qty from assembly where id = ?
+
+    if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
+                                    # keine einzelteile definiert
+        $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
+                             Dementsprechend kann auch nichts hergestellt werden";
+   }
+    # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
+    #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
+    if ($kannNichtFertigen) {
+      return 0;
+    }
+
+    # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
+    my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
+                                                        comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
+                                 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
+                                 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
+                                 (select current_date))|;
+    my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
+    do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
+                 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
+    1;
+  }) or do { return $kannNichtFertigen };
 
   $main::lxdebug->leave_sub();
   return 1; # Alles erfolgreich
