1 #====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #=====================================================================
 
   8 # SQL-Ledger Accounting
 
   9 # Copyright (C) 1999-2003
 
  11 #  Author: Dieter Simader
 
  12 #   Email: dsimader@sql-ledger.org
 
  13 #     Web: http://www.sql-ledger.org
 
  17 # This program is free software; you can redistribute it and/or modify
 
  18 # it under the terms of the GNU General Public License as published by
 
  19 # the Free Software Foundation; either version 2 of the License, or
 
  20 # (at your option) any later version.
 
  22 # This program is distributed in the hope that it will be useful,
 
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
  25 # GNU General Public License for more details.
 
  26 # You should have received a copy of the GNU General Public License
 
  27 # along with this program; if not, write to the Free Software
 
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
  29 #======================================================================
 
  33 #======================================================================
 
  40 use SL::Util qw(trim);
 
  49   $::lxdebug->enter_sub;
 
  51   my ($self, @args) = @_;
 
  54     $::lxdebug->leave_sub;
 
  58   require SL::DB::TransferType;
 
  60   require SL::DB::Employee;
 
  61   require SL::DB::Inventory;
 
  63   my $employee   = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
 
  64   my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
 
  65   my @directions = (undef, qw(out in transfer));
 
  68     my ($transfer, $field, $class, @find_by) = @_;
 
  70     @find_by = (description => $transfer->{$field}) unless @find_by;
 
  72     if ($transfer->{$field} || $transfer->{"${field}_id"}) {
 
  73       return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
 
  74            : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
 
  75            : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
 
  82   my $db = SL::DB::Inventory->new->db;
 
  83   $db->with_transaction(sub{
 
  84     while (my $transfer = shift @args) {
 
  85       my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
 
  87       my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
 
  88       my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
 
  89       my $qty           = $transfer->{qty};
 
  90       my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
 
  91       my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
 
  92       my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
 
  93       my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
 
  94       my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
 
  96       $src_wh ||= $src_bin->warehouse if $src_bin;
 
  97       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
 
  99       my $direction = 0; # bit mask
 
 100       $direction |= 1 if $src_bin;
 
 101       $direction |= 2 if $dst_bin;
 
 103       my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
 
 104                                                                                            description => $transfer->{transfer_type});
 
 108           employee         => $employee,
 
 109           trans_type       => $transfer_type,
 
 111           trans_id         => $trans_id,
 
 112           shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
 
 113                               ? $now : $transfer->{shippingdate},
 
 114           map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
 
 118         $qty = $unit->convert_to($qty, $part->unit_obj);
 
 121       $params{chargenumber} ||= '';
 
 123       if ($direction & 1) {
 
 124         SL::DB::Inventory->new(
 
 126           warehouse => $src_wh,
 
 132       if ($direction & 2) {
 
 133         SL::DB::Inventory->new(
 
 135           warehouse => $dst_wh->id,
 
 139         # Standardlagerplatz in Stammdaten gleich mitverschieben
 
 140         if (defined($transfer->{change_default_bin})){
 
 141           $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
 
 145       push @trans_ids, $trans_id;
 
 150     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
 
 153   $::lxdebug->leave_sub;
 
 158 sub transfer_assembly {
 
 159   $main::lxdebug->enter_sub();
 
 163   Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
 
 166   my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
 
 168     my $assembly = SL::DB::Manager::Assembly->get_all(
 
 169       query => [ id => $params{assembly_id} ],
 
 170       with_objects => ['part'],
 
 173     $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
 
 176 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
 
 178   my $myconfig = \%main::myconfig;
 
 179   my $form     = $main::form;
 
 180   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 
 185   # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
 
 186   # select parts_id,qty from assembly where id=1064;
 
 187   # Erweiterung für bug 935 am 23.4.09 -
 
 188   # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
 
 189   # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 190   # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
 
 192   # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
 
 193   # wenn assembly nicht überprüft wird ...
 
 194   # patch von joachim eingespielt 24.4.2009:
 
 195   # my $query    = qq|select parts_id,qty from assembly inner join parts
 
 196   # on assembly.parts_id = parts.id  where assembly.id = ? and
 
 197   # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 200   my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
 
 201                   where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
 
 203   my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
 
 205   # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
 
 206   my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
 
 207                            trans_id, trans_type_id, shippingdate)
 
 208                            VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 209                            (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
 
 210                            (SELECT current_date))|;
 
 211   my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
 
 213   # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
 
 215   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
 
 216   my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
 
 217   while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
 
 218     $schleife_durchlaufen=1;  # Erzeugnis definiert
 
 219     my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
 
 220     my $currentPart_ID = $hash_ref->{parts_id};
 
 222     # Überprüfen, ob diese Anzahl gefertigt werden kann
 
 223     my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
 
 224                                              warehouse_id => $params{dst_warehouse_id});
 
 226     if ($partsQTY  > $max_parts){
 
 227       # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
 
 228       # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
 
 230       $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
 
 231                             " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
 
 232                             ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
 
 233       next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
 
 236     # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
 
 237     # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
 
 238     # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
 
 239     # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
 
 240     # und lösen den Rest dann so wie bei xplace im Barcode-Programm
 
 241     # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
 
 243     my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
 
 244                        WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
 
 245     my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
 
 247     # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
 
 248     my $tmpPartsQTY = $partsQTY;
 
 250     while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
 
 251       my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
 
 252       my $temppart_chargenumber = $temphash_ref->{chargenumber};
 
 253       my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
 
 254       my $temppart_qty          = $temphash_ref->{sum};
 
 256       if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
 
 257                                            # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
 
 258         $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
 
 259         $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
 
 260                                             # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
 
 261                                             # Dieser Wert IST und BLEIBT positiv!! Hilfe.
 
 262                                             # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
 
 263         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 264                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 265                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
 
 267         # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
 
 268         # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
 
 269         # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
 
 270         # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
 
 271       } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
 
 273         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 274                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 275                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
 
 276         last; # beendet die schleife (springt zum letzten element)
 
 278     }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
 
 279   } #ende while select parts_id,qty from assembly where id = ?
 
 281   if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
 
 282                                   # keine einzelteile definiert
 
 283       $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
 
 284                            Dementsprechend kann auch nichts hergestellt werden";
 
 286   # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
 
 287   #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
 
 288   if ($kannNichtFertigen) {
 
 289     return $kannNichtFertigen;
 
 292   # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
 
 293   my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
 
 294                                                       comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
 
 295                                VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 296                                (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
 
 297                                (select current_date))|;
 
 298   my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
 
 299   do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
 
 300                $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
 
 303   $main::lxdebug->leave_sub();
 
 304   return 1; # Alles erfolgreich
 
 307 sub get_warehouse_journal {
 
 308   $main::lxdebug->enter_sub();
 
 313   my $myconfig  = \%main::myconfig;
 
 314   my $form      = $main::form;
 
 316   my $all_units = AM->retrieve_units($myconfig, $form);
 
 318   # connect to database
 
 319   my $dbh = $form->get_standard_dbh($myconfig);
 
 322   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 324   if ($filter{warehouse_id}) {
 
 325     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 326     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 329   if ($filter{bin_id}) {
 
 330     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 331     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 334   if ($filter{partnumber}) {
 
 335     push @filter_ary, "p.partnumber ILIKE ?";
 
 336     push @filter_vars, like($filter{partnumber});
 
 339   if ($filter{description}) {
 
 340     push @filter_ary, "(p.description ILIKE ?)";
 
 341     push @filter_vars, like($filter{description});
 
 344   if ($filter{chargenumber}) {
 
 345     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 346     push @filter_vars, like($filter{chargenumber});
 
 349   if (trim($form->{bestbefore})) {
 
 350     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 351     push @filter_vars, trim($form->{bestbefore});
 
 354   if (trim($form->{fromdate})) {
 
 355     push @filter_ary, "? <= i1.shippingdate";
 
 356     push @filter_vars, trim($form->{fromdate});
 
 359   if (trim($form->{todate})) {
 
 360     push @filter_ary, "? >= i1.shippingdate";
 
 361     push @filter_vars, trim($form->{todate});
 
 364   if ($form->{l_employee}) {
 
 368   # prepare qty comparison for later filtering
 
 369   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 370   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 371     $f_qty_op        = $filter{qty_op};
 
 372     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 373     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 376   map { $_ = "(${_})"; } @filter_ary;
 
 378   # if of a property number or description is requested,
 
 379   # automatically check the matching id too.
 
 380   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 382   # customize shown entry for not available fields.
 
 383   $filter{na} = '-' unless $filter{na};
 
 385   # make order, search in $filter and $form
 
 386   my $sort_col   = $form->{sort};
 
 387   my $sort_order = $form->{order};
 
 389   $sort_col      = $filter{sort}         unless $sort_col;
 
 390   $sort_order    = ($sort_col = 'shippingdate') unless $sort_col;
 
 391   $sort_col      = 'shippingdate'               if     $sort_col eq 'date';
 
 392   $sort_order    = $filter{order}        unless $sort_order;
 
 393   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 395   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 397   $select_tokens{'trans'} = {
 
 398      "parts_id"             => "i1.parts_id",
 
 399      "qty"                  => "ABS(SUM(i1.qty))",
 
 400      "partnumber"           => "p.partnumber",
 
 401      "partdescription"      => "p.description",
 
 402      "bindescription"       => "b.description",
 
 403      "chargenumber"         => "i1.chargenumber",
 
 404      "bestbefore"           => "i1.bestbefore",
 
 405      "warehousedescription" => "w.description",
 
 406      "partunit"             => "p.unit",
 
 407      "bin_from"             => "b1.description",
 
 408      "bin_to"               => "b2.description",
 
 409      "warehouse_from"       => "w1.description",
 
 410      "warehouse_to"         => "w2.description",
 
 411      "comment"              => "i1.comment",
 
 412      "trans_type"           => "tt.description",
 
 413      "trans_id"             => "i1.trans_id",
 
 414      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 
 415      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 
 416      "date"                 => "i1.shippingdate",
 
 417      "itime"                => "i1.itime",
 
 418      "shippingdate"         => "i1.shippingdate",
 
 419      "employee"             => "e.name",
 
 420      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 
 423   $select_tokens{'out'} = {
 
 424      "bin_to"               => "'$filter{na}'",
 
 425      "warehouse_to"         => "'$filter{na}'",
 
 428   $select_tokens{'in'} = {
 
 429      "bin_from"             => "'$filter{na}'",
 
 430      "warehouse_from"       => "'$filter{na}'",
 
 433   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
 
 435   # build the select clauses.
 
 436   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 
 437   for my $i ('trans', 'out', 'in') {
 
 438     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 
 439           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
 
 442   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 
 443         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
 
 445   $where_clause = defined($where_clause) ? $where_clause : '';
 
 448   qq|SELECT DISTINCT $select{trans}
 
 450     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 451     LEFT JOIN parts p ON i1.parts_id = p.id
 
 452     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 453     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 454     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 455     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 456     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 457     LEFT JOIN project pr ON i1.project_id = pr.id
 
 458     LEFT JOIN employee e ON i1.employee_id = e.id
 
 459     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 460           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 461     GROUP BY $group_clause
 
 465     SELECT DISTINCT $select{out}
 
 467     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 468     LEFT JOIN parts p ON i1.parts_id = p.id
 
 469     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 470     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 471     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 472     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 473     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 474     LEFT JOIN project pr ON i1.project_id = pr.id
 
 475     LEFT JOIN employee e ON i1.employee_id = e.id
 
 476     WHERE $where_clause i1.qty < 0 AND
 
 477           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 478     GROUP BY $group_clause
 
 482     SELECT DISTINCT $select{in}
 
 484     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 485     LEFT JOIN parts p ON i1.parts_id = p.id
 
 486     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 487     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 488     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 489     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 490     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 491     LEFT JOIN project pr ON i1.project_id = pr.id
 
 492     LEFT JOIN employee e ON i1.employee_id = e.id
 
 493     WHERE $where_clause i1.qty > 0 AND
 
 494           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 495     GROUP BY $group_clause
 
 496     ORDER BY r_${sort_spec}|;
 
 498   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 500   my ($h_oe_id, $q_oe_id);
 
 501   if ($form->{l_oe_id}) {
 
 504         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 506           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 507           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 508           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 509           ELSE                                                                       'purchase_order'
 
 516       SELECT dord.id AS id, dord.donumber AS number,
 
 518           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 519           ELSE                               'sales_delivery_order'
 
 521       FROM delivery_orders dord
 
 526       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 532       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 538       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 540       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 544       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 546       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 548     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 552   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 553     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 554     my $qty = $ref->{"qty"} * 1;
 
 556     next unless ($qty > 0);
 
 559       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 560       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 561       $qty *= $part_unit->{"factor"};
 
 562       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 563       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 564       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 567     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 
 568       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
 
 569       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
 
 570       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 573     push @contents, $ref;
 
 577   $h_oe_id->finish() if $h_oe_id;
 
 579   $main::lxdebug->leave_sub();
 
 585 # This sub is the primary function to retrieve information about items in warehouses.
 
 586 # $filter is a hashref and supports the following keys:
 
 587 #  - warehouse_id - will return matches with this warehouse_id only
 
 588 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 589 #  - partsid      - will return matches with this parts_id only
 
 590 #  - description  - will return only matches where the given string is a substring of the description
 
 591 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 592 #  - bestbefore   - will return only matches with this bestbefore date
 
 593 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 594 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 595 #  - expires_in   - will only return matches that expire within the given number of days
 
 596 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 597 #  - hazardous    - will return matches with the flag hazardous only
 
 598 #  - oil          - will return matches with the flag oil only
 
 599 #  - qty, qty_op  - quantity filter (more info to come)
 
 600 #  - sort, order_by - sorting (more to come)
 
 601 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 602 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 604 sub get_warehouse_report {
 
 605   $main::lxdebug->enter_sub();
 
 610   my $myconfig  = \%main::myconfig;
 
 611   my $form      = $main::form;
 
 613   my $all_units = AM->retrieve_units($myconfig, $form);
 
 615   # connect to database
 
 616   my $dbh = $form->get_standard_dbh($myconfig);
 
 619   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 621   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 623   if ($filter{warehouse_id}) {
 
 624     push @wh_bin_filter_ary,  "w.id = ?";
 
 625     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 628   if ($filter{bin_id}) {
 
 629     push @wh_bin_filter_ary,  "b.id = ?";
 
 630     push @wh_bin_filter_vars, $filter{bin_id};
 
 633   push @filter_ary,  @wh_bin_filter_ary;
 
 634   push @filter_vars, @wh_bin_filter_vars;
 
 636   if ($filter{partnumber}) {
 
 637     push @filter_ary,  "p.partnumber ILIKE ?";
 
 638     push @filter_vars, like($filter{partnumber});
 
 641   if ($filter{description}) {
 
 642     push @filter_ary,  "p.description ILIKE ?";
 
 643     push @filter_vars, like($filter{description});
 
 646   if ($filter{partsid}) {
 
 647     push @filter_ary,  "p.id = ?";
 
 648     push @filter_vars, $filter{partsid};
 
 651   if ($filter{chargenumber}) {
 
 652     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 653     push @filter_vars, like($filter{chargenumber});
 
 656   if (trim($form->{bestbefore})) {
 
 657     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 658     push @filter_vars, trim($form->{bestbefore});
 
 662     push @filter_ary,  "p.ean ILIKE ?";
 
 663     push @filter_vars, like($filter{ean});
 
 666   if (trim($filter{date})) {
 
 667     push @filter_ary, "i.shippingdate <= ?";
 
 668     push @filter_vars, trim($filter{date});
 
 670   if (!$filter{include_invalid_warehouses}){
 
 671     push @filter_ary,  "NOT (w.invalid)";
 
 674   # prepare qty comparison for later filtering
 
 675   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 677   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 678     $f_qty_op        = $filter{qty_op};
 
 679     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 680     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 683   map { $_ = "(${_})"; } @filter_ary;
 
 685   # if of a property number or description is requested,
 
 686   # automatically check the matching id too.
 
 687   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 689   # make order, search in $filter and $form
 
 690   my $sort_col    =  $form->{sort};
 
 691   my $sort_order  = $form->{order};
 
 693   $sort_col       =  $filter{sort}  unless $sort_col;
 
 694   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 695   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 696   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 697   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 698   # S.a. Bug 1597 jb 12.5.2011
 
 699   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 700   $sort_order     =  $filter{order} unless $sort_order;
 
 701   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 702   my $orderby     =  $sort_col;
 
 703   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 705   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 707   my %select_tokens = (
 
 708      "parts_id"              => "i.parts_id",
 
 709      "qty"                  => "SUM(i.qty)",
 
 710      "warehouseid"          => "i.warehouse_id",
 
 711      "partnumber"           => "p.partnumber",
 
 712      "partdescription"      => "p.description",
 
 713      "bindescription"       => "b.description",
 
 715      "chargenumber"         => "i.chargenumber",
 
 716      "bestbefore"           => "i.bestbefore",
 
 718      "chargeid"             => "c.id",
 
 719      "warehousedescription" => "w.description",
 
 720      "partunit"             => "p.unit",
 
 721      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 723   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 724         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 725           qw(l_parts_id l_qty l_partunit) );
 
 727   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 728         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 729           qw(l_parts_id l_partunit) );
 
 732     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 735   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 736         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 737           qw(l_parts_id l_qty l_partunit) );
 
 740     qq|SELECT $select_clause
 
 742       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 743       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 744       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 747       GROUP BY $group_clause
 
 748       ORDER BY $sort_spec|;
 
 750   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 752   my (%non_empty_bins, @all_fields, @contents);
 
 754   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 756     my $qty      = $ref->{qty};
 
 758     next unless ($qty != 0);
 
 761       my $part_unit = $all_units->{$ref->{partunit}};
 
 762       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 763       $qty *= $part_unit->{factor};
 
 764       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 765       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 766       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 769     if ($form->{include_empty_bins}) {
 
 770       $non_empty_bins{$ref->{binid}} = 1;
 
 771       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 774     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 776     push @contents, $ref;
 
 781   if ($form->{include_empty_bins}) {
 
 784            w.id AS warehouseid, w.description AS warehousedescription,
 
 785            b.id AS binid, b.description AS bindescription
 
 787          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 789     @filter_ary  = @wh_bin_filter_ary;
 
 790     @filter_vars = @wh_bin_filter_vars;
 
 792     my @non_empty_bin_ids = keys %non_empty_bins;
 
 793     if (@non_empty_bin_ids) {
 
 794       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 795       push @filter_vars, @non_empty_bin_ids;
 
 798     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 800     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 802     while (my $ref = $sth->fetchrow_hashref()) {
 
 803       map { $ref->{$_} ||= "" } @all_fields;
 
 804       push @contents, $ref;
 
 808     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 809       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 813   $main::lxdebug->leave_sub();
 
 819   $main::lxdebug->enter_sub();
 
 821   my ($self, $qty_op) = @_;
 
 823   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 824     $main::lxdebug->leave_sub();
 
 828   if ($qty_op eq "atleast") {
 
 830   } elsif ($qty_op eq "atmost") {
 
 836   $main::lxdebug->leave_sub();
 
 841 sub retrieve_transfer_types {
 
 842   $main::lxdebug->enter_sub();
 
 845   my $direction = shift;
 
 847   my $myconfig  = \%main::myconfig;
 
 848   my $form      = $main::form;
 
 850   my $dbh       = $form->get_standard_dbh($myconfig);
 
 852   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 854   $main::lxdebug->leave_sub();
 
 859 sub get_basic_bin_info {
 
 860   $main::lxdebug->enter_sub();
 
 865   Common::check_params(\%params, qw(id));
 
 867   my $myconfig = \%main::myconfig;
 
 868   my $form     = $main::form;
 
 870   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 872   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 875     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 876          w.id AS warehouse_id, w.description AS warehouse_description
 
 878        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 879        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 881   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 883   if ('' eq ref $params{id}) {
 
 884     $result = $result->[0] || { };
 
 885     $main::lxdebug->leave_sub();
 
 890   $main::lxdebug->leave_sub();
 
 892   return map { $_->{bin_id} => $_ } @{ $result };
 
 895 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 896 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 898 sub get_max_qty_parts {
 
 899 $main::lxdebug->enter_sub();
 
 904   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 906   my $myconfig = \%main::myconfig;
 
 907   my $form     = $main::form;
 
 909   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 911   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 913   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 915   my $max_qty_parts = 0; #Initialisierung mit 0
 
 916   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 917     $max_qty_parts += $ref->{sum};
 
 920   $main::lxdebug->leave_sub();
 
 922   return $max_qty_parts;
 
 926 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 927 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 929 sub get_part_description {
 
 930 $main::lxdebug->enter_sub();
 
 935   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 937   my $myconfig = \%main::myconfig;
 
 938   my $form     = $main::form;
 
 940   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 942   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 944   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 946   my $ref = $sth->fetchrow_hashref();
 
 947   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 949   $main::lxdebug->leave_sub();
 
 951   return $part_description;
 
 954 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 955 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 956 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 957 #           bei eingelagerten Teilen definiert sind.
 
 959 sub get_max_qty_parts_bin {
 
 960 $main::lxdebug->enter_sub();
 
 965   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 967   my $myconfig = \%main::myconfig;
 
 968   my $form     = $main::form;
 
 970   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 972   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 973                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 975   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 977   my $max_qty_parts = 0; #Initialisierung mit 0
 
 978   # falls derselbe artikel mehrmals eingelagert ist
 
 979   # chargennummer, muss entsprechend händisch agiert werden
 
 982   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 983     $max_qty_parts += $ref->{sum};
 
 985     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
 
 989   $main::lxdebug->leave_sub();
 
 991   return ($max_qty_parts, $error);
 
1000 SL::WH - Warehouse backend
 
1005   WH->transfer(\%params);
 
1009 Backend for kivitendo warehousing functions.
 
1013 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1015 This is the main function to manipulate warehouse contents. A typical transfer
 
1016 is called like this:
 
1021     transfer_type    => 'transfer',
 
1022     src_warehouse_id => 12,
 
1024     dst_warehouse_id => 25,
 
1028 It will generate an entry in inventory representing the transfer. Note that
 
1029 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1030 a destination or a src is mandatory.
 
1032 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1033 more than one is supplied, it is guaranteed, that all are processed in the same
 
1036 Here is a full list of parameters. All "_id" parameters except oe and
 
1037 orderitems can be called without id with RDB objects as well.
 
1043 The id of the article transferred. Does not check if the article is a service.
 
1048 Quantity of the transaction.  Mandatory.
 
1052 Unit of the transaction. Optional.
 
1056 =item transfer_type_id
 
1058 The type of transaction. The first version is a string describing the
 
1059 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1060 every system), the id is the hard id of a transfer_type from the database.
 
1062 Depending of the direction of the transfer_type, source and/or destination must
 
1065 One of transfer_type or transfer_type_id is mandatory.
 
1067 =item src_warehouse_id
 
1071 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1072 directions. Ignored in in directions.
 
1074 =item dst_warehouse_id
 
1078 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1079 directions. Ignored in out directions.
 
1083 If given, the transfer will transfer only articles with this chargenumber.
 
1088 Reference to an orderitem for which this transfer happened. Optional
 
1092 Reference to an order for which this transfer happened. Optional
 
1096 An optional comment.
 
1100 An expiration date. Note that this is not by default used by C<warehouse_report>.