SelfTest um Testfall ac.amount == ar.netamount ergänzt
[kivitendo-erp.git] / SL / WH.pm
index 7ef012d..8ff63f2 100644 (file)
--- a/SL/WH.pm
+++ b/SL/WH.pm
@@ -37,91 +37,121 @@ package WH;
 use SL::AM;
 use SL::DBUtils;
 use SL::Form;
-use warnings;
-#use strict;
-sub transfer {
-  $main::lxdebug->enter_sub();
 
-  my $self = shift;
+use SL::DB::Unit;
+use SL::DB::Assembly;
 
-  if (!@_) {
-    $main::lxdebug->leave_sub();
-    return;
-  }
-
-  my $myconfig = \%main::myconfig;
-  my $form     = $main::form;
-
-  my $dbh      = $form->get_standard_dbh($myconfig);
-
-  my $units    = AM->retrieve_units($myconfig, $form);
+use warnings;
+use strict;
 
-  my $query    = qq|SELECT * FROM transfer_type|;
-  my $sth      = prepare_execute_query($form, $dbh, $query);
+sub transfer {
+  $::lxdebug->enter_sub;
 
-  my %transfer_types;
+  my ($self, @args) = @_;
 
-  while (my $ref = $sth->fetchrow_hashref()) {
-    $transfer_types{$ref->{direction}} ||= { };
-    $transfer_types{$ref->{direction}}->{$ref->{description}} = $ref->{id};
+  if (!@args) {
+    $::lxdebug->leave_sub;
+    return;
   }
 
-  my @part_ids  = map { $_->{parts_id} } @_;
-  my %partunits = selectall_as_map($form, $dbh, qq|SELECT id, unit FROM parts WHERE id IN (| . join(', ', map { '?' } @part_ids ) . qq|)|, 'id', 'unit', @part_ids);
-
-  my ($now)     = selectrow_query($form, $dbh, qq|SELECT current_date|);
-
-  $query = qq|INSERT INTO inventory (warehouse_id, bin_id, parts_id, chargenumber, oe_id, orderitems_id, shippingdate,
-                                     employee_id, project_id, trans_id, trans_type_id, comment, qty)
-              VALUES (?, ?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?, ?, ?)|;
-
-  $sth   = prepare_query($form, $dbh, $query);
+  require SL::DB::TransferType;
+  require SL::DB::Part;
+  require SL::DB::Employee;
+  require SL::DB::Inventory;
 
-  my @directions = (undef, 'out', 'in', 'transfer');
+  my $employee   = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
+  my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
+  my @directions = (undef, qw(out in transfer));
 
-  while (@_) {
-    my $transfer   = shift;
-    my ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
+  my $objectify = sub {
+    my ($transfer, $field, $class, @find_by) = @_;
 
-    my ($direction, @values) = (0);
+    @find_by = (description => $transfer->{$field}) unless @find_by;
 
-    $direction |= 1 if ($transfer->{src_warehouse_id} && $transfer->{src_bin_id});
-    $direction |= 2 if ($transfer->{dst_warehouse_id} && $transfer->{dst_bin_id});
-
-    push @values, conv_i($transfer->{parts_id}), "$transfer->{chargenumber}", conv_i($transfer->{oe_id}), conv_i($transfer->{orderitems_id});
-    push @values, $transfer->{shippingdate} eq 'current_date' ? $now : conv_date($transfer->{shippingdate}), $form->{login}, conv_i($transfer->{project_id}), $trans_id;
-
-    if ($transfer->{transfer_type_id}) {
-      push @values, $transfer->{transfer_type_id};
-    } else {
-      push @values, $transfer_types{$directions[$direction]}->{$transfer->{transfer_type}};
+    if ($transfer->{$field} || $transfer->{"${field}_id"}) {
+      return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
+           : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
+           : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
     }
+    return;
+  };
+
+  my @trans_ids;
+
+  my $db = SL::DB::Inventory->new->db;
+  $db->with_transaction(sub{
+    while (my $transfer = shift @args) {
+      my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
+
+      my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
+      my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
+      my $qty           = $transfer->{qty};
+      my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
+      my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
+      my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
+      my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
+      my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
+
+      $src_wh ||= $src_bin->warehouse if $src_bin;
+      $dst_wh ||= $dst_bin->warehouse if $dst_bin;
+
+      my $direction = 0; # bit mask
+      $direction |= 1 if $src_bin;
+      $direction |= 2 if $dst_bin;
+
+      my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
+                                                                                           description => $transfer->{transfer_type});
+
+      my %params = (
+          part             => $part,
+          employee         => $employee,
+          trans_type       => $transfer_type,
+          project          => $project,
+          trans_id         => $trans_id,
+          shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
+                              ? $now : $transfer->{shippingdate},
+          map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
+      );
+
+      if ($unit) {
+        $qty = $unit->convert_to($qty, $part->unit_obj);
+      }
 
-    push @values, "$transfer->{comment}";
-
-    my $qty = $transfer->{qty};
-
-    if ($transfer->{unit}) {
-      my $partunit = $partunits{$transfer->{parts_id}};
+      $params{chargenumber} ||= '';
 
-      $qty *= $units->{$transfer->{unit}}->{factor};
-      $qty /= $units->{$partunit}->{factor} || 1 if ($partunit);
-    }
+      if ($direction & 1) {
+        SL::DB::Inventory->new(
+          %params,
+          warehouse => $src_wh,
+          bin       => $src_bin,
+          qty       => $qty * -1,
+        )->save;
+      }
 
-    if ($direction & 1) {
-      do_statement($form, $sth, $query, conv_i($transfer->{src_warehouse_id}), conv_i($transfer->{src_bin_id}), @values, $qty * -1);
-    }
+      if ($direction & 2) {
+        SL::DB::Inventory->new(
+          %params,
+          warehouse => $dst_wh->id,
+          bin       => $dst_bin->id,
+          qty       => $qty,
+        )->save;
+        # Standardlagerplatz in Stammdaten gleich mitverschieben
+        if (defined($transfer->{change_default_bin})){
+          $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
+        }
+      }
 
-    if ($direction & 2) {
-      do_statement($form, $sth, $query, conv_i($transfer->{dst_warehouse_id}), conv_i($transfer->{dst_bin_id}), @values, $qty);
+      push @trans_ids, $trans_id;
     }
-  }
 
-  $sth->finish();
+    1;
+  }) or do {
+    $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
+  };
 
-  $dbh->commit();
+  $::lxdebug->leave_sub;
 
-  $main::lxdebug->leave_sub();
+  return @trans_ids;
 }
 
 sub transfer_assembly {
@@ -129,7 +159,18 @@ sub transfer_assembly {
 
   my $self     = shift;
   my %params   = @_;
-  Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber comment));
+  Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
+
+
+  my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
+  if ($unit) {
+    my $assembly = SL::DB::Manager::Assembly->get_all(
+      query => [ id => $params{assembly_id} ],
+      with_objects => ['part'],
+      limit => 1,
+    )->[0];
+    $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
+  }
 
 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
 
@@ -142,89 +183,121 @@ sub transfer_assembly {
   #
   # ... 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 ...
+  # 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)|;
 
 
-  # my $query    = qq|select parts_id,qty from assembly where id = ?|;
-  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)|;
+  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)|;
 
-  my $sth_part_qty_assembly      = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
+  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, comment, employee_id, qty, trans_id, trans_type_id)
-                           VALUES (?, ?, ?, ?, ?,(SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
-                                   (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
+  my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
+                           VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
+                           (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
   my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
 
-  my $kannNichtFertigen ="";   # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
-
-  while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) {  # Schleife für $query=select parts_id,qty from assembly
+  # 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};
 
     # Überprüfen, ob diese Anzahl gefertigt werden kann
-    my $max_parts = get_max_qty_parts($self, parts_id => $currentPart_ID, warehouse_id => $params{dst_warehouse_id}); #$self angeben, damit die Standardkonvention (Name, Parameter) eingehalten wird
+    my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
+                                             warehouse_id => $params{dst_warehouse_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:" . get_part_description($self, parts_id => $currentPart_ID) . ", um das Erzeugnis herzustellen. <br>";        # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
-      next;    # die weiteren Überprüfungen sind unnötig
+      # 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) .
+                            ", 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)
     }
 
-    # Eine kurze Vorabfrage, um den Lagerplatz und die Chargennummber zu bestimmen
+    # 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   FROM inventory  WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber having SUM(qty)>0|;
-    my $tempsth          =     prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
+    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, $params{dst_warehouse_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_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;     # 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, $params{dst_warehouse_id}, $temppart_bin_id, $temppart_chargenumber, 'Verbraucht für ' . get_part_description($self, 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, $params{dst_warehouse_id}, $temppart_bin_id, $temppart_chargenumber, 'Verbraucht für ' . get_part_description($self, parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
-        last;  # beendet die schleife (springt zum letzten element)
+      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, $params{dst_warehouse_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, $params{dst_warehouse_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   FROM inventory  WHERE warehouse_id
+    }  # 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, comment, employee_id, qty, trans_id, trans_type_id)
-                           VALUES (?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
-                                   (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
+  my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
+                                                      comment, employee_id, qty, trans_id, trans_type_id)
+                               VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
+                               (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
   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}, $params{comment}, $params{login}, $params{qty});
+  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();
 
   $main::lxdebug->leave_sub();
-  return 1;    # Alles erfolgreich
+  return 1; # Alles erfolgreich
 }
 
 sub get_warehouse_journal {
@@ -242,14 +315,14 @@ sub get_warehouse_journal {
   my $dbh = $form->get_standard_dbh($myconfig);
 
   # filters
-  my (@filter_ary, @filter_vars, $joins);
+  my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
-  if ($filter{warehouse_id} ne '') {
+  if ($filter{warehouse_id}) {
     push @filter_ary, "w1.id = ? OR w2.id = ?";
     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
   }
 
-  if ($filter{bin_id} ne '') {
+  if ($filter{bin_id}) {
     push @filter_ary, "b1.id = ? OR b2.id = ?";
     push @filter_vars, $filter{bin_id}, $filter{bin_id};
   }
@@ -269,6 +342,11 @@ sub get_warehouse_journal {
     push @filter_vars, '%' . $filter{chargenumber} . '%';
   }
 
+  if ($form->{bestbefore}) {
+    push @filter_ary, "?::DATE = i1.bestbefore::DATE";
+    push @filter_vars, $form->{bestbefore};
+  }
+
   if ($form->{fromdate}) {
     push @filter_ary, "?::DATE <= i1.itime::DATE";
     push @filter_vars, $form->{fromdate};
@@ -310,7 +388,7 @@ sub get_warehouse_journal {
   $sort_order    = $filter{order}        unless $sort_order;
   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
-  my $where_clause = join(" AND ", @filter_ary) . " AND " if (@filter_ary);
+  my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
   $select_tokens{'trans'} = {
      "parts_id"             => "i1.parts_id",
@@ -319,6 +397,7 @@ sub get_warehouse_journal {
      "partdescription"      => "p.description",
      "bindescription"       => "b.description",
      "chargenumber"         => "i1.chargenumber",
+     "bestbefore"           => "i1.bestbefore",
      "warehousedescription" => "w.description",
      "partunit"             => "p.unit",
      "bin_from"             => "b1.description",
@@ -329,6 +408,7 @@ sub get_warehouse_journal {
      "trans_type"           => "tt.description",
      "trans_id"             => "i1.trans_id",
      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
+     "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
      "date"                 => "i1.itime::DATE",
      "itime"                => "i1.itime",
      "employee"             => "e.name",
@@ -345,6 +425,8 @@ sub get_warehouse_journal {
      "warehouse_from"       => "'$filter{na}'",
      };
 
+  $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
+
   # build the select clauses.
   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
   for my $i ('trans', 'out', 'in') {
@@ -355,6 +437,7 @@ sub get_warehouse_journal {
   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
 
+  $where_clause = defined($where_clause) ? $where_clause : '';
   my $query =
   qq|SELECT DISTINCT $select{trans}
     FROM inventory i1
@@ -443,12 +526,24 @@ sub get_warehouse_journal {
       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
       FROM ap
       WHERE ap.id = ?
+
+      UNION
+
+      SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
+      FROM ar
+      WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
+
+      UNION
+
+      SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
+      FROM ap
+      WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 SQL
     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
   }
 
   my @contents = ();
-  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+  while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
     my $qty = $ref->{"qty"} * 1;
 
@@ -463,8 +558,9 @@ SQL
       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
     }
 
-    if ($h_oe_id && $ref->{oe_id}) {
-      do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
+    if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
+      my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
+      do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
     }
 
@@ -487,7 +583,8 @@ SQL
 #  - partsid      - will return matches with this parts_id only
 #  - description  - will return only matches where the given string is a substring of the description
 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
-#  - ean         - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
+#  - bestbefore   - will return only matches with this bestbefore date
+#  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 #  - expires_in   - will only return matches that expire within the given number of days
 #                   will also add a column named 'has_expired' containing if the match has already expired or not
@@ -549,11 +646,25 @@ sub get_warehouse_report {
     push @filter_ary,  "i.chargenumber ILIKE ?";
     push @filter_vars, '%' . $filter{chargenumber} . '%';
   }
+
+  if ($form->{bestbefore}) {
+    push @filter_ary, "?::DATE = i.bestbefore::DATE";
+    push @filter_vars, $form->{bestbefore};
+  }
+
   if ($filter{ean}) {
     push @filter_ary,  "p.ean ILIKE ?";
     push @filter_vars, '%' . $filter{ean} . '%';
   }
 
+  if ($filter{date}) {
+    push @filter_ary, "i.itime <= ?";
+    push @filter_vars, $filter{date};
+  }
+  if (!$filter{include_invalid_warehouses}){
+    push @filter_ary,  "NOT (w.invalid)";
+  }
+
   # prepare qty comparison for later filtering
   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
@@ -574,7 +685,12 @@ sub get_warehouse_report {
   my $sort_order  = $form->{order};
 
   $sort_col       =  $filter{sort}  unless $sort_col;
-  $sort_col       =  "parts_id"     unless $sort_col;
+  # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
+  # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
+  # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
+  # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
+  # S.a. Bug 1597 jb 12.5.2011
+  $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
   $sort_order     =  $filter{order} unless $sort_order;
   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
   my $orderby     =  $sort_col;
@@ -591,7 +707,8 @@ sub get_warehouse_report {
      "bindescription"       => "b.description",
      "binid"                => "b.id",
      "chargenumber"         => "i.chargenumber",
-     "ean"                 => "p.ean",
+     "bestbefore"           => "i.bestbefore",
+     "ean"                  => "p.ean",
      "chargeid"             => "c.id",
      "warehousedescription" => "w.description",
      "partunit"             => "p.unit",
@@ -628,7 +745,7 @@ sub get_warehouse_report {
 
   my (%non_empty_bins, @all_fields, @contents);
 
-  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+  while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
     $ref->{qty} *= 1;
     my $qty      = $ref->{qty};
 
@@ -769,8 +886,8 @@ sub get_basic_bin_info {
   return map { $_->{bin_id} => $_ } @{ $result };
 }
 #
-# Eingabe:     Teilenummer, Lagernummer (warehouse)
-# Ausgabe:     Die maximale Anzahl der Teile in diesem Lager
+# Eingabe:  Teilenummer, Lagernummer (warehouse)
+# Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 #
 sub get_max_qty_parts {
 $main::lxdebug->enter_sub();
@@ -785,12 +902,12 @@ $main::lxdebug->enter_sub();
 
   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
-  my $query = qq| SELECT SUM(qty), bin_id, chargenumber  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber|;
+  my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
   my $max_qty_parts = 0; #Initialisierung mit 0
-  while (my $ref = $sth_QTY->fetchrow_hashref()) {     # wir laufen über alle chargen und Lagerorte (s.a. SQL-Query oben)
+  while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
     $max_qty_parts += $ref->{sum};
   }
 
@@ -800,8 +917,8 @@ $main::lxdebug->enter_sub();
 }
 
 #
-# Eingabe:     Teilenummer, Lagernummer (warehouse)
-# Ausgabe:     Die Beschreibung der Ware bzw. Erzeugnis
+# Eingabe:  Teilenummer, Lagernummer (warehouse)
+# Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 #
 sub get_part_description {
 $main::lxdebug->enter_sub();
@@ -809,7 +926,7 @@ $main::lxdebug->enter_sub();
   my $self     = shift;
   my %params   = @_;
 
-  Common::check_params(\%params, qw(parts_id )); #die brauchen wir
+  Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
   my $myconfig = \%main::myconfig;
   my $form     = $main::form;
@@ -827,6 +944,167 @@ $main::lxdebug->enter_sub();
 
   return $part_description;
 }
+#
+# Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
+# Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
+#           Bzw. Fehler, falls Chargen oder bestbefore
+#           bei eingelagerten Teilen definiert sind.
+#
+sub get_max_qty_parts_bin {
+$main::lxdebug->enter_sub();
+
+  my $self     = shift;
+  my %params   = @_;
+
+  Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
+
+  my $myconfig = \%main::myconfig;
+  my $form     = $main::form;
+
+  my $dbh      = $params{dbh} || $form->get_standard_dbh();
+
+  my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
+                            AND bin_id = ? GROUP BY chargenumber, bestbefore|;
+
+  my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
+
+  my $max_qty_parts = 0; #Initialisierung mit 0
+  # falls derselbe artikel mehrmals eingelagert ist
+  # chargennummer, muss entsprechend händisch agiert werden
+  my $i = 0;
+  my $error;
+  while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
+    $max_qty_parts += $ref->{sum};
+    $i++;
+    if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
+      $error=1;
+    }
+  }
+  #if ($i < 1){
+  #  $error = 2;
+  #}
+
+  $main::lxdebug->leave_sub();
+
+  return ($max_qty_parts, $error);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+SL::WH - Warehouse backend
+
+=head1 SYNOPSIS
+
+  use SL::WH;
+  WH->transfer(\%params);
+
+=head1 DESCRIPTION
+
+Backend for lx-office warehousing functions.
+
+=head1 FUNCTIONS
+
+=head2 transfer \%PARAMS, [ \%PARAMS, ... ]
+
+This is the main function to manipulate warehouse contents. A typical transfer
+is called like this:
+
+  WH->transfer->({
+    parts_id         => 6342,
+    qty              => 12.45,
+    transfer_type    => 'transfer',
+    src_warehouse_id => 12,
+    stc_bin_id       => 23,
+    dst_warehouse_id => 25,
+    dst_bin_id       => 167,
+  });
+
+It will generate an entry in inventory representing the transfer. Note that
+parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
+a destination or a src is mandatory.
+
+transfer accepts more than one transaction parameter, each being a hash ref. If
+more than one is supplied, it is guaranteed, that all are processed in the same
+transaction.
+
+Here is a full list of parameters. All "_id" parameters except oe and
+orderitems can be called without id with RDB objects as well.
+
+=over 4
+
+=item parts_id
+
+The id of the article transferred. Does not check if the article is a service.
+Mandatory.
+
+=item qty
+
+Quantity of the transaction.  Mandatory.
+
+=item unit
+
+Unit of the transaction. Optional.
+
+=item transfer_type
+
+=item transfer_type_id
+
+The type of transaction. The first version is a string describing the
+transaction (the types 'transfer' 'in' 'out' and a few others are present on
+every system), the id is the hard id of a transfer_type from the database.
+
+Depending of the direction of the transfer_type, source and/or destination must
+be specified.
+
+One of transfer_type or transfer_type_id is mandatory.
+
+=item src_warehouse_id
+
+=item src_bin_id
+
+Warehouse and bin from which to transfer. Mandatory in transfer and out
+directions. Ignored in in directions.
+
+=item dst_warehouse_id
+
+=item dst_bin_id
+
+Warehouse and bin to which to transfer. Mandatory in transfer and in
+directions. Ignored in out directions.
+
+=item chargenumber
+
+If given, the transfer will transfer only articles with this chargenumber.
+Optional.
+
+=item orderitem_id
+
+Reference to an orderitem for which this transfer happened. Optional
+
+=item oe_id
+
+Reference to an order for which this transfer happened. Optional
+
+=item comment
+
+An optional comment.
+
+=item best_before
+
+An expiration date. Note that this is not by default used by C<warehouse_report>.
+
+=back
+
+=head1 BUGS
+
+None yet.
+
+=head1 AUTHOR
 
+=cut
 
 1;