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 #======================================================================
 
  48   $::lxdebug->enter_sub;
 
  50   my ($self, @args) = @_;
 
  53     $::lxdebug->leave_sub;
 
  57   require SL::DB::TransferType;
 
  59   require SL::DB::Employee;
 
  60   require SL::DB::Inventory;
 
  62   my $employee   = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
 
  63   my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
 
  64   my @directions = (undef, qw(out in transfer));
 
  67     my ($transfer, $field, $class, @find_by) = @_;
 
  69     @find_by = (description => $transfer->{$field}) unless @find_by;
 
  71     if ($transfer->{$field} || $transfer->{"${field}_id"}) {
 
  72       return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
 
  73            : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
 
  74            : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
 
  81   my $db = SL::DB::Inventory->new->db;
 
  82   $db->with_transaction(sub{
 
  83     while (my $transfer = shift @args) {
 
  84       my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
 
  86       my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
 
  87       my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
 
  88       my $qty           = $transfer->{qty};
 
  89       my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
 
  90       my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
 
  91       my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
 
  92       my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
 
  93       my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
 
  95       $src_wh ||= $src_bin->warehouse if $src_bin;
 
  96       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
 
  98       my $direction = 0; # bit mask
 
  99       $direction |= 1 if $src_bin;
 
 100       $direction |= 2 if $dst_bin;
 
 102       my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
 
 103                                                                                            description => $transfer->{transfer_type});
 
 107           employee         => $employee,
 
 108           trans_type       => $transfer_type,
 
 110           trans_id         => $trans_id,
 
 111           shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
 
 112                               ? $now : $transfer->{shippingdate},
 
 113           map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
 
 117         $qty = $unit->convert_to($qty, $part->unit_obj);
 
 120       $params{chargenumber} ||= '';
 
 122       if ($direction & 1) {
 
 123         SL::DB::Inventory->new(
 
 125           warehouse => $src_wh,
 
 131       if ($direction & 2) {
 
 132         SL::DB::Inventory->new(
 
 134           warehouse => $dst_wh->id,
 
 138         # Standardlagerplatz in Stammdaten gleich mitverschieben
 
 139         if (defined($transfer->{change_default_bin})){
 
 140           my $part = SL::DB::Part->new(id        => conv_i($transfer->{parts_id}))->load;
 
 141           $part->update_attributes(warehouse_id  => conv_i($transfer->{dst_warehouse_id}));
 
 142           $part->update_attributes(bin_id        => conv_i($transfer->{dst_bin_id}));
 
 146       push @trans_ids, $trans_id;
 
 151     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
 
 154   $::lxdebug->leave_sub;
 
 159 sub transfer_assembly {
 
 160   $main::lxdebug->enter_sub();
 
 164   Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
 
 167   my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
 
 169     my $assembly = SL::DB::Manager::Assembly->get_all(
 
 170       query => [ id => $params{assembly_id} ],
 
 171       with_objects => ['part'],
 
 174     $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
 
 177 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
 
 179   my $myconfig = \%main::myconfig;
 
 180   my $form     = $main::form;
 
 181   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 
 186   # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
 
 187   # select parts_id,qty from assembly where id=1064;
 
 188   # Erweiterung für bug 935 am 23.4.09 -
 
 189   # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
 
 190   # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 191   # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
 
 193   # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
 
 194   # wenn assembly nicht überprüft wird ...
 
 195   # patch von joachim eingespielt 24.4.2009:
 
 196   # my $query    = qq|select parts_id,qty from assembly inner join parts
 
 197   # on assembly.parts_id = parts.id  where assembly.id = ? and
 
 198   # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 201   my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 202                   where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 204   my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
 
 206   # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
 
 207   my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
 
 208                            VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 209                            (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
 
 210   my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
 
 212   # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
 
 214   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
 
 215   my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
 
 216   while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
 
 217     $schleife_durchlaufen=1;  # Erzeugnis definiert
 
 218     my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
 
 219     my $currentPart_ID = $hash_ref->{parts_id};
 
 221     # Überprüfen, ob diese Anzahl gefertigt werden kann
 
 222     my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
 
 223                                              warehouse_id => $params{dst_warehouse_id});
 
 225     if ($partsQTY  > $max_parts){
 
 226       # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
 
 227       # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
 
 229       $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
 
 230                             " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
 
 231                             ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
 
 232       next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
 
 235     # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
 
 236     # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
 
 237     # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
 
 238     # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
 
 239     # und lösen den Rest dann so wie bei xplace im Barcode-Programm
 
 240     # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
 
 242     my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
 
 243                        WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
 
 244     my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
 
 246     # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
 
 247     my $tmpPartsQTY = $partsQTY;
 
 249     while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
 
 250       my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
 
 251       my $temppart_chargenumber = $temphash_ref->{chargenumber};
 
 252       my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
 
 253       my $temppart_qty          = $temphash_ref->{sum};
 
 255       if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
 
 256                                            # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
 
 257         $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
 
 258         $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
 
 259                                             # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
 
 260                                             # Dieser Wert IST und BLEIBT positiv!! Hilfe.
 
 261                                             # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
 
 262         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 263                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 264                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
 
 266         # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
 
 267         # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
 
 268         # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
 
 269         # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
 
 270       } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
 
 272         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 273                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 274                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
 
 275         last; # beendet die schleife (springt zum letzten element)
 
 277     }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
 
 278   } #ende while select parts_id,qty from assembly where id = ?
 
 280   if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
 
 281                                   # keine einzelteile definiert
 
 282       $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
 
 283                            Dementsprechend kann auch nichts hergestellt werden";
 
 285   # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
 
 286   #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
 
 287   if ($kannNichtFertigen) {
 
 288     return $kannNichtFertigen;
 
 291   # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
 
 292   my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
 
 293                                                       comment, employee_id, qty, trans_id, trans_type_id)
 
 294                                VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 295                                (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
 
 296   my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
 
 297   do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
 
 298                $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
 
 301   $main::lxdebug->leave_sub();
 
 302   return 1; # Alles erfolgreich
 
 305 sub get_warehouse_journal {
 
 306   $main::lxdebug->enter_sub();
 
 311   my $myconfig  = \%main::myconfig;
 
 312   my $form      = $main::form;
 
 314   my $all_units = AM->retrieve_units($myconfig, $form);
 
 316   # connect to database
 
 317   my $dbh = $form->get_standard_dbh($myconfig);
 
 320   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 322   if ($filter{warehouse_id}) {
 
 323     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 324     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 327   if ($filter{bin_id}) {
 
 328     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 329     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 332   if ($filter{partnumber}) {
 
 333     push @filter_ary, "p.partnumber ILIKE ?";
 
 334     push @filter_vars, '%' . $filter{partnumber} . '%';
 
 337   if ($filter{description}) {
 
 338     push @filter_ary, "(p.description ILIKE ?)";
 
 339     push @filter_vars, '%' . $filter{description} . '%';
 
 342   if ($filter{chargenumber}) {
 
 343     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 344     push @filter_vars, '%' . $filter{chargenumber} . '%';
 
 347   if ($form->{bestbefore}) {
 
 348     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 349     push @filter_vars, $form->{bestbefore};
 
 352   if ($form->{fromdate}) {
 
 353     push @filter_ary, "?::DATE <= i1.itime::DATE";
 
 354     push @filter_vars, $form->{fromdate};
 
 357   if ($form->{todate}) {
 
 358     push @filter_ary, "?::DATE >= i1.itime::DATE";
 
 359     push @filter_vars, $form->{todate};
 
 362   if ($form->{l_employee}) {
 
 366   # prepare qty comparison for later filtering
 
 367   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 368   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 369     $f_qty_op        = $filter{qty_op};
 
 370     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 371     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 374   map { $_ = "(${_})"; } @filter_ary;
 
 376   # if of a property number or description is requested,
 
 377   # automatically check the matching id too.
 
 378   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 380   # customize shown entry for not available fields.
 
 381   $filter{na} = '-' unless $filter{na};
 
 383   # make order, search in $filter and $form
 
 384   my $sort_col   = $form->{sort};
 
 385   my $sort_order = $form->{order};
 
 387   $sort_col      = $filter{sort}         unless $sort_col;
 
 388   $sort_order    = ($sort_col = 'itime') unless $sort_col;
 
 389   $sort_col      = 'itime'               if     $sort_col eq 'date';
 
 390   $sort_order    = $filter{order}        unless $sort_order;
 
 391   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 393   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 395   $select_tokens{'trans'} = {
 
 396      "parts_id"             => "i1.parts_id",
 
 397      "qty"                  => "ABS(SUM(i1.qty))",
 
 398      "partnumber"           => "p.partnumber",
 
 399      "partdescription"      => "p.description",
 
 400      "bindescription"       => "b.description",
 
 401      "chargenumber"         => "i1.chargenumber",
 
 402      "bestbefore"           => "i1.bestbefore",
 
 403      "warehousedescription" => "w.description",
 
 404      "partunit"             => "p.unit",
 
 405      "bin_from"             => "b1.description",
 
 406      "bin_to"               => "b2.description",
 
 407      "warehouse_from"       => "w1.description",
 
 408      "warehouse_to"         => "w2.description",
 
 409      "comment"              => "i1.comment",
 
 410      "trans_type"           => "tt.description",
 
 411      "trans_id"             => "i1.trans_id",
 
 412      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 
 413      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 
 414      "date"                 => "i1.itime::DATE",
 
 415      "itime"                => "i1.itime",
 
 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_itime) );
 
 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_itime) );
 
 442   $where_clause = defined($where_clause) ? $where_clause : '';
 
 444   qq|SELECT DISTINCT $select{trans}
 
 446     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 447     LEFT JOIN parts p ON i1.parts_id = p.id
 
 448     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 449     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 450     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 451     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 452     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 453     LEFT JOIN project pr ON i1.project_id = pr.id
 
 454     LEFT JOIN employee e ON i1.employee_id = e.id
 
 455     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 456           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 457     GROUP BY $group_clause
 
 461     SELECT DISTINCT $select{out}
 
 463     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 464     LEFT JOIN parts p ON i1.parts_id = p.id
 
 465     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 466     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 467     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 468     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 469     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 470     LEFT JOIN project pr ON i1.project_id = pr.id
 
 471     LEFT JOIN employee e ON i1.employee_id = e.id
 
 472     WHERE $where_clause i1.qty < 0 AND
 
 473           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 474     GROUP BY $group_clause
 
 478     SELECT DISTINCT $select{in}
 
 480     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 481     LEFT JOIN parts p ON i1.parts_id = p.id
 
 482     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 483     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 484     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 485     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 486     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 487     LEFT JOIN project pr ON i1.project_id = pr.id
 
 488     LEFT JOIN employee e ON i1.employee_id = e.id
 
 489     WHERE $where_clause i1.qty > 0 AND
 
 490           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 491     GROUP BY $group_clause
 
 492     ORDER BY r_${sort_spec}|;
 
 494   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 496   my ($h_oe_id, $q_oe_id);
 
 497   if ($form->{l_oe_id}) {
 
 500         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 502           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 503           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 504           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 505           ELSE                                                                       'purchase_order'
 
 512       SELECT dord.id AS id, dord.donumber AS number,
 
 514           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 515           ELSE                               'sales_delivery_order'
 
 517       FROM delivery_orders dord
 
 522       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 528       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 534       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 536       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 540       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 542       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 544     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 548   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 549     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 550     my $qty = $ref->{"qty"} * 1;
 
 552     next unless ($qty > 0);
 
 555       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 556       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 557       $qty *= $part_unit->{"factor"};
 
 558       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 559       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 560       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 563     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 
 564       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
 
 565       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
 
 566       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 569     push @contents, $ref;
 
 573   $h_oe_id->finish() if $h_oe_id;
 
 575   $main::lxdebug->leave_sub();
 
 581 # This sub is the primary function to retrieve information about items in warehouses.
 
 582 # $filter is a hashref and supports the following keys:
 
 583 #  - warehouse_id - will return matches with this warehouse_id only
 
 584 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 585 #  - partsid      - will return matches with this parts_id only
 
 586 #  - description  - will return only matches where the given string is a substring of the description
 
 587 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 588 #  - bestbefore   - will return only matches with this bestbefore date
 
 589 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 590 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 591 #  - expires_in   - will only return matches that expire within the given number of days
 
 592 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 593 #  - hazardous    - will return matches with the flag hazardous only
 
 594 #  - oil          - will return matches with the flag oil only
 
 595 #  - qty, qty_op  - quantity filter (more info to come)
 
 596 #  - sort, order_by - sorting (more to come)
 
 597 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 598 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 600 sub get_warehouse_report {
 
 601   $main::lxdebug->enter_sub();
 
 606   my $myconfig  = \%main::myconfig;
 
 607   my $form      = $main::form;
 
 609   my $all_units = AM->retrieve_units($myconfig, $form);
 
 611   # connect to database
 
 612   my $dbh = $form->get_standard_dbh($myconfig);
 
 615   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 617   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 619   if ($filter{warehouse_id}) {
 
 620     push @wh_bin_filter_ary,  "w.id = ?";
 
 621     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 624   if ($filter{bin_id}) {
 
 625     push @wh_bin_filter_ary,  "b.id = ?";
 
 626     push @wh_bin_filter_vars, $filter{bin_id};
 
 629   push @filter_ary,  @wh_bin_filter_ary;
 
 630   push @filter_vars, @wh_bin_filter_vars;
 
 632   if ($filter{partnumber}) {
 
 633     push @filter_ary,  "p.partnumber ILIKE ?";
 
 634     push @filter_vars, '%' . $filter{partnumber} . '%';
 
 637   if ($filter{description}) {
 
 638     push @filter_ary,  "p.description ILIKE ?";
 
 639     push @filter_vars, '%' . $filter{description} . '%';
 
 642   if ($filter{partsid}) {
 
 643     push @filter_ary,  "p.id = ?";
 
 644     push @filter_vars, $filter{partsid};
 
 647   if ($filter{chargenumber}) {
 
 648     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 649     push @filter_vars, '%' . $filter{chargenumber} . '%';
 
 652   if ($form->{bestbefore}) {
 
 653     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 654     push @filter_vars, $form->{bestbefore};
 
 658     push @filter_ary,  "p.ean ILIKE ?";
 
 659     push @filter_vars, '%' . $filter{ean} . '%';
 
 663     push @filter_ary, "i.itime <= ?";
 
 664     push @filter_vars, $filter{date};
 
 666   if (!$filter{include_invalid_warehouses}){
 
 667     push @filter_ary,  "NOT (w.invalid)";
 
 670   # prepare qty comparison for later filtering
 
 671   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 673   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 674     $f_qty_op        = $filter{qty_op};
 
 675     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 676     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 679   map { $_ = "(${_})"; } @filter_ary;
 
 681   # if of a property number or description is requested,
 
 682   # automatically check the matching id too.
 
 683   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 685   # make order, search in $filter and $form
 
 686   my $sort_col    =  $form->{sort};
 
 687   my $sort_order  = $form->{order};
 
 689   $sort_col       =  $filter{sort}  unless $sort_col;
 
 690   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 691   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 692   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 693   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 694   # S.a. Bug 1597 jb 12.5.2011
 
 695   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 696   $sort_order     =  $filter{order} unless $sort_order;
 
 697   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 698   my $orderby     =  $sort_col;
 
 699   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 701   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 703   my %select_tokens = (
 
 704      "parts_id"              => "i.parts_id",
 
 705      "qty"                  => "SUM(i.qty)",
 
 706      "warehouseid"          => "i.warehouse_id",
 
 707      "partnumber"           => "p.partnumber",
 
 708      "partdescription"      => "p.description",
 
 709      "bindescription"       => "b.description",
 
 711      "chargenumber"         => "i.chargenumber",
 
 712      "bestbefore"           => "i.bestbefore",
 
 714      "chargeid"             => "c.id",
 
 715      "warehousedescription" => "w.description",
 
 716      "partunit"             => "p.unit",
 
 717      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 719   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 720         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 721           qw(l_parts_id l_qty l_partunit) );
 
 723   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 724         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 725           qw(l_parts_id l_partunit) );
 
 728     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 731   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 732         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 733           qw(l_parts_id l_qty l_partunit) );
 
 736     qq|SELECT $select_clause
 
 738       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 739       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 740       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 743       GROUP BY $group_clause
 
 744       ORDER BY $sort_spec|;
 
 746   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 748   my (%non_empty_bins, @all_fields, @contents);
 
 750   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 752     my $qty      = $ref->{qty};
 
 754     next unless ($qty != 0);
 
 757       my $part_unit = $all_units->{$ref->{partunit}};
 
 758       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 759       $qty *= $part_unit->{factor};
 
 760       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 761       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 762       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 765     if ($form->{include_empty_bins}) {
 
 766       $non_empty_bins{$ref->{binid}} = 1;
 
 767       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 770     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 772     push @contents, $ref;
 
 777   if ($form->{include_empty_bins}) {
 
 780            w.id AS warehouseid, w.description AS warehousedescription,
 
 781            b.id AS binid, b.description AS bindescription
 
 783          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 785     @filter_ary  = @wh_bin_filter_ary;
 
 786     @filter_vars = @wh_bin_filter_vars;
 
 788     my @non_empty_bin_ids = keys %non_empty_bins;
 
 789     if (@non_empty_bin_ids) {
 
 790       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 791       push @filter_vars, @non_empty_bin_ids;
 
 794     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 796     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 798     while (my $ref = $sth->fetchrow_hashref()) {
 
 799       map { $ref->{$_} ||= "" } @all_fields;
 
 800       push @contents, $ref;
 
 804     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 805       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 809   $main::lxdebug->leave_sub();
 
 815   $main::lxdebug->enter_sub();
 
 817   my ($self, $qty_op) = @_;
 
 819   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 820     $main::lxdebug->leave_sub();
 
 824   if ($qty_op eq "atleast") {
 
 826   } elsif ($qty_op eq "atmost") {
 
 832   $main::lxdebug->leave_sub();
 
 837 sub retrieve_transfer_types {
 
 838   $main::lxdebug->enter_sub();
 
 841   my $direction = shift;
 
 843   my $myconfig  = \%main::myconfig;
 
 844   my $form      = $main::form;
 
 846   my $dbh       = $form->get_standard_dbh($myconfig);
 
 848   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 850   $main::lxdebug->leave_sub();
 
 855 sub get_basic_bin_info {
 
 856   $main::lxdebug->enter_sub();
 
 861   Common::check_params(\%params, qw(id));
 
 863   my $myconfig = \%main::myconfig;
 
 864   my $form     = $main::form;
 
 866   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 868   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 871     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 872          w.id AS warehouse_id, w.description AS warehouse_description
 
 874        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 875        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 877   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 879   if ('' eq ref $params{id}) {
 
 880     $result = $result->[0] || { };
 
 881     $main::lxdebug->leave_sub();
 
 886   $main::lxdebug->leave_sub();
 
 888   return map { $_->{bin_id} => $_ } @{ $result };
 
 891 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 892 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 894 sub get_max_qty_parts {
 
 895 $main::lxdebug->enter_sub();
 
 900   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 902   my $myconfig = \%main::myconfig;
 
 903   my $form     = $main::form;
 
 905   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 907   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 909   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 911   my $max_qty_parts = 0; #Initialisierung mit 0
 
 912   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 913     $max_qty_parts += $ref->{sum};
 
 916   $main::lxdebug->leave_sub();
 
 918   return $max_qty_parts;
 
 922 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 923 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 925 sub get_part_description {
 
 926 $main::lxdebug->enter_sub();
 
 931   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 933   my $myconfig = \%main::myconfig;
 
 934   my $form     = $main::form;
 
 936   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 938   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 940   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 942   my $ref = $sth->fetchrow_hashref();
 
 943   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 945   $main::lxdebug->leave_sub();
 
 947   return $part_description;
 
 950 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 951 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 952 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 953 #           bei eingelagerten Teilen definiert sind.
 
 955 sub get_max_qty_parts_bin {
 
 956 $main::lxdebug->enter_sub();
 
 961   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 963   my $myconfig = \%main::myconfig;
 
 964   my $form     = $main::form;
 
 966   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 968   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 969                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 971   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 973   my $max_qty_parts = 0; #Initialisierung mit 0
 
 974   # falls derselbe artikel mehrmals eingelagert ist
 
 975   # chargennummer, muss entsprechend händisch agiert werden
 
 978   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 979     $max_qty_parts += $ref->{sum};
 
 981     if ($ref->{chargenumber} || $ref->{bestbefore}){
 
 989   $main::lxdebug->leave_sub();
 
 991   return ($max_qty_parts, $error);
 
1000 SL::WH - Warehouse backend
 
1005   WH->transfer(\%params);
 
1009 Backend for lx-office warehousing functions.
 
1013 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1015 This is the main function to manipulate warehouse contents. A typical transfer
 
1016 is called like this:
 
1021     transfer_type    => 'transfer',
 
1022     src_warehouse_id => 12,
 
1024     dst_warehouse_id => 25,
 
1028 It will generate an entry in inventory representing the transfer. Note that
 
1029 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1030 a destination or a src is mandatory.
 
1032 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1033 more than one is supplied, it is guaranteed, that all are processed in the same
 
1036 Here is a full list of parameters. All "_id" parameters except oe and
 
1037 orderitems can be called without id with RDB objects as well.
 
1043 The id of the article transferred. Does not check if the article is a service.
 
1048 Quantity of the transaction.  Mandatory.
 
1052 Unit of the transaction. Optional.
 
1056 =item transfer_type_id
 
1058 The type of transaction. The first version is a string describing the
 
1059 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1060 every system), the id is the hard id of a transfer_type from the database.
 
1062 Depending of the direction of the transfer_type, source and/or destination must
 
1065 One of transfer_type or transfer_type_id is mandatory.
 
1067 =item src_warehouse_id
 
1071 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1072 directions. Ignored in in directions.
 
1074 =item dst_warehouse_id
 
1078 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1079 directions. Ignored in out directions.
 
1083 If given, the transfer will transfer only articles with this chargenumber.
 
1088 Reference to an orderitem for which this transfer happened. Optional
 
1092 Reference to an order for which this transfer happened. Optional
 
1096 An optional comment.
 
1100 An expiration date. Note that this is not by default used by C<warehouse_report>.