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 parts_id,qty 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};
 
 208     # Überprüfen, ob diese Anzahl gefertigt werden kann
 
 209     my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
 
 210                                              warehouse_id => $params{dst_warehouse_id});
 
 212     if ($partsQTY  > $max_parts){
 
 213       # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
 
 214       # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
 
 216       $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
 
 217                             " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
 
 218                             ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
 
 219       next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
 
 222     # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
 
 223     # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
 
 224     # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
 
 225     # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
 
 226     # und lösen den Rest dann so wie bei xplace im Barcode-Programm
 
 227     # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
 
 229     my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
 
 230                        WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
 
 231     my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
 
 233     # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
 
 234     my $tmpPartsQTY = $partsQTY;
 
 236     while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
 
 237       my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
 
 238       my $temppart_chargenumber = $temphash_ref->{chargenumber};
 
 239       my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
 
 240       my $temppart_qty          = $temphash_ref->{sum};
 
 242       if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
 
 243                                            # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
 
 244         $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
 
 245         $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
 
 246                                             # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
 
 247                                             # Dieser Wert IST und BLEIBT positiv!! Hilfe.
 
 248                                             # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
 
 249         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 250                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 251                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
 
 253         # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
 
 254         # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
 
 255         # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
 
 256         # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
 
 257       } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
 
 259         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
 
 260                      $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
 
 261                      $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
 
 262         last; # beendet die schleife (springt zum letzten element)
 
 264     }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
 
 265   } #ende while select parts_id,qty from assembly where id = ?
 
 267   if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
 
 268                                   # keine einzelteile definiert
 
 269       $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
 
 270                            Dementsprechend kann auch nichts hergestellt werden";
 
 272   # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
 
 273   #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
 
 274   if ($kannNichtFertigen) {
 
 275     return $kannNichtFertigen;
 
 278   # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
 
 279   my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
 
 280                                                       comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
 
 281                                VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
 
 282                                (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
 
 283                                (select current_date))|;
 
 284   my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
 
 285   do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
 
 286                $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
 
 289   $main::lxdebug->leave_sub();
 
 290   return 1; # Alles erfolgreich
 
 293 sub get_warehouse_journal {
 
 294   $main::lxdebug->enter_sub();
 
 299   my $myconfig  = \%main::myconfig;
 
 300   my $form      = $main::form;
 
 302   my $all_units = AM->retrieve_units($myconfig, $form);
 
 304   # connect to database
 
 305   my $dbh = $form->get_standard_dbh($myconfig);
 
 308   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 310   if ($filter{warehouse_id}) {
 
 311     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 312     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 315   if ($filter{bin_id}) {
 
 316     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 317     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 320   if ($filter{partnumber}) {
 
 321     push @filter_ary, "p.partnumber ILIKE ?";
 
 322     push @filter_vars, like($filter{partnumber});
 
 325   if ($filter{description}) {
 
 326     push @filter_ary, "(p.description ILIKE ?)";
 
 327     push @filter_vars, like($filter{description});
 
 330   if ($filter{chargenumber}) {
 
 331     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 332     push @filter_vars, like($filter{chargenumber});
 
 335   if (trim($form->{bestbefore})) {
 
 336     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 337     push @filter_vars, trim($form->{bestbefore});
 
 340   if (trim($form->{fromdate})) {
 
 341     push @filter_ary, "? <= i1.shippingdate";
 
 342     push @filter_vars, trim($form->{fromdate});
 
 345   if (trim($form->{todate})) {
 
 346     push @filter_ary, "? >= i1.shippingdate";
 
 347     push @filter_vars, trim($form->{todate});
 
 350   if ($form->{l_employee}) {
 
 354   # prepare qty comparison for later filtering
 
 355   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 356   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 357     $f_qty_op        = $filter{qty_op};
 
 358     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 359     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 362   map { $_ = "(${_})"; } @filter_ary;
 
 364   # if of a property number or description is requested,
 
 365   # automatically check the matching id too.
 
 366   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 368   # customize shown entry for not available fields.
 
 369   $filter{na} = '-' unless $filter{na};
 
 371   # make order, search in $filter and $form
 
 372   my $sort_col   = $form->{sort};
 
 373   my $sort_order = $form->{order};
 
 375   $sort_col      = $filter{sort}         unless $sort_col;
 
 376   $sort_order    = ($sort_col = 'shippingdate') unless $sort_col;
 
 377   $sort_col      = 'shippingdate'               if     $sort_col eq 'date';
 
 378   $sort_order    = $filter{order}        unless $sort_order;
 
 379   my $sort_spec  = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 381   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 383   $select_tokens{'trans'} = {
 
 384      "parts_id"             => "i1.parts_id",
 
 385      "qty"                  => "ABS(SUM(i1.qty))",
 
 386      "partnumber"           => "p.partnumber",
 
 387      "partdescription"      => "p.description",
 
 388      "bindescription"       => "b.description",
 
 389      "chargenumber"         => "i1.chargenumber",
 
 390      "bestbefore"           => "i1.bestbefore",
 
 391      "warehousedescription" => "w.description",
 
 392      "partunit"             => "p.unit",
 
 393      "bin_from"             => "b1.description",
 
 394      "bin_to"               => "b2.description",
 
 395      "warehouse_from"       => "w1.description",
 
 396      "warehouse_to"         => "w2.description",
 
 397      "comment"              => "i1.comment",
 
 398      "trans_type"           => "tt.description",
 
 399      "trans_id"             => "i1.trans_id",
 
 400      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 
 401      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 
 402      "date"                 => "i1.shippingdate",
 
 403      "itime"                => "i1.itime",
 
 404      "shippingdate"         => "i1.shippingdate",
 
 405      "employee"             => "e.name",
 
 406      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 
 409   $select_tokens{'out'} = {
 
 410      "bin_to"               => "'$filter{na}'",
 
 411      "warehouse_to"         => "'$filter{na}'",
 
 414   $select_tokens{'in'} = {
 
 415      "bin_from"             => "'$filter{na}'",
 
 416      "warehouse_from"       => "'$filter{na}'",
 
 419   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
 
 421   # build the select clauses.
 
 422   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 
 423   for my $i ('trans', 'out', 'in') {
 
 424     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 
 425           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
 
 428   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 
 429         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
 
 431   $where_clause = defined($where_clause) ? $where_clause : '';
 
 434   qq|SELECT DISTINCT $select{trans}
 
 436     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 437     LEFT JOIN parts p ON i1.parts_id = p.id
 
 438     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 439     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 440     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 441     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 442     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 443     LEFT JOIN project pr ON i1.project_id = pr.id
 
 444     LEFT JOIN employee e ON i1.employee_id = e.id
 
 445     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 
 446           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 
 447     GROUP BY $group_clause
 
 451     SELECT DISTINCT $select{out}
 
 453     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 454     LEFT JOIN parts p ON i1.parts_id = p.id
 
 455     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 456     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 457     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 458     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 459     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 460     LEFT JOIN project pr ON i1.project_id = pr.id
 
 461     LEFT JOIN employee e ON i1.employee_id = e.id
 
 462     WHERE $where_clause i1.qty < 0 AND
 
 463           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 464     GROUP BY $group_clause
 
 468     SELECT DISTINCT $select{in}
 
 470     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 
 471     LEFT JOIN parts p ON i1.parts_id = p.id
 
 472     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 
 473     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 
 474     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 
 475     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 
 476     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 
 477     LEFT JOIN project pr ON i1.project_id = pr.id
 
 478     LEFT JOIN employee e ON i1.employee_id = e.id
 
 479     WHERE $where_clause i1.qty > 0 AND
 
 480           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 
 481     GROUP BY $group_clause
 
 482     ORDER BY r_${sort_spec}|;
 
 484   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
 
 486   my ($h_oe_id, $q_oe_id);
 
 487   if ($form->{l_oe_id}) {
 
 490         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
 
 492           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
 
 493           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
 
 494           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
 
 495           ELSE                                                                       'purchase_order'
 
 502       SELECT dord.id AS id, dord.donumber AS number,
 
 504           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 505           ELSE                               'sales_delivery_order'
 
 507       FROM delivery_orders dord
 
 512       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 518       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 524       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 526       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 530       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 532       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 534     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 538   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 539     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 540     my $qty = $ref->{"qty"} * 1;
 
 542     next unless ($qty > 0);
 
 545       my $part_unit = $all_units->{$ref->{"partunit"}};
 
 546       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 
 547       $qty *= $part_unit->{"factor"};
 
 548       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 
 549       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 
 550       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 
 553     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 
 554       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
 
 555       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
 
 556       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 
 559     push @contents, $ref;
 
 563   $h_oe_id->finish() if $h_oe_id;
 
 565   $main::lxdebug->leave_sub();
 
 571 # This sub is the primary function to retrieve information about items in warehouses.
 
 572 # $filter is a hashref and supports the following keys:
 
 573 #  - warehouse_id - will return matches with this warehouse_id only
 
 574 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 
 575 #  - partsid      - will return matches with this parts_id only
 
 576 #  - description  - will return only matches where the given string is a substring of the description
 
 577 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 
 578 #  - bestbefore   - will return only matches with this bestbefore date
 
 579 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 
 580 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 
 581 #  - expires_in   - will only return matches that expire within the given number of days
 
 582 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 
 583 #  - hazardous    - will return matches with the flag hazardous only
 
 584 #  - oil          - will return matches with the flag oil only
 
 585 #  - qty, qty_op  - quantity filter (more info to come)
 
 586 #  - sort, order_by - sorting (more to come)
 
 587 #  - reservation  - will provide an extra column containing the amount reserved of this match
 
 588 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 
 590 sub get_warehouse_report {
 
 591   $main::lxdebug->enter_sub();
 
 596   my $myconfig  = \%main::myconfig;
 
 597   my $form      = $main::form;
 
 599   my $all_units = AM->retrieve_units($myconfig, $form);
 
 601   # connect to database
 
 602   my $dbh = $form->get_standard_dbh($myconfig);
 
 605   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 607   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 609   if ($filter{warehouse_id}) {
 
 610     push @wh_bin_filter_ary,  "w.id = ?";
 
 611     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 614   if ($filter{bin_id}) {
 
 615     push @wh_bin_filter_ary,  "b.id = ?";
 
 616     push @wh_bin_filter_vars, $filter{bin_id};
 
 619   push @filter_ary,  @wh_bin_filter_ary;
 
 620   push @filter_vars, @wh_bin_filter_vars;
 
 622   if ($filter{partnumber}) {
 
 623     push @filter_ary,  "p.partnumber ILIKE ?";
 
 624     push @filter_vars, like($filter{partnumber});
 
 627   if ($filter{description}) {
 
 628     push @filter_ary,  "p.description ILIKE ?";
 
 629     push @filter_vars, like($filter{description});
 
 632   if ($filter{partsid}) {
 
 633     push @filter_ary,  "p.id = ?";
 
 634     push @filter_vars, $filter{partsid};
 
 637   if ($filter{chargenumber}) {
 
 638     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 639     push @filter_vars, like($filter{chargenumber});
 
 642   if (trim($form->{bestbefore})) {
 
 643     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 644     push @filter_vars, trim($form->{bestbefore});
 
 648     push @filter_ary,  "p.ean ILIKE ?";
 
 649     push @filter_vars, like($filter{ean});
 
 652   if (trim($filter{date})) {
 
 653     push @filter_ary, "i.shippingdate <= ?";
 
 654     push @filter_vars, trim($filter{date});
 
 656   if (!$filter{include_invalid_warehouses}){
 
 657     push @filter_ary,  "NOT (w.invalid)";
 
 660   # prepare qty comparison for later filtering
 
 661   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 663   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 
 664     $f_qty_op        = $filter{qty_op};
 
 665     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 
 666     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 
 669   map { $_ = "(${_})"; } @filter_ary;
 
 671   # if of a property number or description is requested,
 
 672   # automatically check the matching id too.
 
 673   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 
 675   # make order, search in $filter and $form
 
 676   my $sort_col    =  $form->{sort};
 
 677   my $sort_order  = $form->{order};
 
 679   $sort_col       =  $filter{sort}  unless $sort_col;
 
 680   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 
 681   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 
 682   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 
 683   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 
 684   # S.a. Bug 1597 jb 12.5.2011
 
 685   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 
 686   $sort_order     =  $filter{order} unless $sort_order;
 
 687   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 
 688   my $orderby     =  $sort_col;
 
 689   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 
 691   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 693   my %select_tokens = (
 
 694      "parts_id"              => "i.parts_id",
 
 695      "qty"                  => "SUM(i.qty)",
 
 696      "warehouseid"          => "i.warehouse_id",
 
 697      "partnumber"           => "p.partnumber",
 
 698      "partdescription"      => "p.description",
 
 699      "bindescription"       => "b.description",
 
 701      "chargenumber"         => "i.chargenumber",
 
 702      "bestbefore"           => "i.bestbefore",
 
 704      "chargeid"             => "c.id",
 
 705      "warehousedescription" => "w.description",
 
 706      "partunit"             => "p.unit",
 
 707      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
 
 709   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 
 710         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 711           qw(l_parts_id l_qty l_partunit) );
 
 713   my $group_clause = join ", ", map { +/^l_/; "$'" }
 
 714         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 715           qw(l_parts_id l_partunit) );
 
 718     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 721   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 
 722         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 
 723           qw(l_parts_id l_qty l_partunit) );
 
 726     qq|SELECT $select_clause
 
 728       LEFT JOIN parts     p ON i.parts_id     = p.id
 
 729       LEFT JOIN bin       b ON i.bin_id       = b.id
 
 730       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 
 733       GROUP BY $group_clause
 
 734       ORDER BY $sort_spec|;
 
 736   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 738   my (%non_empty_bins, @all_fields, @contents);
 
 740   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 742     my $qty      = $ref->{qty};
 
 744     next unless ($qty != 0);
 
 747       my $part_unit = $all_units->{$ref->{partunit}};
 
 748       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 749       $qty *= $part_unit->{factor};
 
 750       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 751       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 752       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 755     if ($form->{include_empty_bins}) {
 
 756       $non_empty_bins{$ref->{binid}} = 1;
 
 757       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 760     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 762     push @contents, $ref;
 
 767   if ($form->{include_empty_bins}) {
 
 770            w.id AS warehouseid, w.description AS warehousedescription,
 
 771            b.id AS binid, b.description AS bindescription
 
 773          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 775     @filter_ary  = @wh_bin_filter_ary;
 
 776     @filter_vars = @wh_bin_filter_vars;
 
 778     my @non_empty_bin_ids = keys %non_empty_bins;
 
 779     if (@non_empty_bin_ids) {
 
 780       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 781       push @filter_vars, @non_empty_bin_ids;
 
 784     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 786     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 788     while (my $ref = $sth->fetchrow_hashref()) {
 
 789       map { $ref->{$_} ||= "" } @all_fields;
 
 790       push @contents, $ref;
 
 794     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 795       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 799   $main::lxdebug->leave_sub();
 
 805   $main::lxdebug->enter_sub();
 
 807   my ($self, $qty_op) = @_;
 
 809   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 810     $main::lxdebug->leave_sub();
 
 814   if ($qty_op eq "atleast") {
 
 816   } elsif ($qty_op eq "atmost") {
 
 822   $main::lxdebug->leave_sub();
 
 827 sub retrieve_transfer_types {
 
 828   $main::lxdebug->enter_sub();
 
 831   my $direction = shift;
 
 833   my $myconfig  = \%main::myconfig;
 
 834   my $form      = $main::form;
 
 836   my $dbh       = $form->get_standard_dbh($myconfig);
 
 838   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 840   $main::lxdebug->leave_sub();
 
 845 sub get_basic_bin_info {
 
 846   $main::lxdebug->enter_sub();
 
 851   Common::check_params(\%params, qw(id));
 
 853   my $myconfig = \%main::myconfig;
 
 854   my $form     = $main::form;
 
 856   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 858   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 861     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 862          w.id AS warehouse_id, w.description AS warehouse_description
 
 864        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 865        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 867   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 869   if ('' eq ref $params{id}) {
 
 870     $result = $result->[0] || { };
 
 871     $main::lxdebug->leave_sub();
 
 876   $main::lxdebug->leave_sub();
 
 878   return map { $_->{bin_id} => $_ } @{ $result };
 
 881 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 882 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 884 sub get_max_qty_parts {
 
 885 $main::lxdebug->enter_sub();
 
 890   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 892   my $myconfig = \%main::myconfig;
 
 893   my $form     = $main::form;
 
 895   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 897   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
 
 899   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
 
 901   my $max_qty_parts = 0; #Initialisierung mit 0
 
 902   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
 
 903     $max_qty_parts += $ref->{sum};
 
 906   $main::lxdebug->leave_sub();
 
 908   return $max_qty_parts;
 
 912 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 913 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 915 sub get_part_description {
 
 916 $main::lxdebug->enter_sub();
 
 921   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 923   my $myconfig = \%main::myconfig;
 
 924   my $form     = $main::form;
 
 926   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 928   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 930   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 932   my $ref = $sth->fetchrow_hashref();
 
 933   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 935   $main::lxdebug->leave_sub();
 
 937   return $part_description;
 
 940 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
 
 941 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
 
 942 #           Bzw. Fehler, falls Chargen oder bestbefore
 
 943 #           bei eingelagerten Teilen definiert sind.
 
 945 sub get_max_qty_parts_bin {
 
 946 $main::lxdebug->enter_sub();
 
 951   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 953   my $myconfig = \%main::myconfig;
 
 954   my $form     = $main::form;
 
 956   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 958   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 959                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 961   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 963   my $max_qty_parts = 0; #Initialisierung mit 0
 
 964   # falls derselbe artikel mehrmals eingelagert ist
 
 965   # chargennummer, muss entsprechend händisch agiert werden
 
 968   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
 
 969     $max_qty_parts += $ref->{sum};
 
 971     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
 
 975   $main::lxdebug->leave_sub();
 
 977   return ($max_qty_parts, $error);
 
 986 SL::WH - Warehouse backend
 
 991   WH->transfer(\%params);
 
 995 Backend for kivitendo warehousing functions.
 
 999 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1001 This is the main function to manipulate warehouse contents. A typical transfer
 
1002 is called like this:
 
1007     transfer_type    => 'transfer',
 
1008     src_warehouse_id => 12,
 
1010     dst_warehouse_id => 25,
 
1014 It will generate an entry in inventory representing the transfer. Note that
 
1015 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
 
1016 a destination or a src is mandatory.
 
1018 transfer accepts more than one transaction parameter, each being a hash ref. If
 
1019 more than one is supplied, it is guaranteed, that all are processed in the same
 
1022 Here is a full list of parameters. All "_id" parameters except oe and
 
1023 orderitems can be called without id with RDB objects as well.
 
1029 The id of the article transferred. Does not check if the article is a service.
 
1034 Quantity of the transaction.  Mandatory.
 
1038 Unit of the transaction. Optional.
 
1042 =item transfer_type_id
 
1044 The type of transaction. The first version is a string describing the
 
1045 transaction (the types 'transfer' 'in' 'out' and a few others are present on
 
1046 every system), the id is the hard id of a transfer_type from the database.
 
1048 Depending of the direction of the transfer_type, source and/or destination must
 
1051 One of transfer_type or transfer_type_id is mandatory.
 
1053 =item src_warehouse_id
 
1057 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1058 directions. Ignored in in directions.
 
1060 =item dst_warehouse_id
 
1064 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1065 directions. Ignored in out directions.
 
1069 If given, the transfer will transfer only articles with this chargenumber.
 
1074 Reference to an orderitem for which this transfer happened. Optional
 
1078 Reference to an order for which this transfer happened. Optional
 
1082 An optional comment.
 
1086 An expiration date. Note that this is not by default used by C<warehouse_report>.