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 => $::form->{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      "date"                 => "i1.itime::DATE",
 
 414      "itime"                => "i1.itime",
 
 415      "employee"             => "e.name",
 
 416      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 
 419   $select_tokens{'out'} = {
 
 420      "bin_to"               => "'$filter{na}'",
 
 421      "warehouse_to"         => "'$filter{na}'",
 
 424   $select_tokens{'in'} = {
 
 425      "bin_from"             => "'$filter{na}'",
 
 426      "warehouse_from"       => "'$filter{na}'",
 
 429   # build the select clauses.
 
 430   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 
 431   for my $i ('trans', 'out', 'in') {
 
 432     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 
 433           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
 
 436   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 
 437         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
 
 439   $where_clause = defined($where_clause) ? $where_clause : '';
 
 441   qq|SELECT DISTINCT $select{trans}
 
 443     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 444     LEFT JOIN parts p ON i1.parts_id = p.id
 
 445     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 446     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 447     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 448     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 449     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 450     LEFT JOIN project pr ON i1.project_id = pr.id
 
 451     LEFT JOIN employee e ON i1.employee_id = e.id
 
 452     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 453           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 454     GROUP BY $group_clause
 
 458     SELECT DISTINCT $select{out}
 
 460     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 461     LEFT JOIN parts p ON i1.parts_id = p.id
 
 462     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 463     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 464     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 465     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 466     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 467     LEFT JOIN project pr ON i1.project_id = pr.id
 
 468     LEFT JOIN employee e ON i1.employee_id = e.id
 
 469     WHERE $where_clause i1.qty < 0 AND
 
 470           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 471     GROUP BY $group_clause
 
 475     SELECT DISTINCT $select{in}
 
 477     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 478     LEFT JOIN parts p ON i1.parts_id = p.id
 
 479     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 480     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 481     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 482     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 483     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 484     LEFT JOIN project pr ON i1.project_id = pr.id
 
 485     LEFT JOIN employee e ON i1.employee_id = e.id
 
 486     WHERE $where_clause i1.qty > 0 AND
 
 487           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 488     GROUP BY $group_clause
 
 489     ORDER BY r_${sort_spec}|;
 
 491   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 493   my ($h_oe_id, $q_oe_id);
 
 494   if ($form->{l_oe_id}) {
 
 497         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 499           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 500           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 501           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 502           ELSE                                                                       'purchase_order'
 
 509       SELECT dord.id AS id, dord.donumber AS number,
 
 511           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 512           ELSE                               'sales_delivery_order'
 
 514       FROM delivery_orders dord
 
 519       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 525       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 529     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 533   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 534     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 535     my $qty = $ref->{"qty"} * 1;
 
 537     next unless ($qty > 0);
 
 540       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 541       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 542       $qty *= $part_unit->{"factor"};
 
 543       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 544       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 545       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 548     if ($h_oe_id && $ref->{oe_id}) {
 
 549       do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
 
 550       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 553     push @contents, $ref;
 
 557   $h_oe_id->finish() if $h_oe_id;
 
 559   $main::lxdebug->leave_sub();
 
 565 # This sub is the primary function to retrieve information about items in warehouses.
 
 566 # $filter is a hashref and supports the following keys:
 
 567 #  - warehouse_id - will return matches with this warehouse_id only
 
 568 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 569 #  - partsid      - will return matches with this parts_id only
 
 570 #  - description  - will return only matches where the given string is a substring of the description
 
 571 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 572 #  - bestbefore   - will return only matches with this bestbefore date
 
 573 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 574 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 575 #  - expires_in   - will only return matches that expire within the given number of days
 
 576 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 577 #  - hazardous    - will return matches with the flag hazardous only
 
 578 #  - oil          - will return matches with the flag oil only
 
 579 #  - qty, qty_op  - quantity filter (more info to come)
 
 580 #  - sort, order_by - sorting (more to come)
 
 581 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 582 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 584 sub get_warehouse_report {
 
 585   $main::lxdebug->enter_sub();
 
 590   my $myconfig  = \%main::myconfig;
 
 591   my $form      = $main::form;
 
 593   my $all_units = AM->retrieve_units($myconfig, $form);
 
 595   # connect to database
 
 596   my $dbh = $form->get_standard_dbh($myconfig);
 
 599   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 601   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 603   if ($filter{warehouse_id}) {
 
 604     push @wh_bin_filter_ary,  "w.id = ?";
 
 605     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 608   if ($filter{bin_id}) {
 
 609     push @wh_bin_filter_ary,  "b.id = ?";
 
 610     push @wh_bin_filter_vars, $filter{bin_id};
 
 613   push @filter_ary,  @wh_bin_filter_ary;
 
 614   push @filter_vars, @wh_bin_filter_vars;
 
 616   if ($filter{partnumber}) {
 
 617     push @filter_ary,  "p.partnumber ILIKE ?";
 
 618     push @filter_vars, '%' . $filter{partnumber} . '%';
 
 621   if ($filter{description}) {
 
 622     push @filter_ary,  "p.description ILIKE ?";
 
 623     push @filter_vars, '%' . $filter{description} . '%';
 
 626   if ($filter{partsid}) {
 
 627     push @filter_ary,  "p.id = ?";
 
 628     push @filter_vars, $filter{partsid};
 
 631   if ($filter{chargenumber}) {
 
 632     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 633     push @filter_vars, '%' . $filter{chargenumber} . '%';
 
 636   if ($form->{bestbefore}) {
 
 637     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 638     push @filter_vars, $form->{bestbefore};
 
 642     push @filter_ary,  "p.ean ILIKE ?";
 
 643     push @filter_vars, '%' . $filter{ean} . '%';
 
 647     push @filter_ary, "i.itime <= ?";
 
 648     push @filter_vars, $filter{date};
 
 650   if (!$filter{include_invalid_warehouses}){
 
 651     push @filter_ary,  "NOT (w.invalid)";
 
 654   # prepare qty comparison for later filtering
 
 655   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 657   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 658     $f_qty_op        = $filter{qty_op};
 
 659     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 660     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 663   map { $_ = "(${_})"; } @filter_ary;
 
 665   # if of a property number or description is requested,
 
 666   # automatically check the matching id too.
 
 667   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 669   # make order, search in $filter and $form
 
 670   my $sort_col    =  $form->{sort};
 
 671   my $sort_order  = $form->{order};
 
 673   $sort_col       =  $filter{sort}  unless $sort_col;
 
 674   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 675   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 676   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 677   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 678   # S.a. Bug 1597 jb 12.5.2011
 
 679   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 680   $sort_order     =  $filter{order} unless $sort_order;
 
 681   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 682   my $orderby     =  $sort_col;
 
 683   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 685   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 687   my %select_tokens = (
 
 688      "parts_id"              => "i.parts_id",
 
 689      "qty"                  => "SUM(i.qty)",
 
 690      "warehouseid"          => "i.warehouse_id",
 
 691      "partnumber"           => "p.partnumber",
 
 692      "partdescription"      => "p.description",
 
 693      "bindescription"       => "b.description",
 
 695      "chargenumber"         => "i.chargenumber",
 
 696      "bestbefore"           => "i.bestbefore",
 
 698      "chargeid"             => "c.id",
 
 699      "warehousedescription" => "w.description",
 
 700      "partunit"             => "p.unit",
 
 701      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 703   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 704         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 705           qw(l_parts_id l_qty l_partunit) );
 
 707   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 708         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 709           qw(l_parts_id l_partunit) );
 
 712     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 715   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 716         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 717           qw(l_parts_id l_qty l_partunit) );
 
 720     qq|SELECT $select_clause
 
 722       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 723       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 724       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 727       GROUP BY $group_clause
 
 728       ORDER BY $sort_spec|;
 
 730   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 732   my (%non_empty_bins, @all_fields, @contents);
 
 734   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 736     my $qty      = $ref->{qty};
 
 738     next unless ($qty != 0);
 
 741       my $part_unit = $all_units->{$ref->{partunit}};
 
 742       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 743       $qty *= $part_unit->{factor};
 
 744       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 745       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 746       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 749     if ($form->{include_empty_bins}) {
 
 750       $non_empty_bins{$ref->{binid}} = 1;
 
 751       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 754     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 756     push @contents, $ref;
 
 761   if ($form->{include_empty_bins}) {
 
 764            w.id AS warehouseid, w.description AS warehousedescription,
 
 765            b.id AS binid, b.description AS bindescription
 
 767          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 769     @filter_ary  = @wh_bin_filter_ary;
 
 770     @filter_vars = @wh_bin_filter_vars;
 
 772     my @non_empty_bin_ids = keys %non_empty_bins;
 
 773     if (@non_empty_bin_ids) {
 
 774       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 775       push @filter_vars, @non_empty_bin_ids;
 
 778     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 780     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 782     while (my $ref = $sth->fetchrow_hashref()) {
 
 783       map { $ref->{$_} ||= "" } @all_fields;
 
 784       push @contents, $ref;
 
 788     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 789       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 793   $main::lxdebug->leave_sub();
 
 799   $main::lxdebug->enter_sub();
 
 801   my ($self, $qty_op) = @_;
 
 803   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 804     $main::lxdebug->leave_sub();
 
 808   if ($qty_op eq "atleast") {
 
 810   } elsif ($qty_op eq "atmost") {
 
 816   $main::lxdebug->leave_sub();
 
 821 sub retrieve_transfer_types {
 
 822   $main::lxdebug->enter_sub();
 
 825   my $direction = shift;
 
 827   my $myconfig  = \%main::myconfig;
 
 828   my $form      = $main::form;
 
 830   my $dbh       = $form->get_standard_dbh($myconfig);
 
 832   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 834   $main::lxdebug->leave_sub();
 
 839 sub get_basic_bin_info {
 
 840   $main::lxdebug->enter_sub();
 
 845   Common::check_params(\%params, qw(id));
 
 847   my $myconfig = \%main::myconfig;
 
 848   my $form     = $main::form;
 
 850   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 852   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 855     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 856          w.id AS warehouse_id, w.description AS warehouse_description
 
 858        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 859        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 861   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 863   if ('' eq ref $params{id}) {
 
 864     $result = $result->[0] || { };
 
 865     $main::lxdebug->leave_sub();
 
 870   $main::lxdebug->leave_sub();
 
 872   return map { $_->{bin_id} => $_ } @{ $result };
 
 875 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 876 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 878 sub get_max_qty_parts {
 
 879 $main::lxdebug->enter_sub();
 
 884   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 886   my $myconfig = \%main::myconfig;
 
 887   my $form     = $main::form;
 
 889   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 891   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 893   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 895   my $max_qty_parts = 0; #Initialisierung mit 0
 
 896   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 897     $max_qty_parts += $ref->{sum};
 
 900   $main::lxdebug->leave_sub();
 
 902   return $max_qty_parts;
 
 906 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 907 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 909 sub get_part_description {
 
 910 $main::lxdebug->enter_sub();
 
 915   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 917   my $myconfig = \%main::myconfig;
 
 918   my $form     = $main::form;
 
 920   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 922   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 924   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 926   my $ref = $sth->fetchrow_hashref();
 
 927   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 929   $main::lxdebug->leave_sub();
 
 931   return $part_description;
 
 934 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 935 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 936 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 937 #           bei eingelagerten Teilen definiert sind.
 
 939 sub get_max_qty_parts_bin {
 
 940 $main::lxdebug->enter_sub();
 
 945   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 947   my $myconfig = \%main::myconfig;
 
 948   my $form     = $main::form;
 
 950   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 952   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 953                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 955   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 957   my $max_qty_parts = 0; #Initialisierung mit 0
 
 958   # falls derselbe artikel mehrmals eingelagert ist
 
 959   # chargennummer, muss entsprechend händisch agiert werden
 
 962   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 963     $max_qty_parts += $ref->{sum};
 
 965     if ($ref->{chargenumber} || $ref->{bestbefore}){
 
 973   $main::lxdebug->leave_sub();
 
 975   return ($max_qty_parts, $error);
 
 984 SL::WH - Warehouse backend
 
 989   WH->transfer(\%params);
 
 993 Backend for lx-office warehousing functions.
 
 997 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
 999 This is the main function to manipulate warehouse contents. A typical transfer
 
1000 is called like this:
 
1005     transfer_type    => 'transfer',
 
1006     src_warehouse_id => 12,
 
1008     dst_warehouse_id => 25,
 
1012 It will generate an entry in inventory representing the transfer. Note that
 
1013 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1014 a destination or a src is mandatory.
 
1016 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1017 more than one is supplied, it is guaranteed, that all are processed in the same
 
1020 Here is a full list of parameters. All "_id" parameters except oe and
 
1021 orderitems can be called without id with RDB objects as well.
 
1027 The id of the article transferred. Does not check if the article is a service.
 
1032 Quantity of the transaction.  Mandatory.
 
1036 Unit of the transaction. Optional.
 
1040 =item transfer_type_id
 
1042 The type of transaction. The first version is a string describing the
 
1043 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1044 every system), the id is the hard id of a transfer_type from the database.
 
1046 Depending of the direction of the transfer_type, source and/or destination must
 
1049 One of transfer_type or transfer_type_id is mandatory.
 
1051 =item src_warehouse_id
 
1055 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1056 directions. Ignored in in directions.
 
1058 =item dst_warehouse_id
 
1062 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1063 directions. Ignored in out directions.
 
1067 If given, the transfer will transfer only articles with this chargenumber.
 
1072 Reference to an orderitem for which this transfer happened. Optional
 
1076 Reference to an order for which this transfer happened. Optional
 
1080 An optional comment.
 
1084 An expiration date. Note that this is not by default used by C<warehouse_report>.