1 #====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #=====================================================================
 
   8 # SQL-Ledger Accounting
 
   9 # Copyright (C) 1999-2003
 
  11 #  Author: Dieter Simader
 
  12 #   Email: dsimader@sql-ledger.org
 
  13 #     Web: http://www.sql-ledger.org
 
  17 # This program is free software; you can redistribute it and/or modify
 
  18 # it under the terms of the GNU General Public License as published by
 
  19 # the Free Software Foundation; either version 2 of the License, or
 
  20 # (at your option) any later version.
 
  22 # This program is distributed in the hope that it will be useful,
 
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
  25 # GNU General Public License for more details.
 
  26 # You should have received a copy of the GNU General Public License
 
  27 # along with this program; if not, write to the Free Software
 
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
  29 #======================================================================
 
  33 #======================================================================
 
  40 use SL::Util qw(trim);
 
  46   $::lxdebug->enter_sub;
 
  48   my ($self, @args) = @_;
 
  51     $::lxdebug->leave_sub;
 
  55   require SL::DB::TransferType;
 
  57   require SL::DB::Employee;
 
  58   require SL::DB::Inventory;
 
  60   my $employee   = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
 
  61   my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
 
  62   my @directions = (undef, qw(out in transfer));
 
  65     my ($transfer, $field, $class, @find_by) = @_;
 
  67     @find_by = (description => $transfer->{$field}) unless @find_by;
 
  69     if ($transfer->{$field} || $transfer->{"${field}_id"}) {
 
  70       return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
 
  71            : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
 
  72            : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
 
  79   my $db = SL::DB::Inventory->new->db;
 
  80   $db->with_transaction(sub{
 
  81     while (my $transfer = shift @args) {
 
  82       my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
 
  84       my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
 
  85       my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
 
  86       my $qty           = $transfer->{qty};
 
  87       my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
 
  88       my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
 
  89       my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
 
  90       my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
 
  91       my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
 
  93       $src_wh ||= $src_bin->warehouse if $src_bin;
 
  94       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
 
  96       my $direction = 0; # bit mask
 
  97       $direction |= 1 if $src_bin;
 
  98       $direction |= 2 if $dst_bin;
 
 100       my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
 
 101                                                                                            description => $transfer->{transfer_type});
 
 105           employee         => $employee,
 
 106           trans_type       => $transfer_type,
 
 108           trans_id         => $trans_id,
 
 109           shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
 
 110                               ? $now : $transfer->{shippingdate},
 
 111           map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
 
 115         $qty = $unit->convert_to($qty, $part->unit_obj);
 
 118       $params{chargenumber} ||= '';
 
 120       if ($direction & 1) {
 
 121         SL::DB::Inventory->new(
 
 123           warehouse => $src_wh,
 
 129       if ($direction & 2) {
 
 130         SL::DB::Inventory->new(
 
 132           warehouse => $dst_wh->id,
 
 136         # Standardlagerplatz in Stammdaten gleich mitverschieben
 
 137         if (defined($transfer->{change_default_bin})){
 
 138           $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
 
 142       push @trans_ids, $trans_id;
 
 147     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
 
 150   $::lxdebug->leave_sub;
 
 155 sub transfer_assembly {
 
 156   $main::lxdebug->enter_sub();
 
 160   Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
 
 162 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
 
 164   my $myconfig = \%main::myconfig;
 
 165   my $form     = $main::form;
 
 166   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 
 171   # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
 
 172   # select parts_id,qty from assembly where id=1064;
 
 173   # Erweiterung für bug 935 am 23.4.09 -
 
 174   # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
 
 175   # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 176   # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
 
 178   # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
 
 179   # wenn assembly nicht überprüft wird ...
 
 180   # patch von joachim eingespielt 24.4.2009:
 
 181   # my $query    = qq|select parts_id,qty from assembly inner join parts
 
 182   # on assembly.parts_id = parts.id  where assembly.id = ? and
 
 183   # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 186   my $query = qq|select assembly.parts_id, assembly.qty, parts.warehouse_id from assembly inner join parts on assembly.parts_id = parts.id
 
 187                   where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 189   my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
 
 191   # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
 
 192   my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
 
 193                            trans_id, trans_type_id, shippingdate)
 
 194                            VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 195                            (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
 
 196                            (SELECT current_date))|;
 
 197   my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
 
 199   # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
 
 201   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
 
 202   my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
 
 203   while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
 
 204     $schleife_durchlaufen=1;  # Erzeugnis definiert
 
 205     my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
 
 206     my $currentPart_ID = $hash_ref->{parts_id};
 
 207     my $currentPart_WH_ID = $hash_ref->{warehouse_id};
 
 208     my $warehouse_info = $self->get_basic_warehouse_info('id' => $currentPart_WH_ID);
 
 209     my $warehouse_desc = $warehouse_info->{"warehouse_description"};
 
 211     # Überprüfen, ob diese Anzahl gefertigt werden kann
 
 212     my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
 
 213                                              warehouse_id => $currentPart_WH_ID);
 
 215     if ($partsQTY  > $max_parts){
 
 216       # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
 
 217       # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
 
 219       $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
 
 220                             " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) . 
 
 221                             " im Lager: " . $warehouse_desc .
 
 222                             ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
 
 223       next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
 
 226     # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
 
 227     # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
 
 228     # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
 
 229     # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
 
 230     # und lösen den Rest dann so wie bei xplace im Barcode-Programm
 
 231     # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
 
 233     my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
 
 234                        WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
 
 235     my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
 
 237     # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
 
 238     my $tmpPartsQTY = $partsQTY;
 
 240     while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
 
 241       my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
 
 242       my $temppart_chargenumber = $temphash_ref->{chargenumber};
 
 243       my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
 
 244       my $temppart_qty          = $temphash_ref->{sum};
 
 246       if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
 
 247                                            # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
 
 248         $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
 
 249         $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
 
 250                                             # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
 
 251                                             # Dieser Wert IST und BLEIBT positiv!! Hilfe.
 
 252                                             # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
 
 253         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
 
 254                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 255                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
 
 257         # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
 
 258         # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
 
 259         # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
 
 260         # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
 
 261       } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
 
 263         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
 
 264                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 265                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
 
 266         last; # beendet die schleife (springt zum letzten element)
 
 268     }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
 
 269   } #ende while select parts_id,qty from assembly where id = ?
 
 271   if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
 
 272                                   # keine einzelteile definiert
 
 273       $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
 
 274                            Dementsprechend kann auch nichts hergestellt werden";
 
 276   # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
 
 277   #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
 
 278   if ($kannNichtFertigen) {
 
 279     return $kannNichtFertigen;
 
 282   # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
 
 283   my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
 
 284                                                       comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
 
 285                                VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 286                                (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
 
 287                                (select current_date))|;
 
 288   my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
 
 289   do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
 
 290                $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
 
 293   $main::lxdebug->leave_sub();
 
 294   return 1; # Alles erfolgreich
 
 297 sub get_warehouse_journal {
 
 298   $main::lxdebug->enter_sub();
 
 303   my $myconfig  = \%main::myconfig;
 
 304   my $form      = $main::form;
 
 306   my $all_units = AM->retrieve_units($myconfig, $form);
 
 308   # connect to database
 
 309   my $dbh = $form->get_standard_dbh($myconfig);
 
 312   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 314   if ($filter{warehouse_id}) {
 
 315     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 316     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 319   if ($filter{bin_id}) {
 
 320     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 321     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 324   if ($filter{partnumber}) {
 
 325     push @filter_ary, "p.partnumber ILIKE ?";
 
 326     push @filter_vars, like($filter{partnumber});
 
 329   if ($filter{description}) {
 
 330     push @filter_ary, "(p.description ILIKE ?)";
 
 331     push @filter_vars, like($filter{description});
 
 334   if ($filter{chargenumber}) {
 
 335     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 336     push @filter_vars, like($filter{chargenumber});
 
 339   if (trim($form->{bestbefore})) {
 
 340     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 341     push @filter_vars, trim($form->{bestbefore});
 
 344   if (trim($form->{fromdate})) {
 
 345     push @filter_ary, "? <= i1.shippingdate";
 
 346     push @filter_vars, trim($form->{fromdate});
 
 349   if (trim($form->{todate})) {
 
 350     push @filter_ary, "? >= i1.shippingdate";
 
 351     push @filter_vars, trim($form->{todate});
 
 354   if ($form->{l_employee}) {
 
 358   # prepare qty comparison for later filtering
 
 359   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 360   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 361     $f_qty_op        = $filter{qty_op};
 
 362     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 363     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 366   map { $_ = "(${_})"; } @filter_ary;
 
 368   # if of a property number or description is requested,
 
 369   # automatically check the matching id too.
 
 370   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 372   # customize shown entry for not available fields.
 
 373   $filter{na} = '-' unless $filter{na};
 
 375   # make order, search in $filter and $form
 
 376   my $sort_col   = $form->{sort};
 
 377   my $sort_order = $form->{order};
 
 379   $sort_col      = $filter{sort}         unless $sort_col;
 
 380   $sort_order    = ($sort_col = 'shippingdate') unless $sort_col;
 
 381   $sort_col      = 'shippingdate'               if     $sort_col eq 'date';
 
 382   $sort_order    = $filter{order}        unless $sort_order;
 
 383   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 385   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 387   $select_tokens{'trans'} = {
 
 388      "parts_id"             => "i1.parts_id",
 
 389      "qty"                  => "ABS(SUM(i1.qty))",
 
 390      "partnumber"           => "p.partnumber",
 
 391      "partdescription"      => "p.description",
 
 392      "bindescription"       => "b.description",
 
 393      "chargenumber"         => "i1.chargenumber",
 
 394      "bestbefore"           => "i1.bestbefore",
 
 395      "warehousedescription" => "w.description",
 
 396      "partunit"             => "p.unit",
 
 397      "bin_from"             => "b1.description",
 
 398      "bin_to"               => "b2.description",
 
 399      "warehouse_from"       => "w1.description",
 
 400      "warehouse_to"         => "w2.description",
 
 401      "comment"              => "i1.comment",
 
 402      "trans_type"           => "tt.description",
 
 403      "trans_id"             => "i1.trans_id",
 
 404      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 
 405      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 
 406      "date"                 => "i1.shippingdate",
 
 407      "itime"                => "i1.itime",
 
 408      "shippingdate"         => "i1.shippingdate",
 
 409      "employee"             => "e.name",
 
 410      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 
 413   $select_tokens{'out'} = {
 
 414      "bin_to"               => "'$filter{na}'",
 
 415      "warehouse_to"         => "'$filter{na}'",
 
 418   $select_tokens{'in'} = {
 
 419      "bin_from"             => "'$filter{na}'",
 
 420      "warehouse_from"       => "'$filter{na}'",
 
 423   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
 
 425   # build the select clauses.
 
 426   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 
 427   for my $i ('trans', 'out', 'in') {
 
 428     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 
 429           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
 
 432   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 
 433         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
 
 435   $where_clause = defined($where_clause) ? $where_clause : '';
 
 438   qq|SELECT DISTINCT $select{trans}
 
 440     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 441     LEFT JOIN parts p ON i1.parts_id = p.id
 
 442     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 443     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 444     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 445     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 446     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 447     LEFT JOIN project pr ON i1.project_id = pr.id
 
 448     LEFT JOIN employee e ON i1.employee_id = e.id
 
 449     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 450           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 451     GROUP BY $group_clause
 
 455     SELECT DISTINCT $select{out}
 
 457     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 458     LEFT JOIN parts p ON i1.parts_id = p.id
 
 459     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 460     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 461     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 462     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 463     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 464     LEFT JOIN project pr ON i1.project_id = pr.id
 
 465     LEFT JOIN employee e ON i1.employee_id = e.id
 
 466     WHERE $where_clause i1.qty < 0 AND
 
 467           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 468     GROUP BY $group_clause
 
 472     SELECT DISTINCT $select{in}
 
 474     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 475     LEFT JOIN parts p ON i1.parts_id = p.id
 
 476     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 477     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 478     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 479     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 480     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 481     LEFT JOIN project pr ON i1.project_id = pr.id
 
 482     LEFT JOIN employee e ON i1.employee_id = e.id
 
 483     WHERE $where_clause i1.qty > 0 AND
 
 484           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 485     GROUP BY $group_clause
 
 486     ORDER BY r_${sort_spec}|;
 
 488   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 490   my ($h_oe_id, $q_oe_id);
 
 491   if ($form->{l_oe_id}) {
 
 494         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 496           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 497           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 498           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 499           ELSE                                                                       'purchase_order'
 
 506       SELECT dord.id AS id, dord.donumber AS number,
 
 508           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 509           ELSE                               'sales_delivery_order'
 
 511       FROM delivery_orders dord
 
 516       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 522       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 528       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 530       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 534       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 536       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 538     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 542   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 543     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 544     my $qty = $ref->{"qty"} * 1;
 
 546     next unless ($qty > 0);
 
 549       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 550       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 551       $qty *= $part_unit->{"factor"};
 
 552       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 553       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 554       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 557     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 
 558       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
 
 559       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
 
 560       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 563     push @contents, $ref;
 
 567   $h_oe_id->finish() if $h_oe_id;
 
 569   $main::lxdebug->leave_sub();
 
 575 # This sub is the primary function to retrieve information about items in warehouses.
 
 576 # $filter is a hashref and supports the following keys:
 
 577 #  - warehouse_id - will return matches with this warehouse_id only
 
 578 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 579 #  - partsid      - will return matches with this parts_id only
 
 580 #  - description  - will return only matches where the given string is a substring of the description
 
 581 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 582 #  - bestbefore   - will return only matches with this bestbefore date
 
 583 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 584 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 585 #  - expires_in   - will only return matches that expire within the given number of days
 
 586 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 587 #  - hazardous    - will return matches with the flag hazardous only
 
 588 #  - oil          - will return matches with the flag oil only
 
 589 #  - qty, qty_op  - quantity filter (more info to come)
 
 590 #  - sort, order_by - sorting (more to come)
 
 591 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 592 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 594 sub get_warehouse_report {
 
 595   $main::lxdebug->enter_sub();
 
 600   my $myconfig  = \%main::myconfig;
 
 601   my $form      = $main::form;
 
 603   my $all_units = AM->retrieve_units($myconfig, $form);
 
 605   # connect to database
 
 606   my $dbh = $form->get_standard_dbh($myconfig);
 
 609   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 611   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 613   if ($filter{warehouse_id}) {
 
 614     push @wh_bin_filter_ary,  "w.id = ?";
 
 615     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 618   if ($filter{bin_id}) {
 
 619     push @wh_bin_filter_ary,  "b.id = ?";
 
 620     push @wh_bin_filter_vars, $filter{bin_id};
 
 623   push @filter_ary,  @wh_bin_filter_ary;
 
 624   push @filter_vars, @wh_bin_filter_vars;
 
 626   if ($filter{partnumber}) {
 
 627     push @filter_ary,  "p.partnumber ILIKE ?";
 
 628     push @filter_vars, like($filter{partnumber});
 
 631   if ($filter{description}) {
 
 632     push @filter_ary,  "p.description ILIKE ?";
 
 633     push @filter_vars, like($filter{description});
 
 636   if ($filter{partsid}) {
 
 637     push @filter_ary,  "p.id = ?";
 
 638     push @filter_vars, $filter{partsid};
 
 641   if ($filter{chargenumber}) {
 
 642     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 643     push @filter_vars, like($filter{chargenumber});
 
 646   if (trim($form->{bestbefore})) {
 
 647     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 648     push @filter_vars, trim($form->{bestbefore});
 
 652     push @filter_ary,  "p.ean ILIKE ?";
 
 653     push @filter_vars, like($filter{ean});
 
 656   if (trim($filter{date})) {
 
 657     push @filter_ary, "i.shippingdate <= ?";
 
 658     push @filter_vars, trim($filter{date});
 
 660   if (!$filter{include_invalid_warehouses}){
 
 661     push @filter_ary,  "NOT (w.invalid)";
 
 664   # prepare qty comparison for later filtering
 
 665   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 667   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 668     $f_qty_op        = $filter{qty_op};
 
 669     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 670     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 673   map { $_ = "(${_})"; } @filter_ary;
 
 675   # if of a property number or description is requested,
 
 676   # automatically check the matching id too.
 
 677   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 679   # make order, search in $filter and $form
 
 680   my $sort_col    =  $form->{sort};
 
 681   my $sort_order  = $form->{order};
 
 683   $sort_col       =  $filter{sort}  unless $sort_col;
 
 684   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 685   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 686   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 687   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 688   # S.a. Bug 1597 jb 12.5.2011
 
 689   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 690   $sort_order     =  $filter{order} unless $sort_order;
 
 691   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 692   my $orderby     =  $sort_col;
 
 693   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 695   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 697   my %select_tokens = (
 
 698      "parts_id"              => "i.parts_id",
 
 699      "qty"                  => "SUM(i.qty)",
 
 700      "warehouseid"          => "i.warehouse_id",
 
 701      "partnumber"           => "p.partnumber",
 
 702      "partdescription"      => "p.description",
 
 703      "bindescription"       => "b.description",
 
 705      "chargenumber"         => "i.chargenumber",
 
 706      "bestbefore"           => "i.bestbefore",
 
 708      "chargeid"             => "c.id",
 
 709      "warehousedescription" => "w.description",
 
 710      "partunit"             => "p.unit",
 
 711      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 713   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 714         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 715           qw(l_parts_id l_qty l_partunit) );
 
 717   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 718         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 719           qw(l_parts_id l_partunit) );
 
 722     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 725   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 726         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 727           qw(l_parts_id l_qty l_partunit) );
 
 730     qq|SELECT $select_clause
 
 732       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 733       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 734       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 737       GROUP BY $group_clause
 
 738       ORDER BY $sort_spec|;
 
 740   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 742   my (%non_empty_bins, @all_fields, @contents);
 
 744   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 746     my $qty      = $ref->{qty};
 
 748     next unless ($qty != 0);
 
 751       my $part_unit = $all_units->{$ref->{partunit}};
 
 752       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 753       $qty *= $part_unit->{factor};
 
 754       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 755       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 756       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 759     if ($form->{include_empty_bins}) {
 
 760       $non_empty_bins{$ref->{binid}} = 1;
 
 761       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 764     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 766     push @contents, $ref;
 
 771   if ($form->{include_empty_bins}) {
 
 774            w.id AS warehouseid, w.description AS warehousedescription,
 
 775            b.id AS binid, b.description AS bindescription
 
 777          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 779     @filter_ary  = @wh_bin_filter_ary;
 
 780     @filter_vars = @wh_bin_filter_vars;
 
 782     my @non_empty_bin_ids = keys %non_empty_bins;
 
 783     if (@non_empty_bin_ids) {
 
 784       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 785       push @filter_vars, @non_empty_bin_ids;
 
 788     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 790     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 792     while (my $ref = $sth->fetchrow_hashref()) {
 
 793       map { $ref->{$_} ||= "" } @all_fields;
 
 794       push @contents, $ref;
 
 798     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 799       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 803   $main::lxdebug->leave_sub();
 
 809   $main::lxdebug->enter_sub();
 
 811   my ($self, $qty_op) = @_;
 
 813   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 814     $main::lxdebug->leave_sub();
 
 818   if ($qty_op eq "atleast") {
 
 820   } elsif ($qty_op eq "atmost") {
 
 826   $main::lxdebug->leave_sub();
 
 831 sub retrieve_transfer_types {
 
 832   $main::lxdebug->enter_sub();
 
 835   my $direction = shift;
 
 837   my $myconfig  = \%main::myconfig;
 
 838   my $form      = $main::form;
 
 840   my $dbh       = $form->get_standard_dbh($myconfig);
 
 842   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 844   $main::lxdebug->leave_sub();
 
 849 sub get_basic_bin_info {
 
 850   $main::lxdebug->enter_sub();
 
 855   Common::check_params(\%params, qw(id));
 
 857   my $myconfig = \%main::myconfig;
 
 858   my $form     = $main::form;
 
 860   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 862   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 865     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 866          w.id AS warehouse_id, w.description AS warehouse_description
 
 868        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 869        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 871   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 873   if ('' eq ref $params{id}) {
 
 874     $result = $result->[0] || { };
 
 875     $main::lxdebug->leave_sub();
 
 880   $main::lxdebug->leave_sub();
 
 882   return map { $_->{bin_id} => $_ } @{ $result };
 
 885 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 886 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 888 sub get_max_qty_parts {
 
 889 $main::lxdebug->enter_sub();
 
 894   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 896   my $myconfig = \%main::myconfig;
 
 897   my $form     = $main::form;
 
 899   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 901   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 902   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 905   my $max_qty_parts = 0; #Initialisierung mit 0
 
 906   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 907     $max_qty_parts += $ref->{sum};
 
 910   $main::lxdebug->leave_sub();
 
 912   return $max_qty_parts;
 
 916 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 917 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 919 sub get_part_description {
 
 920 $main::lxdebug->enter_sub();
 
 925   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 927   my $myconfig = \%main::myconfig;
 
 928   my $form     = $main::form;
 
 930   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 932   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 934   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 936   my $ref = $sth->fetchrow_hashref();
 
 937   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 939   $main::lxdebug->leave_sub();
 
 941   return $part_description;
 
 944 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 945 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 946 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 947 #           bei eingelagerten Teilen definiert sind.
 
 949 sub get_max_qty_parts_bin {
 
 950 $main::lxdebug->enter_sub();
 
 955   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 957   my $myconfig = \%main::myconfig;
 
 958   my $form     = $main::form;
 
 960   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 962   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 963                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 965   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 967   my $max_qty_parts = 0; #Initialisierung mit 0
 
 968   # falls derselbe artikel mehrmals eingelagert ist
 
 969   # chargennummer, muss entsprechend händisch agiert werden
 
 972   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 973     $max_qty_parts += $ref->{sum};
 
 975     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
 
 979   $main::lxdebug->leave_sub();
 
 981   return ($max_qty_parts, $error);
 
 990 SL::WH - Warehouse backend
 
 995   WH->transfer(\%params);
 
 999 Backend for kivitendo warehousing functions.
 
1003 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1005 This is the main function to manipulate warehouse contents. A typical transfer
 
1006 is called like this:
 
1011     transfer_type    => 'transfer',
 
1012     src_warehouse_id => 12,
 
1014     dst_warehouse_id => 25,
 
1018 It will generate an entry in inventory representing the transfer. Note that
 
1019 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1020 a destination or a src is mandatory.
 
1022 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1023 more than one is supplied, it is guaranteed, that all are processed in the same
 
1026 Here is a full list of parameters. All "_id" parameters except oe and
 
1027 orderitems can be called without id with RDB objects as well.
 
1033 The id of the article transferred. Does not check if the article is a service.
 
1038 Quantity of the transaction.  Mandatory.
 
1042 Unit of the transaction. Optional.
 
1046 =item transfer_type_id
 
1048 The type of transaction. The first version is a string describing the
 
1049 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1050 every system), the id is the hard id of a transfer_type from the database.
 
1052 Depending of the direction of the transfer_type, source and/or destination must
 
1055 One of transfer_type or transfer_type_id is mandatory.
 
1057 =item src_warehouse_id
 
1061 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1062 directions. Ignored in in directions.
 
1064 =item dst_warehouse_id
 
1068 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1069 directions. Ignored in out directions.
 
1073 If given, the transfer will transfer only articles with this chargenumber.
 
1078 Reference to an orderitem for which this transfer happened. Optional
 
1082 Reference to an order for which this transfer happened. Optional
 
1086 An optional comment.
 
1090 An expiration date. Note that this is not by default used by C<warehouse_report>.