1 #====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #=====================================================================
 
   8 # SQL-Ledger Accounting
 
   9 # Copyright (C) 1999-2003
 
  11 #  Author: Dieter Simader
 
  12 #   Email: dsimader@sql-ledger.org
 
  13 #     Web: http://www.sql-ledger.org
 
  17 # This program is free software; you can redistribute it and/or modify
 
  18 # it under the terms of the GNU General Public License as published by
 
  19 # the Free Software Foundation; either version 2 of the License, or
 
  20 # (at your option) any later version.
 
  22 # This program is distributed in the hope that it will be useful,
 
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
  25 # GNU General Public License for more details.
 
  26 # You should have received a copy of the GNU General Public License
 
  27 # along with this program; if not, write to the Free Software
 
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
  29 #======================================================================
 
  33 #======================================================================
 
  40 use SL::Util qw(trim);
 
  49   $::lxdebug->enter_sub;
 
  51   my ($self, @args) = @_;
 
  54     $::lxdebug->leave_sub;
 
  58   require SL::DB::TransferType;
 
  60   require SL::DB::Employee;
 
  61   require SL::DB::Inventory;
 
  63   my $employee   = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
 
  64   my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
 
  65   my @directions = (undef, qw(out in transfer));
 
  68     my ($transfer, $field, $class, @find_by) = @_;
 
  70     @find_by = (description => $transfer->{$field}) unless @find_by;
 
  72     if ($transfer->{$field} || $transfer->{"${field}_id"}) {
 
  73       return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
 
  74            : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
 
  75            : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
 
  82   my $db = SL::DB::Inventory->new->db;
 
  83   $db->with_transaction(sub{
 
  84     while (my $transfer = shift @args) {
 
  85       my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
 
  87       my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
 
  88       my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
 
  89       my $qty           = $transfer->{qty};
 
  90       my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
 
  91       my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
 
  92       my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
 
  93       my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
 
  94       my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
 
  96       $src_wh ||= $src_bin->warehouse if $src_bin;
 
  97       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
 
  99       my $direction = 0; # bit mask
 
 100       $direction |= 1 if $src_bin;
 
 101       $direction |= 2 if $dst_bin;
 
 103       my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
 
 104                                                                                            description => $transfer->{transfer_type});
 
 108           employee         => $employee,
 
 109           trans_type       => $transfer_type,
 
 111           trans_id         => $trans_id,
 
 112           shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
 
 113                               ? $now : $transfer->{shippingdate},
 
 114           map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
 
 118         $qty = $unit->convert_to($qty, $part->unit_obj);
 
 121       $params{chargenumber} ||= '';
 
 123       if ($direction & 1) {
 
 124         SL::DB::Inventory->new(
 
 126           warehouse => $src_wh,
 
 132       if ($direction & 2) {
 
 133         SL::DB::Inventory->new(
 
 135           warehouse => $dst_wh->id,
 
 139         # Standardlagerplatz in Stammdaten gleich mitverschieben
 
 140         if (defined($transfer->{change_default_bin})){
 
 141           $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
 
 145       push @trans_ids, $trans_id;
 
 150     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
 
 153   $::lxdebug->leave_sub;
 
 158 sub transfer_assembly {
 
 159   $main::lxdebug->enter_sub();
 
 163   Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
 
 166   my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
 
 168     my $assembly = SL::DB::Manager::Assembly->get_all(
 
 169       query => [ id => $params{assembly_id} ],
 
 170       with_objects => ['part'],
 
 173     $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
 
 176 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
 
 178   my $myconfig = \%main::myconfig;
 
 179   my $form     = $main::form;
 
 180   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 
 185   # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
 
 186   # select parts_id,qty from assembly where id=1064;
 
 187   # Erweiterung für bug 935 am 23.4.09 -
 
 188   # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
 
 189   # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 190   # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
 
 192   # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
 
 193   # wenn assembly nicht überprüft wird ...
 
 194   # patch von joachim eingespielt 24.4.2009:
 
 195   # my $query    = qq|select parts_id,qty from assembly inner join parts
 
 196   # on assembly.parts_id = parts.id  where assembly.id = ? and
 
 197   # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 200   my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 201                   where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 203   my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
 
 205   # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
 
 206   my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
 
 207                            VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 208                            (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
 
 209   my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
 
 211   # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
 
 213   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
 
 214   my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
 
 215   while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
 
 216     $schleife_durchlaufen=1;  # Erzeugnis definiert
 
 217     my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
 
 218     my $currentPart_ID = $hash_ref->{parts_id};
 
 220     # Überprüfen, ob diese Anzahl gefertigt werden kann
 
 221     my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
 
 222                                              warehouse_id => $params{dst_warehouse_id});
 
 224     if ($partsQTY  > $max_parts){
 
 225       # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
 
 226       # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
 
 228       $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
 
 229                             " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
 
 230                             ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
 
 231       next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
 
 234     # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
 
 235     # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
 
 236     # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
 
 237     # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
 
 238     # und lösen den Rest dann so wie bei xplace im Barcode-Programm
 
 239     # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
 
 241     my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
 
 242                        WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
 
 243     my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
 
 245     # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
 
 246     my $tmpPartsQTY = $partsQTY;
 
 248     while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
 
 249       my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
 
 250       my $temppart_chargenumber = $temphash_ref->{chargenumber};
 
 251       my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
 
 252       my $temppart_qty          = $temphash_ref->{sum};
 
 254       if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
 
 255                                            # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
 
 256         $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
 
 257         $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
 
 258                                             # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
 
 259                                             # Dieser Wert IST und BLEIBT positiv!! Hilfe.
 
 260                                             # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
 
 261         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 262                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 263                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
 
 265         # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
 
 266         # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
 
 267         # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
 
 268         # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
 
 269       } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
 
 271         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 272                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 273                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
 
 274         last; # beendet die schleife (springt zum letzten element)
 
 276     }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
 
 277   } #ende while select parts_id,qty from assembly where id = ?
 
 279   if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
 
 280                                   # keine einzelteile definiert
 
 281       $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
 
 282                            Dementsprechend kann auch nichts hergestellt werden";
 
 284   # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
 
 285   #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
 
 286   if ($kannNichtFertigen) {
 
 287     return $kannNichtFertigen;
 
 290   # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
 
 291   my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
 
 292                                                       comment, employee_id, qty, trans_id, trans_type_id)
 
 293                                VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 294                                (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
 
 295   my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
 
 296   do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
 
 297                $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
 
 300   $main::lxdebug->leave_sub();
 
 301   return 1; # Alles erfolgreich
 
 304 sub get_warehouse_journal {
 
 305   $main::lxdebug->enter_sub();
 
 310   my $myconfig  = \%main::myconfig;
 
 311   my $form      = $main::form;
 
 313   my $all_units = AM->retrieve_units($myconfig, $form);
 
 315   # connect to database
 
 316   my $dbh = $form->get_standard_dbh($myconfig);
 
 319   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 321   if ($filter{warehouse_id}) {
 
 322     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 323     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 326   if ($filter{bin_id}) {
 
 327     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 328     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 331   if ($filter{partnumber}) {
 
 332     push @filter_ary, "p.partnumber ILIKE ?";
 
 333     push @filter_vars, like($filter{partnumber});
 
 336   if ($filter{description}) {
 
 337     push @filter_ary, "(p.description ILIKE ?)";
 
 338     push @filter_vars, like($filter{description});
 
 341   if ($filter{chargenumber}) {
 
 342     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 343     push @filter_vars, like($filter{chargenumber});
 
 346   if (trim($form->{bestbefore})) {
 
 347     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 348     push @filter_vars, trim($form->{bestbefore});
 
 351   if (trim($form->{fromdate})) {
 
 352     push @filter_ary, "? <= i1.shippingdate";
 
 353     push @filter_vars, trim($form->{fromdate});
 
 356   if (trim($form->{todate})) {
 
 357     push @filter_ary, "? >= i1.shippingdate";
 
 358     push @filter_vars, trim($form->{todate});
 
 361   if ($form->{l_employee}) {
 
 365   # prepare qty comparison for later filtering
 
 366   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 367   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 368     $f_qty_op        = $filter{qty_op};
 
 369     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 370     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 373   map { $_ = "(${_})"; } @filter_ary;
 
 375   # if of a property number or description is requested,
 
 376   # automatically check the matching id too.
 
 377   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 379   # customize shown entry for not available fields.
 
 380   $filter{na} = '-' unless $filter{na};
 
 382   # make order, search in $filter and $form
 
 383   my $sort_col   = $form->{sort};
 
 384   my $sort_order = $form->{order};
 
 386   $sort_col      = $filter{sort}         unless $sort_col;
 
 387   $sort_order    = ($sort_col = 'shippingdate') unless $sort_col;
 
 388   $sort_col      = 'shippingdate'               if     $sort_col eq 'date';
 
 389   $sort_order    = $filter{order}        unless $sort_order;
 
 390   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 392   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 394   $select_tokens{'trans'} = {
 
 395      "parts_id"             => "i1.parts_id",
 
 396      "qty"                  => "ABS(SUM(i1.qty))",
 
 397      "partnumber"           => "p.partnumber",
 
 398      "partdescription"      => "p.description",
 
 399      "bindescription"       => "b.description",
 
 400      "chargenumber"         => "i1.chargenumber",
 
 401      "bestbefore"           => "i1.bestbefore",
 
 402      "warehousedescription" => "w.description",
 
 403      "partunit"             => "p.unit",
 
 404      "bin_from"             => "b1.description",
 
 405      "bin_to"               => "b2.description",
 
 406      "warehouse_from"       => "w1.description",
 
 407      "warehouse_to"         => "w2.description",
 
 408      "comment"              => "i1.comment",
 
 409      "trans_type"           => "tt.description",
 
 410      "trans_id"             => "i1.trans_id",
 
 411      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 
 412      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 
 413      "date"                 => "i1.shippingdate",
 
 414      "itime"                => "i1.itime",
 
 415      "shippingdate"         => "i1.shippingdate",
 
 416      "employee"             => "e.name",
 
 417      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 
 420   $select_tokens{'out'} = {
 
 421      "bin_to"               => "'$filter{na}'",
 
 422      "warehouse_to"         => "'$filter{na}'",
 
 425   $select_tokens{'in'} = {
 
 426      "bin_from"             => "'$filter{na}'",
 
 427      "warehouse_from"       => "'$filter{na}'",
 
 430   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
 
 432   # build the select clauses.
 
 433   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 
 434   for my $i ('trans', 'out', 'in') {
 
 435     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 
 436           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
 
 439   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 
 440         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
 
 442   $where_clause = defined($where_clause) ? $where_clause : '';
 
 445   qq|SELECT DISTINCT $select{trans}
 
 447     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 448     LEFT JOIN parts p ON i1.parts_id = p.id
 
 449     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 450     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 451     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 452     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 453     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 454     LEFT JOIN project pr ON i1.project_id = pr.id
 
 455     LEFT JOIN employee e ON i1.employee_id = e.id
 
 456     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 457           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 458     GROUP BY $group_clause
 
 462     SELECT DISTINCT $select{out}
 
 464     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 465     LEFT JOIN parts p ON i1.parts_id = p.id
 
 466     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 467     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 468     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 469     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 470     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 471     LEFT JOIN project pr ON i1.project_id = pr.id
 
 472     LEFT JOIN employee e ON i1.employee_id = e.id
 
 473     WHERE $where_clause i1.qty < 0 AND
 
 474           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 475     GROUP BY $group_clause
 
 479     SELECT DISTINCT $select{in}
 
 481     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 482     LEFT JOIN parts p ON i1.parts_id = p.id
 
 483     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 484     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 485     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 486     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 487     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 488     LEFT JOIN project pr ON i1.project_id = pr.id
 
 489     LEFT JOIN employee e ON i1.employee_id = e.id
 
 490     WHERE $where_clause i1.qty > 0 AND
 
 491           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 492     GROUP BY $group_clause
 
 493     ORDER BY r_${sort_spec}|;
 
 495   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 497   my ($h_oe_id, $q_oe_id);
 
 498   if ($form->{l_oe_id}) {
 
 501         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 503           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 504           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 505           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 506           ELSE                                                                       'purchase_order'
 
 513       SELECT dord.id AS id, dord.donumber AS number,
 
 515           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 516           ELSE                               'sales_delivery_order'
 
 518       FROM delivery_orders dord
 
 523       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 529       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 535       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 537       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 541       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 543       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 545     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 549   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 550     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 551     my $qty = $ref->{"qty"} * 1;
 
 553     next unless ($qty > 0);
 
 556       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 557       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 558       $qty *= $part_unit->{"factor"};
 
 559       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 560       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 561       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 564     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 
 565       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
 
 566       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
 
 567       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 570     push @contents, $ref;
 
 574   $h_oe_id->finish() if $h_oe_id;
 
 576   $main::lxdebug->leave_sub();
 
 582 # This sub is the primary function to retrieve information about items in warehouses.
 
 583 # $filter is a hashref and supports the following keys:
 
 584 #  - warehouse_id - will return matches with this warehouse_id only
 
 585 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 586 #  - partsid      - will return matches with this parts_id only
 
 587 #  - description  - will return only matches where the given string is a substring of the description
 
 588 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 589 #  - bestbefore   - will return only matches with this bestbefore date
 
 590 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 591 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 592 #  - expires_in   - will only return matches that expire within the given number of days
 
 593 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 594 #  - hazardous    - will return matches with the flag hazardous only
 
 595 #  - oil          - will return matches with the flag oil only
 
 596 #  - qty, qty_op  - quantity filter (more info to come)
 
 597 #  - sort, order_by - sorting (more to come)
 
 598 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 599 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 601 sub get_warehouse_report {
 
 602   $main::lxdebug->enter_sub();
 
 607   my $myconfig  = \%main::myconfig;
 
 608   my $form      = $main::form;
 
 610   my $all_units = AM->retrieve_units($myconfig, $form);
 
 612   # connect to database
 
 613   my $dbh = $form->get_standard_dbh($myconfig);
 
 616   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 618   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 620   if ($filter{warehouse_id}) {
 
 621     push @wh_bin_filter_ary,  "w.id = ?";
 
 622     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 625   if ($filter{bin_id}) {
 
 626     push @wh_bin_filter_ary,  "b.id = ?";
 
 627     push @wh_bin_filter_vars, $filter{bin_id};
 
 630   push @filter_ary,  @wh_bin_filter_ary;
 
 631   push @filter_vars, @wh_bin_filter_vars;
 
 633   if ($filter{partnumber}) {
 
 634     push @filter_ary,  "p.partnumber ILIKE ?";
 
 635     push @filter_vars, like($filter{partnumber});
 
 638   if ($filter{description}) {
 
 639     push @filter_ary,  "p.description ILIKE ?";
 
 640     push @filter_vars, like($filter{description});
 
 643   if ($filter{partsid}) {
 
 644     push @filter_ary,  "p.id = ?";
 
 645     push @filter_vars, $filter{partsid};
 
 648   if ($filter{chargenumber}) {
 
 649     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 650     push @filter_vars, like($filter{chargenumber});
 
 653   if (trim($form->{bestbefore})) {
 
 654     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 655     push @filter_vars, trim($form->{bestbefore});
 
 659     push @filter_ary,  "p.ean ILIKE ?";
 
 660     push @filter_vars, like($filter{ean});
 
 663   if (trim($filter{date})) {
 
 664     push @filter_ary, "i.shippingdate <= ?";
 
 665     push @filter_vars, trim($filter{date});
 
 667   if (!$filter{include_invalid_warehouses}){
 
 668     push @filter_ary,  "NOT (w.invalid)";
 
 671   # prepare qty comparison for later filtering
 
 672   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 674   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 675     $f_qty_op        = $filter{qty_op};
 
 676     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 677     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 680   map { $_ = "(${_})"; } @filter_ary;
 
 682   # if of a property number or description is requested,
 
 683   # automatically check the matching id too.
 
 684   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 686   # make order, search in $filter and $form
 
 687   my $sort_col    =  $form->{sort};
 
 688   my $sort_order  = $form->{order};
 
 690   $sort_col       =  $filter{sort}  unless $sort_col;
 
 691   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 692   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 693   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 694   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 695   # S.a. Bug 1597 jb 12.5.2011
 
 696   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 697   $sort_order     =  $filter{order} unless $sort_order;
 
 698   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 699   my $orderby     =  $sort_col;
 
 700   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 702   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 704   my %select_tokens = (
 
 705      "parts_id"              => "i.parts_id",
 
 706      "qty"                  => "SUM(i.qty)",
 
 707      "warehouseid"          => "i.warehouse_id",
 
 708      "partnumber"           => "p.partnumber",
 
 709      "partdescription"      => "p.description",
 
 710      "bindescription"       => "b.description",
 
 712      "chargenumber"         => "i.chargenumber",
 
 713      "bestbefore"           => "i.bestbefore",
 
 715      "chargeid"             => "c.id",
 
 716      "warehousedescription" => "w.description",
 
 717      "partunit"             => "p.unit",
 
 718      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 720   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 721         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 722           qw(l_parts_id l_qty l_partunit) );
 
 724   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 725         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 726           qw(l_parts_id l_partunit) );
 
 729     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 732   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 733         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 734           qw(l_parts_id l_qty l_partunit) );
 
 737     qq|SELECT $select_clause
 
 739       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 740       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 741       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 744       GROUP BY $group_clause
 
 745       ORDER BY $sort_spec|;
 
 747   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 749   my (%non_empty_bins, @all_fields, @contents);
 
 751   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 753     my $qty      = $ref->{qty};
 
 755     next unless ($qty != 0);
 
 758       my $part_unit = $all_units->{$ref->{partunit}};
 
 759       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 760       $qty *= $part_unit->{factor};
 
 761       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 762       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 763       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 766     if ($form->{include_empty_bins}) {
 
 767       $non_empty_bins{$ref->{binid}} = 1;
 
 768       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 771     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 773     push @contents, $ref;
 
 778   if ($form->{include_empty_bins}) {
 
 781            w.id AS warehouseid, w.description AS warehousedescription,
 
 782            b.id AS binid, b.description AS bindescription
 
 784          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 786     @filter_ary  = @wh_bin_filter_ary;
 
 787     @filter_vars = @wh_bin_filter_vars;
 
 789     my @non_empty_bin_ids = keys %non_empty_bins;
 
 790     if (@non_empty_bin_ids) {
 
 791       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 792       push @filter_vars, @non_empty_bin_ids;
 
 795     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 797     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 799     while (my $ref = $sth->fetchrow_hashref()) {
 
 800       map { $ref->{$_} ||= "" } @all_fields;
 
 801       push @contents, $ref;
 
 805     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 806       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 810   $main::lxdebug->leave_sub();
 
 816   $main::lxdebug->enter_sub();
 
 818   my ($self, $qty_op) = @_;
 
 820   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 821     $main::lxdebug->leave_sub();
 
 825   if ($qty_op eq "atleast") {
 
 827   } elsif ($qty_op eq "atmost") {
 
 833   $main::lxdebug->leave_sub();
 
 838 sub retrieve_transfer_types {
 
 839   $main::lxdebug->enter_sub();
 
 842   my $direction = shift;
 
 844   my $myconfig  = \%main::myconfig;
 
 845   my $form      = $main::form;
 
 847   my $dbh       = $form->get_standard_dbh($myconfig);
 
 849   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 851   $main::lxdebug->leave_sub();
 
 856 sub get_basic_bin_info {
 
 857   $main::lxdebug->enter_sub();
 
 862   Common::check_params(\%params, qw(id));
 
 864   my $myconfig = \%main::myconfig;
 
 865   my $form     = $main::form;
 
 867   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 869   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 872     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 873          w.id AS warehouse_id, w.description AS warehouse_description
 
 875        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 876        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 878   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 880   if ('' eq ref $params{id}) {
 
 881     $result = $result->[0] || { };
 
 882     $main::lxdebug->leave_sub();
 
 887   $main::lxdebug->leave_sub();
 
 889   return map { $_->{bin_id} => $_ } @{ $result };
 
 892 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 893 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 895 sub get_max_qty_parts {
 
 896 $main::lxdebug->enter_sub();
 
 901   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 903   my $myconfig = \%main::myconfig;
 
 904   my $form     = $main::form;
 
 906   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 908   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 910   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 912   my $max_qty_parts = 0; #Initialisierung mit 0
 
 913   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 914     $max_qty_parts += $ref->{sum};
 
 917   $main::lxdebug->leave_sub();
 
 919   return $max_qty_parts;
 
 923 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 924 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 926 sub get_part_description {
 
 927 $main::lxdebug->enter_sub();
 
 932   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 934   my $myconfig = \%main::myconfig;
 
 935   my $form     = $main::form;
 
 937   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 939   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 941   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 943   my $ref = $sth->fetchrow_hashref();
 
 944   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 946   $main::lxdebug->leave_sub();
 
 948   return $part_description;
 
 951 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 952 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 953 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 954 #           bei eingelagerten Teilen definiert sind.
 
 956 sub get_max_qty_parts_bin {
 
 957 $main::lxdebug->enter_sub();
 
 962   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 964   my $myconfig = \%main::myconfig;
 
 965   my $form     = $main::form;
 
 967   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 969   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 970                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 972   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 974   my $max_qty_parts = 0; #Initialisierung mit 0
 
 975   # falls derselbe artikel mehrmals eingelagert ist
 
 976   # chargennummer, muss entsprechend händisch agiert werden
 
 979   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 980     $max_qty_parts += $ref->{sum};
 
 982     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
 
 986   $main::lxdebug->leave_sub();
 
 988   return ($max_qty_parts, $error);
 
 997 SL::WH - Warehouse backend
 
1002   WH->transfer(\%params);
 
1006 Backend for kivitendo warehousing functions.
 
1010 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1012 This is the main function to manipulate warehouse contents. A typical transfer
 
1013 is called like this:
 
1018     transfer_type    => 'transfer',
 
1019     src_warehouse_id => 12,
 
1021     dst_warehouse_id => 25,
 
1025 It will generate an entry in inventory representing the transfer. Note that
 
1026 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1027 a destination or a src is mandatory.
 
1029 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1030 more than one is supplied, it is guaranteed, that all are processed in the same
 
1033 Here is a full list of parameters. All "_id" parameters except oe and
 
1034 orderitems can be called without id with RDB objects as well.
 
1040 The id of the article transferred. Does not check if the article is a service.
 
1045 Quantity of the transaction.  Mandatory.
 
1049 Unit of the transaction. Optional.
 
1053 =item transfer_type_id
 
1055 The type of transaction. The first version is a string describing the
 
1056 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1057 every system), the id is the hard id of a transfer_type from the database.
 
1059 Depending of the direction of the transfer_type, source and/or destination must
 
1062 One of transfer_type or transfer_type_id is mandatory.
 
1064 =item src_warehouse_id
 
1068 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1069 directions. Ignored in in directions.
 
1071 =item dst_warehouse_id
 
1075 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1076 directions. Ignored in out directions.
 
1080 If given, the transfer will transfer only articles with this chargenumber.
 
1085 Reference to an orderitem for which this transfer happened. Optional
 
1089 Reference to an order for which this transfer happened. Optional
 
1093 An optional comment.
 
1097 An expiration date. Note that this is not by default used by C<warehouse_report>.