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           $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
 
 144       push @trans_ids, $trans_id;
 
 149     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
 
 152   $::lxdebug->leave_sub;
 
 157 sub transfer_assembly {
 
 158   $main::lxdebug->enter_sub();
 
 162   Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
 
 165   my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
 
 167     my $assembly = SL::DB::Manager::Assembly->get_all(
 
 168       query => [ id => $params{assembly_id} ],
 
 169       with_objects => ['part'],
 
 172     $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
 
 175 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
 
 177   my $myconfig = \%main::myconfig;
 
 178   my $form     = $main::form;
 
 179   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 
 184   # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
 
 185   # select parts_id,qty from assembly where id=1064;
 
 186   # Erweiterung für bug 935 am 23.4.09 -
 
 187   # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
 
 188   # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 189   # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
 
 191   # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
 
 192   # wenn assembly nicht überprüft wird ...
 
 193   # patch von joachim eingespielt 24.4.2009:
 
 194   # my $query    = qq|select parts_id,qty from assembly inner join parts
 
 195   # on assembly.parts_id = parts.id  where assembly.id = ? and
 
 196   # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 199   my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 200                   where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 202   my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
 
 204   # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
 
 205   my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
 
 206                            VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 207                            (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
 
 208   my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
 
 210   # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
 
 212   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
 
 213   my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
 
 214   while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
 
 215     $schleife_durchlaufen=1;  # Erzeugnis definiert
 
 216     my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
 
 217     my $currentPart_ID = $hash_ref->{parts_id};
 
 219     # Überprüfen, ob diese Anzahl gefertigt werden kann
 
 220     my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
 
 221                                              warehouse_id => $params{dst_warehouse_id});
 
 223     if ($partsQTY  > $max_parts){
 
 224       # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
 
 225       # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
 
 227       $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
 
 228                             " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
 
 229                             ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
 
 230       next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
 
 233     # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
 
 234     # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
 
 235     # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
 
 236     # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
 
 237     # und lösen den Rest dann so wie bei xplace im Barcode-Programm
 
 238     # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
 
 240     my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
 
 241                        WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
 
 242     my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
 
 244     # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
 
 245     my $tmpPartsQTY = $partsQTY;
 
 247     while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
 
 248       my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
 
 249       my $temppart_chargenumber = $temphash_ref->{chargenumber};
 
 250       my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
 
 251       my $temppart_qty          = $temphash_ref->{sum};
 
 253       if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
 
 254                                            # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
 
 255         $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
 
 256         $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
 
 257                                             # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
 
 258                                             # Dieser Wert IST und BLEIBT positiv!! Hilfe.
 
 259                                             # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
 
 260         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 261                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 262                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
 
 264         # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
 
 265         # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
 
 266         # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
 
 267         # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
 
 268       } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
 
 270         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 271                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 272                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
 
 273         last; # beendet die schleife (springt zum letzten element)
 
 275     }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
 
 276   } #ende while select parts_id,qty from assembly where id = ?
 
 278   if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
 
 279                                   # keine einzelteile definiert
 
 280       $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
 
 281                            Dementsprechend kann auch nichts hergestellt werden";
 
 283   # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
 
 284   #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
 
 285   if ($kannNichtFertigen) {
 
 286     return $kannNichtFertigen;
 
 289   # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
 
 290   my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
 
 291                                                       comment, employee_id, qty, trans_id, trans_type_id)
 
 292                                VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 293                                (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
 
 294   my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
 
 295   do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
 
 296                $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
 
 299   $main::lxdebug->leave_sub();
 
 300   return 1; # Alles erfolgreich
 
 303 sub get_warehouse_journal {
 
 304   $main::lxdebug->enter_sub();
 
 309   my $myconfig  = \%main::myconfig;
 
 310   my $form      = $main::form;
 
 312   my $all_units = AM->retrieve_units($myconfig, $form);
 
 314   # connect to database
 
 315   my $dbh = $form->get_standard_dbh($myconfig);
 
 318   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 320   if ($filter{warehouse_id}) {
 
 321     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 322     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 325   if ($filter{bin_id}) {
 
 326     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 327     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 330   if ($filter{partnumber}) {
 
 331     push @filter_ary, "p.partnumber ILIKE ?";
 
 332     push @filter_vars, '%' . $filter{partnumber} . '%';
 
 335   if ($filter{description}) {
 
 336     push @filter_ary, "(p.description ILIKE ?)";
 
 337     push @filter_vars, '%' . $filter{description} . '%';
 
 340   if ($filter{chargenumber}) {
 
 341     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 342     push @filter_vars, '%' . $filter{chargenumber} . '%';
 
 345   if ($form->{bestbefore}) {
 
 346     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 347     push @filter_vars, $form->{bestbefore};
 
 350   if ($form->{fromdate}) {
 
 351     push @filter_ary, "?::DATE <= i1.itime::DATE";
 
 352     push @filter_vars, $form->{fromdate};
 
 355   if ($form->{todate}) {
 
 356     push @filter_ary, "?::DATE >= i1.itime::DATE";
 
 357     push @filter_vars, $form->{todate};
 
 360   if ($form->{l_employee}) {
 
 364   # prepare qty comparison for later filtering
 
 365   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 366   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 367     $f_qty_op        = $filter{qty_op};
 
 368     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 369     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 372   map { $_ = "(${_})"; } @filter_ary;
 
 374   # if of a property number or description is requested,
 
 375   # automatically check the matching id too.
 
 376   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 378   # customize shown entry for not available fields.
 
 379   $filter{na} = '-' unless $filter{na};
 
 381   # make order, search in $filter and $form
 
 382   my $sort_col   = $form->{sort};
 
 383   my $sort_order = $form->{order};
 
 385   $sort_col      = $filter{sort}         unless $sort_col;
 
 386   $sort_order    = ($sort_col = 'itime') unless $sort_col;
 
 387   $sort_col      = 'itime'               if     $sort_col eq 'date';
 
 388   $sort_order    = $filter{order}        unless $sort_order;
 
 389   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 391   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 393   $select_tokens{'trans'} = {
 
 394      "parts_id"             => "i1.parts_id",
 
 395      "qty"                  => "ABS(SUM(i1.qty))",
 
 396      "partnumber"           => "p.partnumber",
 
 397      "partdescription"      => "p.description",
 
 398      "bindescription"       => "b.description",
 
 399      "chargenumber"         => "i1.chargenumber",
 
 400      "bestbefore"           => "i1.bestbefore",
 
 401      "warehousedescription" => "w.description",
 
 402      "partunit"             => "p.unit",
 
 403      "bin_from"             => "b1.description",
 
 404      "bin_to"               => "b2.description",
 
 405      "warehouse_from"       => "w1.description",
 
 406      "warehouse_to"         => "w2.description",
 
 407      "comment"              => "i1.comment",
 
 408      "trans_type"           => "tt.description",
 
 409      "trans_id"             => "i1.trans_id",
 
 410      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 
 411      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 
 412      "date"                 => "i1.itime::DATE",
 
 413      "itime"                => "i1.itime",
 
 414      "employee"             => "e.name",
 
 415      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 
 418   $select_tokens{'out'} = {
 
 419      "bin_to"               => "'$filter{na}'",
 
 420      "warehouse_to"         => "'$filter{na}'",
 
 423   $select_tokens{'in'} = {
 
 424      "bin_from"             => "'$filter{na}'",
 
 425      "warehouse_from"       => "'$filter{na}'",
 
 428   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
 
 430   # build the select clauses.
 
 431   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 
 432   for my $i ('trans', 'out', 'in') {
 
 433     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 
 434           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
 
 437   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 
 438         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
 
 440   $where_clause = defined($where_clause) ? $where_clause : '';
 
 442   qq|SELECT DISTINCT $select{trans}
 
 444     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 445     LEFT JOIN parts p ON i1.parts_id = p.id
 
 446     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 447     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 448     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 449     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 450     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 451     LEFT JOIN project pr ON i1.project_id = pr.id
 
 452     LEFT JOIN employee e ON i1.employee_id = e.id
 
 453     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 454           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 455     GROUP BY $group_clause
 
 459     SELECT DISTINCT $select{out}
 
 461     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 462     LEFT JOIN parts p ON i1.parts_id = p.id
 
 463     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 464     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 465     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 466     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 467     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 468     LEFT JOIN project pr ON i1.project_id = pr.id
 
 469     LEFT JOIN employee e ON i1.employee_id = e.id
 
 470     WHERE $where_clause i1.qty < 0 AND
 
 471           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 472     GROUP BY $group_clause
 
 476     SELECT DISTINCT $select{in}
 
 478     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 479     LEFT JOIN parts p ON i1.parts_id = p.id
 
 480     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 481     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 482     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 483     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 484     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 485     LEFT JOIN project pr ON i1.project_id = pr.id
 
 486     LEFT JOIN employee e ON i1.employee_id = e.id
 
 487     WHERE $where_clause i1.qty > 0 AND
 
 488           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 489     GROUP BY $group_clause
 
 490     ORDER BY r_${sort_spec}|;
 
 492   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 494   my ($h_oe_id, $q_oe_id);
 
 495   if ($form->{l_oe_id}) {
 
 498         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 500           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 501           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 502           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 503           ELSE                                                                       'purchase_order'
 
 510       SELECT dord.id AS id, dord.donumber AS number,
 
 512           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 513           ELSE                               'sales_delivery_order'
 
 515       FROM delivery_orders dord
 
 520       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 526       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 532       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 534       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 538       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 540       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 542     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 546   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 547     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 548     my $qty = $ref->{"qty"} * 1;
 
 550     next unless ($qty > 0);
 
 553       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 554       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 555       $qty *= $part_unit->{"factor"};
 
 556       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 557       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 558       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 561     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 
 562       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
 
 563       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
 
 564       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 567     push @contents, $ref;
 
 571   $h_oe_id->finish() if $h_oe_id;
 
 573   $main::lxdebug->leave_sub();
 
 579 # This sub is the primary function to retrieve information about items in warehouses.
 
 580 # $filter is a hashref and supports the following keys:
 
 581 #  - warehouse_id - will return matches with this warehouse_id only
 
 582 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 583 #  - partsid      - will return matches with this parts_id only
 
 584 #  - description  - will return only matches where the given string is a substring of the description
 
 585 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 586 #  - bestbefore   - will return only matches with this bestbefore date
 
 587 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 588 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 589 #  - expires_in   - will only return matches that expire within the given number of days
 
 590 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 591 #  - hazardous    - will return matches with the flag hazardous only
 
 592 #  - oil          - will return matches with the flag oil only
 
 593 #  - qty, qty_op  - quantity filter (more info to come)
 
 594 #  - sort, order_by - sorting (more to come)
 
 595 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 596 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 598 sub get_warehouse_report {
 
 599   $main::lxdebug->enter_sub();
 
 604   my $myconfig  = \%main::myconfig;
 
 605   my $form      = $main::form;
 
 607   my $all_units = AM->retrieve_units($myconfig, $form);
 
 609   # connect to database
 
 610   my $dbh = $form->get_standard_dbh($myconfig);
 
 613   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 615   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 617   if ($filter{warehouse_id}) {
 
 618     push @wh_bin_filter_ary,  "w.id = ?";
 
 619     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 622   if ($filter{bin_id}) {
 
 623     push @wh_bin_filter_ary,  "b.id = ?";
 
 624     push @wh_bin_filter_vars, $filter{bin_id};
 
 627   push @filter_ary,  @wh_bin_filter_ary;
 
 628   push @filter_vars, @wh_bin_filter_vars;
 
 630   if ($filter{partnumber}) {
 
 631     push @filter_ary,  "p.partnumber ILIKE ?";
 
 632     push @filter_vars, '%' . $filter{partnumber} . '%';
 
 635   if ($filter{description}) {
 
 636     push @filter_ary,  "p.description ILIKE ?";
 
 637     push @filter_vars, '%' . $filter{description} . '%';
 
 640   if ($filter{partsid}) {
 
 641     push @filter_ary,  "p.id = ?";
 
 642     push @filter_vars, $filter{partsid};
 
 645   if ($filter{chargenumber}) {
 
 646     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 647     push @filter_vars, '%' . $filter{chargenumber} . '%';
 
 650   if ($form->{bestbefore}) {
 
 651     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 652     push @filter_vars, $form->{bestbefore};
 
 656     push @filter_ary,  "p.ean ILIKE ?";
 
 657     push @filter_vars, '%' . $filter{ean} . '%';
 
 661     push @filter_ary, "i.itime <= ?";
 
 662     push @filter_vars, $filter{date};
 
 664   if (!$filter{include_invalid_warehouses}){
 
 665     push @filter_ary,  "NOT (w.invalid)";
 
 668   # prepare qty comparison for later filtering
 
 669   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 671   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 672     $f_qty_op        = $filter{qty_op};
 
 673     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 674     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 677   map { $_ = "(${_})"; } @filter_ary;
 
 679   # if of a property number or description is requested,
 
 680   # automatically check the matching id too.
 
 681   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 683   # make order, search in $filter and $form
 
 684   my $sort_col    =  $form->{sort};
 
 685   my $sort_order  = $form->{order};
 
 687   $sort_col       =  $filter{sort}  unless $sort_col;
 
 688   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 689   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 690   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 691   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 692   # S.a. Bug 1597 jb 12.5.2011
 
 693   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 694   $sort_order     =  $filter{order} unless $sort_order;
 
 695   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 696   my $orderby     =  $sort_col;
 
 697   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 699   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 701   my %select_tokens = (
 
 702      "parts_id"              => "i.parts_id",
 
 703      "qty"                  => "SUM(i.qty)",
 
 704      "warehouseid"          => "i.warehouse_id",
 
 705      "partnumber"           => "p.partnumber",
 
 706      "partdescription"      => "p.description",
 
 707      "bindescription"       => "b.description",
 
 709      "chargenumber"         => "i.chargenumber",
 
 710      "bestbefore"           => "i.bestbefore",
 
 712      "chargeid"             => "c.id",
 
 713      "warehousedescription" => "w.description",
 
 714      "partunit"             => "p.unit",
 
 715      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 717   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 718         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 719           qw(l_parts_id l_qty l_partunit) );
 
 721   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 722         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 723           qw(l_parts_id l_partunit) );
 
 726     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 729   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 730         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 731           qw(l_parts_id l_qty l_partunit) );
 
 734     qq|SELECT $select_clause
 
 736       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 737       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 738       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 741       GROUP BY $group_clause
 
 742       ORDER BY $sort_spec|;
 
 744   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 746   my (%non_empty_bins, @all_fields, @contents);
 
 748   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 750     my $qty      = $ref->{qty};
 
 752     next unless ($qty != 0);
 
 755       my $part_unit = $all_units->{$ref->{partunit}};
 
 756       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 757       $qty *= $part_unit->{factor};
 
 758       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 759       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 760       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 763     if ($form->{include_empty_bins}) {
 
 764       $non_empty_bins{$ref->{binid}} = 1;
 
 765       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 768     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 770     push @contents, $ref;
 
 775   if ($form->{include_empty_bins}) {
 
 778            w.id AS warehouseid, w.description AS warehousedescription,
 
 779            b.id AS binid, b.description AS bindescription
 
 781          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 783     @filter_ary  = @wh_bin_filter_ary;
 
 784     @filter_vars = @wh_bin_filter_vars;
 
 786     my @non_empty_bin_ids = keys %non_empty_bins;
 
 787     if (@non_empty_bin_ids) {
 
 788       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 789       push @filter_vars, @non_empty_bin_ids;
 
 792     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 794     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 796     while (my $ref = $sth->fetchrow_hashref()) {
 
 797       map { $ref->{$_} ||= "" } @all_fields;
 
 798       push @contents, $ref;
 
 802     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 803       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 807   $main::lxdebug->leave_sub();
 
 813   $main::lxdebug->enter_sub();
 
 815   my ($self, $qty_op) = @_;
 
 817   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 818     $main::lxdebug->leave_sub();
 
 822   if ($qty_op eq "atleast") {
 
 824   } elsif ($qty_op eq "atmost") {
 
 830   $main::lxdebug->leave_sub();
 
 835 sub retrieve_transfer_types {
 
 836   $main::lxdebug->enter_sub();
 
 839   my $direction = shift;
 
 841   my $myconfig  = \%main::myconfig;
 
 842   my $form      = $main::form;
 
 844   my $dbh       = $form->get_standard_dbh($myconfig);
 
 846   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 848   $main::lxdebug->leave_sub();
 
 853 sub get_basic_bin_info {
 
 854   $main::lxdebug->enter_sub();
 
 859   Common::check_params(\%params, qw(id));
 
 861   my $myconfig = \%main::myconfig;
 
 862   my $form     = $main::form;
 
 864   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 866   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 869     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 870          w.id AS warehouse_id, w.description AS warehouse_description
 
 872        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 873        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 875   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 877   if ('' eq ref $params{id}) {
 
 878     $result = $result->[0] || { };
 
 879     $main::lxdebug->leave_sub();
 
 884   $main::lxdebug->leave_sub();
 
 886   return map { $_->{bin_id} => $_ } @{ $result };
 
 889 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 890 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 892 sub get_max_qty_parts {
 
 893 $main::lxdebug->enter_sub();
 
 898   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 900   my $myconfig = \%main::myconfig;
 
 901   my $form     = $main::form;
 
 903   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 905   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 907   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 909   my $max_qty_parts = 0; #Initialisierung mit 0
 
 910   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 911     $max_qty_parts += $ref->{sum};
 
 914   $main::lxdebug->leave_sub();
 
 916   return $max_qty_parts;
 
 920 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 921 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 923 sub get_part_description {
 
 924 $main::lxdebug->enter_sub();
 
 929   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 931   my $myconfig = \%main::myconfig;
 
 932   my $form     = $main::form;
 
 934   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 936   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 938   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 940   my $ref = $sth->fetchrow_hashref();
 
 941   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 943   $main::lxdebug->leave_sub();
 
 945   return $part_description;
 
 948 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 949 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 950 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 951 #           bei eingelagerten Teilen definiert sind.
 
 953 sub get_max_qty_parts_bin {
 
 954 $main::lxdebug->enter_sub();
 
 959   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 961   my $myconfig = \%main::myconfig;
 
 962   my $form     = $main::form;
 
 964   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 966   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 967                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 969   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 971   my $max_qty_parts = 0; #Initialisierung mit 0
 
 972   # falls derselbe artikel mehrmals eingelagert ist
 
 973   # chargennummer, muss entsprechend händisch agiert werden
 
 976   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 977     $max_qty_parts += $ref->{sum};
 
 979     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
 
 987   $main::lxdebug->leave_sub();
 
 989   return ($max_qty_parts, $error);
 
 998 SL::WH - Warehouse backend
 
1003   WH->transfer(\%params);
 
1007 Backend for lx-office warehousing functions.
 
1011 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1013 This is the main function to manipulate warehouse contents. A typical transfer
 
1014 is called like this:
 
1019     transfer_type    => 'transfer',
 
1020     src_warehouse_id => 12,
 
1022     dst_warehouse_id => 25,
 
1026 It will generate an entry in inventory representing the transfer. Note that
 
1027 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1028 a destination or a src is mandatory.
 
1030 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1031 more than one is supplied, it is guaranteed, that all are processed in the same
 
1034 Here is a full list of parameters. All "_id" parameters except oe and
 
1035 orderitems can be called without id with RDB objects as well.
 
1041 The id of the article transferred. Does not check if the article is a service.
 
1046 Quantity of the transaction.  Mandatory.
 
1050 Unit of the transaction. Optional.
 
1054 =item transfer_type_id
 
1056 The type of transaction. The first version is a string describing the
 
1057 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1058 every system), the id is the hard id of a transfer_type from the database.
 
1060 Depending of the direction of the transfer_type, source and/or destination must
 
1063 One of transfer_type or transfer_type_id is mandatory.
 
1065 =item src_warehouse_id
 
1069 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1070 directions. Ignored in in directions.
 
1072 =item dst_warehouse_id
 
1076 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1077 directions. Ignored in out directions.
 
1081 If given, the transfer will transfer only articles with this chargenumber.
 
1086 Reference to an orderitem for which this transfer happened. Optional
 
1090 Reference to an order for which this transfer happened. Optional
 
1094 An optional comment.
 
1098 An expiration date. Note that this is not by default used by C<warehouse_report>.