Auth.pm cosmetics: Entfernen von $::lxdebug->enter_sub/leave_sub
[kivitendo-erp.git] / SL / WH.pm
index b164a30..4e0c3fc 100644 (file)
--- a/SL/WH.pm
+++ b/SL/WH.pm
@@ -38,93 +38,120 @@ use SL::AM;
 use SL::DBUtils;
 use SL::Form;
 
+use SL::DB::Unit;
+use SL::DB::Assembly;
+
 use warnings;
 use strict;
 
 sub transfer {
-  $main::lxdebug->enter_sub();
+  $::lxdebug->enter_sub;
 
-  my $self = shift;
+  my ($self, @args) = @_;
 
-  if (!@_) {
-    $main::lxdebug->leave_sub();
+  if (!@args) {
+    $::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);
-
-  my $query    = qq|SELECT * FROM transfer_type|;
-  my $sth      = prepare_execute_query($form, $dbh, $query);
-
-  my %transfer_types;
-
-  while (my $ref = $sth->fetchrow_hashref()) {
-    $transfer_types{$ref->{direction}} ||= { };
-    $transfer_types{$ref->{direction}}->{$ref->{description}} = $ref->{id};
-  }
-
-  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, bestbefore,
-                                     oe_id, orderitems_id, shippingdate,
-                                     employee_id, project_id, trans_id, trans_type_id, comment, qty)
-              VALUES (?, ?, ?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?, ?, ?)|;
+  require SL::DB::TransferType;
+  require SL::DB::Part;
+  require SL::DB::Employee;
+  require SL::DB::Inventory;
 
-  $sth   = prepare_query($form, $dbh, $query);
+  my $employee   = SL::DB::Manager::Employee->find_by(login => $::form->{login});
+  my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
+  my @directions = (undef, qw(out in transfer));
 
-  my @directions = (undef, 'out', 'in', 'transfer');
+  my $objectify = sub {
+    my ($transfer, $field, $class, @find_by) = @_;
 
-  while (@_) {
-    my $transfer   = shift;
-    my ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
+    @find_by = (description => $transfer->{$field}) unless @find_by;
 
-    my ($direction, @values) = (0);
-
-    $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_date($transfer->{bestbefore}), 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->do_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 orderitems_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}};
-
-      $qty *= $units->{$transfer->{unit}}->{factor};
-      $qty /= $units->{$partunit}->{factor} || 1 if ($partunit);
-    }
+      $params{chargenumber} ||= '';
 
-    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 & 1) {
+        SL::DB::Inventory->new(
+          %params,
+          warehouse => $src_wh,
+          bin       => $src_bin,
+          qty       => $qty * -1,
+        )->save;
+      }
 
-    if ($direction & 2) {
-      do_statement($form, $sth, $query, conv_i($transfer->{dst_warehouse_id}), conv_i($transfer->{dst_bin_id}), @values, $qty);
+      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})){
+          my $part = SL::DB::Part->new(id        => conv_i($transfer->{parts_id}))->load;
+          $part->update_attributes(warehouse_id  => conv_i($transfer->{dst_warehouse_id}));
+          $part->update_attributes(bin_id        => conv_i($transfer->{dst_bin_id}));
+        }
+     }
+
+      push @trans_ids, $trans_id;
     }
-  }
-
-  $sth->finish();
+  }) 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 {
@@ -134,6 +161,17 @@ sub transfer_assembly {
   my %params   = @_;
   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);
 
   my $myconfig = \%main::myconfig;
@@ -145,12 +183,12 @@ 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 - 
+  # 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  
+  # 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, 
+  # 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
@@ -158,7 +196,7 @@ sub transfer_assembly {
   # (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 
+  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});
@@ -183,10 +221,10 @@ sub transfer_assembly {
                                              warehouse_id => $params{dst_warehouse_id});
 
     if ($partsQTY  > $max_parts){
-      # Gibt es hier ein Problem mit nicht "escapten" Zeichen? 
+      # 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) . 
+
+      $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)
@@ -199,7 +237,7 @@ sub transfer_assembly {
     # 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  
+    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);
 
@@ -212,14 +250,14 @@ sub transfer_assembly {
       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. 
+      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. 
+        $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}, 
+        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);
 
@@ -254,7 +292,7 @@ sub transfer_assembly {
                                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}, 
+  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();
 
@@ -279,12 +317,12 @@ sub get_warehouse_journal {
   # filters
   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};
   }
@@ -350,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",
@@ -396,6 +434,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
@@ -602,6 +641,14 @@ sub get_warehouse_report {
     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);
 
@@ -622,7 +669,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;
@@ -876,6 +928,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}){
+      $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;