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)|;
185 # Lager in dem die Bestandteile gesucht werden kann entweder das Ziellager sein oder ist per Mandantenkonfig
186 # auf das Standardlager des Bestandteiles schaltbar
188 my $use_default_warehouse = $::instance_conf->get_transfer_default_warehouse_for_assembly;
190 my $query = qq|SELECT assembly.parts_id, assembly.qty, parts.warehouse_id
191 FROM assembly INNER JOIN parts ON assembly.parts_id = parts.id
192 WHERE assembly.id = ? AND (inventory_accno_id IS NOT NULL OR parts.assembly = TRUE)|;
194 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
196 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
197 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
198 trans_id, trans_type_id, shippingdate)
199 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
200 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
201 (SELECT current_date))|;
202 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
204 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
206 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
207 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
208 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
209 $schleife_durchlaufen=1; # Erzeugnis definiert
211 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
212 my $currentPart_ID = $hash_ref->{parts_id};
213 my $currentPart_WH_ID = $use_default_warehouse ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
214 my $warehouse_info = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
215 my $warehouse_desc = $warehouse_info->{"warehouse_description"};
217 # Überprüfen, ob diese Anzahl gefertigt werden kann
218 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
219 warehouse_id => $currentPart_WH_ID);
221 if ($partsQTY > $max_parts){
222 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
223 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
225 $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
226 " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
227 " im Lager: " . $warehouse_desc .
228 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
229 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
232 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
233 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
234 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
235 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
236 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
237 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
239 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
240 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
241 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
243 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
244 my $tmpPartsQTY = $partsQTY;
246 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
247 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
248 my $temppart_chargenumber = $temphash_ref->{chargenumber};
249 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
250 my $temppart_qty = $temphash_ref->{sum};
252 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
253 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
254 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
255 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
256 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
257 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
258 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
259 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
260 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
261 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
263 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
264 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
265 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
266 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
267 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
269 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
270 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
271 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
272 last; # beendet die schleife (springt zum letzten element)
274 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
275 } #ende while select parts_id,qty from assembly where id = ?
277 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
278 # keine einzelteile definiert
279 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
280 Dementsprechend kann auch nichts hergestellt werden";
282 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
283 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
284 if ($kannNichtFertigen) {
285 return $kannNichtFertigen;
288 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
289 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
290 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
291 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
292 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
293 (select current_date))|;
294 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
295 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
296 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
299 $main::lxdebug->leave_sub();
300 return 1; # Alles erfolgreich
303 sub get_warehouse_journal {
304 $main::lxdebug->enter_sub();
309 my $myconfig = \%main::myconfig;
310 my $form = $main::form;
312 my $all_units = AM->retrieve_units($myconfig, $form);
314 # connect to database
315 my $dbh = $form->get_standard_dbh($myconfig);
318 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
320 if ($filter{warehouse_id}) {
321 push @filter_ary, "w1.id = ? OR w2.id = ?";
322 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
325 if ($filter{bin_id}) {
326 push @filter_ary, "b1.id = ? OR b2.id = ?";
327 push @filter_vars, $filter{bin_id}, $filter{bin_id};
330 if ($filter{partnumber}) {
331 push @filter_ary, "p.partnumber ILIKE ?";
332 push @filter_vars, like($filter{partnumber});
335 if ($filter{description}) {
336 push @filter_ary, "(p.description ILIKE ?)";
337 push @filter_vars, like($filter{description});
340 if ($filter{chargenumber}) {
341 push @filter_ary, "i1.chargenumber ILIKE ?";
342 push @filter_vars, like($filter{chargenumber});
345 if (trim($form->{bestbefore})) {
346 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
347 push @filter_vars, trim($form->{bestbefore});
350 if (trim($form->{fromdate})) {
351 push @filter_ary, "? <= i1.shippingdate";
352 push @filter_vars, trim($form->{fromdate});
355 if (trim($form->{todate})) {
356 push @filter_ary, "? >= i1.shippingdate";
357 push @filter_vars, trim($form->{todate});
360 if ($form->{l_employee}) {
364 # prepare qty comparison for later filtering
365 my ($f_qty_op, $f_qty, $f_qty_base_unit);
366 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
367 $f_qty_op = $filter{qty_op};
368 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
369 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
372 map { $_ = "(${_})"; } @filter_ary;
374 # if of a property number or description is requested,
375 # automatically check the matching id too.
376 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
378 # customize shown entry for not available fields.
379 $filter{na} = '-' unless $filter{na};
381 # make order, search in $filter and $form
382 my $sort_col = $form->{sort};
383 my $sort_order = $form->{order};
385 $sort_col = $filter{sort} unless $sort_col;
386 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
387 $sort_col = 'shippingdate' if $sort_col eq 'date';
388 $sort_order = $filter{order} unless $sort_order;
389 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
391 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
393 $select_tokens{'trans'} = {
394 "parts_id" => "i1.parts_id",
395 "qty" => "ABS(SUM(i1.qty))",
396 "partnumber" => "p.partnumber",
397 "partdescription" => "p.description",
398 "bindescription" => "b.description",
399 "chargenumber" => "i1.chargenumber",
400 "bestbefore" => "i1.bestbefore",
401 "warehousedescription" => "w.description",
402 "partunit" => "p.unit",
403 "bin_from" => "b1.description",
404 "bin_to" => "b2.description",
405 "warehouse_from" => "w1.description",
406 "warehouse_to" => "w2.description",
407 "comment" => "i1.comment",
408 "trans_type" => "tt.description",
409 "trans_id" => "i1.trans_id",
410 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
411 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
412 "date" => "i1.shippingdate",
413 "itime" => "i1.itime",
414 "shippingdate" => "i1.shippingdate",
415 "employee" => "e.name",
416 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
419 $select_tokens{'out'} = {
420 "bin_to" => "'$filter{na}'",
421 "warehouse_to" => "'$filter{na}'",
424 $select_tokens{'in'} = {
425 "bin_from" => "'$filter{na}'",
426 "warehouse_from" => "'$filter{na}'",
429 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
431 # build the select clauses.
432 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
433 for my $i ('trans', 'out', 'in') {
434 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
435 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
438 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
439 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
441 $where_clause = defined($where_clause) ? $where_clause : '';
444 qq|SELECT DISTINCT $select{trans}
446 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
447 LEFT JOIN parts p ON i1.parts_id = p.id
448 LEFT JOIN bin b1 ON i1.bin_id = b1.id
449 LEFT JOIN bin b2 ON i2.bin_id = b2.id
450 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
451 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
452 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
453 LEFT JOIN project pr ON i1.project_id = pr.id
454 LEFT JOIN employee e ON i1.employee_id = e.id
455 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
456 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
457 GROUP BY $group_clause
461 SELECT DISTINCT $select{out}
463 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
464 LEFT JOIN parts p ON i1.parts_id = p.id
465 LEFT JOIN bin b1 ON i1.bin_id = b1.id
466 LEFT JOIN bin b2 ON i2.bin_id = b2.id
467 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
468 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
469 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
470 LEFT JOIN project pr ON i1.project_id = pr.id
471 LEFT JOIN employee e ON i1.employee_id = e.id
472 WHERE $where_clause i1.qty < 0 AND
473 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
474 GROUP BY $group_clause
478 SELECT DISTINCT $select{in}
480 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
481 LEFT JOIN parts p ON i1.parts_id = p.id
482 LEFT JOIN bin b1 ON i1.bin_id = b1.id
483 LEFT JOIN bin b2 ON i2.bin_id = b2.id
484 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
485 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
486 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
487 LEFT JOIN project pr ON i1.project_id = pr.id
488 LEFT JOIN employee e ON i1.employee_id = e.id
489 WHERE $where_clause i1.qty > 0 AND
490 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
491 GROUP BY $group_clause
492 ORDER BY r_${sort_spec}|;
494 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
496 my ($h_oe_id, $q_oe_id);
497 if ($form->{l_oe_id}) {
500 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
502 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
503 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
504 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
505 ELSE 'purchase_order'
512 SELECT dord.id AS id, dord.donumber AS number,
514 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
515 ELSE 'sales_delivery_order'
517 FROM delivery_orders dord
522 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
528 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
534 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
536 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
540 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
542 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
544 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
548 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
549 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
550 my $qty = $ref->{"qty"} * 1;
552 next unless ($qty > 0);
555 my $part_unit = $all_units->{$ref->{"partunit"}};
556 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
557 $qty *= $part_unit->{"factor"};
558 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
559 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
560 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
563 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
564 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
565 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
566 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
569 push @contents, $ref;
573 $h_oe_id->finish() if $h_oe_id;
575 $main::lxdebug->leave_sub();
581 # This sub is the primary function to retrieve information about items in warehouses.
582 # $filter is a hashref and supports the following keys:
583 # - warehouse_id - will return matches with this warehouse_id only
584 # - partnumber - will return only matches where the given string is a substring of the partnumber
585 # - partsid - will return matches with this parts_id only
586 # - description - will return only matches where the given string is a substring of the description
587 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
588 # - bestbefore - will return only matches with this bestbefore date
589 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
590 # - charge_ids - must be an arrayref. will return contents with these ids only
591 # - expires_in - will only return matches that expire within the given number of days
592 # will also add a column named 'has_expired' containing if the match has already expired or not
593 # - hazardous - will return matches with the flag hazardous only
594 # - oil - will return matches with the flag oil only
595 # - qty, qty_op - quantity filter (more info to come)
596 # - sort, order_by - sorting (more to come)
597 # - reservation - will provide an extra column containing the amount reserved of this match
598 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
600 sub get_warehouse_report {
601 $main::lxdebug->enter_sub();
606 my $myconfig = \%main::myconfig;
607 my $form = $main::form;
609 my $all_units = AM->retrieve_units($myconfig, $form);
611 # connect to database
612 my $dbh = $form->get_standard_dbh($myconfig);
615 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
617 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
619 if ($filter{warehouse_id}) {
620 push @wh_bin_filter_ary, "w.id = ?";
621 push @wh_bin_filter_vars, $filter{warehouse_id};
624 if ($filter{bin_id}) {
625 push @wh_bin_filter_ary, "b.id = ?";
626 push @wh_bin_filter_vars, $filter{bin_id};
629 push @filter_ary, @wh_bin_filter_ary;
630 push @filter_vars, @wh_bin_filter_vars;
632 if ($filter{partnumber}) {
633 push @filter_ary, "p.partnumber ILIKE ?";
634 push @filter_vars, like($filter{partnumber});
637 if ($filter{description}) {
638 push @filter_ary, "p.description ILIKE ?";
639 push @filter_vars, like($filter{description});
642 if ($filter{partsid}) {
643 push @filter_ary, "p.id = ?";
644 push @filter_vars, $filter{partsid};
647 if ($filter{chargenumber}) {
648 push @filter_ary, "i.chargenumber ILIKE ?";
649 push @filter_vars, like($filter{chargenumber});
652 if (trim($form->{bestbefore})) {
653 push @filter_ary, "?::DATE = i.bestbefore::DATE";
654 push @filter_vars, trim($form->{bestbefore});
658 push @filter_ary, "p.ean ILIKE ?";
659 push @filter_vars, like($filter{ean});
662 if (trim($filter{date})) {
663 push @filter_ary, "i.shippingdate <= ?";
664 push @filter_vars, trim($filter{date});
666 if (!$filter{include_invalid_warehouses}){
667 push @filter_ary, "NOT (w.invalid)";
670 # prepare qty comparison for later filtering
671 my ($f_qty_op, $f_qty, $f_qty_base_unit);
673 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
674 $f_qty_op = $filter{qty_op};
675 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
676 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
679 map { $_ = "(${_})"; } @filter_ary;
681 # if of a property number or description is requested,
682 # automatically check the matching id too.
683 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
685 # make order, search in $filter and $form
686 my $sort_col = $form->{sort};
687 my $sort_order = $form->{order};
689 $sort_col = $filter{sort} unless $sort_col;
690 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
691 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
692 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
693 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
694 # S.a. Bug 1597 jb 12.5.2011
695 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
696 $sort_order = $filter{order} unless $sort_order;
697 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
698 my $orderby = $sort_col;
699 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
701 my $where_clause = join " AND ", ("1=1", @filter_ary);
703 my %select_tokens = (
704 "parts_id" => "i.parts_id",
705 "qty" => "SUM(i.qty)",
706 "warehouseid" => "i.warehouse_id",
707 "partnumber" => "p.partnumber",
708 "partdescription" => "p.description",
709 "bindescription" => "b.description",
711 "chargenumber" => "i.chargenumber",
712 "bestbefore" => "i.bestbefore",
714 "chargeid" => "c.id",
715 "warehousedescription" => "w.description",
716 "partunit" => "p.unit",
717 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
719 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
720 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
721 qw(l_parts_id l_qty l_partunit) );
723 my $group_clause = join ", ", map { +/^l_/; "$'" }
724 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
725 qw(l_parts_id l_partunit) );
728 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
731 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
732 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
733 qw(l_parts_id l_qty l_partunit) );
736 qq|SELECT $select_clause
738 LEFT JOIN parts p ON i.parts_id = p.id
739 LEFT JOIN bin b ON i.bin_id = b.id
740 LEFT JOIN warehouse w ON i.warehouse_id = w.id
743 GROUP BY $group_clause
744 ORDER BY $sort_spec|;
746 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
748 my (%non_empty_bins, @all_fields, @contents);
750 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
752 my $qty = $ref->{qty};
754 next unless ($qty != 0);
757 my $part_unit = $all_units->{$ref->{partunit}};
758 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
759 $qty *= $part_unit->{factor};
760 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
761 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
762 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
765 if ($form->{include_empty_bins}) {
766 $non_empty_bins{$ref->{binid}} = 1;
767 @all_fields = keys %{ $ref } unless (@all_fields);
770 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
772 push @contents, $ref;
777 if ($form->{include_empty_bins}) {
780 w.id AS warehouseid, w.description AS warehousedescription,
781 b.id AS binid, b.description AS bindescription
783 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
785 @filter_ary = @wh_bin_filter_ary;
786 @filter_vars = @wh_bin_filter_vars;
788 my @non_empty_bin_ids = keys %non_empty_bins;
789 if (@non_empty_bin_ids) {
790 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
791 push @filter_vars, @non_empty_bin_ids;
794 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
796 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
798 while (my $ref = $sth->fetchrow_hashref()) {
799 map { $ref->{$_} ||= "" } @all_fields;
800 push @contents, $ref;
804 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
805 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
809 $main::lxdebug->leave_sub();
815 $main::lxdebug->enter_sub();
817 my ($self, $qty_op) = @_;
819 if (!$qty_op || ($qty_op eq "dontcare")) {
820 $main::lxdebug->leave_sub();
824 if ($qty_op eq "atleast") {
826 } elsif ($qty_op eq "atmost") {
832 $main::lxdebug->leave_sub();
837 sub retrieve_transfer_types {
838 $main::lxdebug->enter_sub();
841 my $direction = shift;
843 my $myconfig = \%main::myconfig;
844 my $form = $main::form;
846 my $dbh = $form->get_standard_dbh($myconfig);
848 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
850 $main::lxdebug->leave_sub();
855 sub get_basic_bin_info {
856 $main::lxdebug->enter_sub();
861 Common::check_params(\%params, qw(id));
863 my $myconfig = \%main::myconfig;
864 my $form = $main::form;
866 my $dbh = $params{dbh} || $form->get_standard_dbh();
868 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
871 qq|SELECT b.id AS bin_id, b.description AS bin_description,
872 w.id AS warehouse_id, w.description AS warehouse_description
874 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
875 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
877 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
879 if ('' eq ref $params{id}) {
880 $result = $result->[0] || { };
881 $main::lxdebug->leave_sub();
886 $main::lxdebug->leave_sub();
888 return map { $_->{bin_id} => $_ } @{ $result };
891 sub get_basic_warehouse_info {
892 $main::lxdebug->enter_sub();
897 Common::check_params(\%params, qw(id));
899 my $myconfig = \%main::myconfig;
900 my $form = $main::form;
902 my $dbh = $params{dbh} || $form->get_standard_dbh();
904 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
907 qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
909 WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
911 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
913 if ('' eq ref $params{id}) {
914 $result = $result->[0] || { };
915 $main::lxdebug->leave_sub();
920 $main::lxdebug->leave_sub();
922 return map { $_->{warehouse_id} => $_ } @{ $result };
925 # Eingabe: Teilenummer, Lagernummer (warehouse)
926 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
928 sub get_max_qty_parts {
929 $main::lxdebug->enter_sub();
934 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
936 my $myconfig = \%main::myconfig;
937 my $form = $main::form;
939 my $dbh = $params{dbh} || $form->get_standard_dbh();
941 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
942 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
945 my $max_qty_parts = 0; #Initialisierung mit 0
946 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
947 $max_qty_parts += $ref->{sum};
950 $main::lxdebug->leave_sub();
952 return $max_qty_parts;
956 # Eingabe: Teilenummer, Lagernummer (warehouse)
957 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
959 sub get_part_description {
960 $main::lxdebug->enter_sub();
965 Common::check_params(\%params, qw(parts_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 partnumber, description FROM parts where id = ? |;
974 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
976 my $ref = $sth->fetchrow_hashref();
977 my $part_description = $ref->{partnumber} . " " . $ref->{description};
979 $main::lxdebug->leave_sub();
981 return $part_description;
984 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
985 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
986 # Bzw. Fehler, falls Chargen oder bestbefore
987 # bei eingelagerten Teilen definiert sind.
989 sub get_max_qty_parts_bin {
990 $main::lxdebug->enter_sub();
995 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
997 my $myconfig = \%main::myconfig;
998 my $form = $main::form;
1000 my $dbh = $params{dbh} || $form->get_standard_dbh();
1002 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
1003 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1005 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1007 my $max_qty_parts = 0; #Initialisierung mit 0
1008 # falls derselbe artikel mehrmals eingelagert ist
1009 # chargennummer, muss entsprechend händisch agiert werden
1012 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1013 $max_qty_parts += $ref->{sum};
1015 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1019 $main::lxdebug->leave_sub();
1021 return ($max_qty_parts, $error);
1030 SL::WH - Warehouse backend
1035 WH->transfer(\%params);
1039 Backend for kivitendo warehousing functions.
1043 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1045 This is the main function to manipulate warehouse contents. A typical transfer
1046 is called like this:
1051 transfer_type => 'transfer',
1052 src_warehouse_id => 12,
1054 dst_warehouse_id => 25,
1058 It will generate an entry in inventory representing the transfer. Note that
1059 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1060 a destination or a src is mandatory.
1062 transfer accepts more than one transaction parameter, each being a hash ref. If
1063 more than one is supplied, it is guaranteed, that all are processed in the same
1066 Here is a full list of parameters. All "_id" parameters except oe and
1067 orderitems can be called without id with RDB objects as well.
1073 The id of the article transferred. Does not check if the article is a service.
1078 Quantity of the transaction. Mandatory.
1082 Unit of the transaction. Optional.
1086 =item transfer_type_id
1088 The type of transaction. The first version is a string describing the
1089 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1090 every system), the id is the hard id of a transfer_type from the database.
1092 Depending of the direction of the transfer_type, source and/or destination must
1095 One of transfer_type or transfer_type_id is mandatory.
1097 =item src_warehouse_id
1101 Warehouse and bin from which to transfer. Mandatory in transfer and out
1102 directions. Ignored in in directions.
1104 =item dst_warehouse_id
1108 Warehouse and bin to which to transfer. Mandatory in transfer and in
1109 directions. Ignored in out directions.
1113 If given, the transfer will transfer only articles with this chargenumber.
1118 Reference to an orderitem for which this transfer happened. Optional
1122 Reference to an order for which this transfer happened. Optional
1126 An optional comment.
1130 An expiration date. Note that this is not by default used by C<warehouse_report>.