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};
214 # Prüfen ob Erzeugnis-Teile Standardlager haben.
215 if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {
216 # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.
217 if ($::instance_conf->get_transfer_default_ignore_onhand) {
218 $hash_ref->{warehouse_id} = $::instance_conf->get_warehouse_id_ignore_onhand;
220 $kannNichtFertigen .= "Kein Standardlager: " .
221 " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .
222 " hat kein Standardlager definiert " .
223 ", um das Erzeugnis herzustellen. <br>";
227 my $currentPart_WH_ID = $use_default_warehouse ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
228 my $warehouse_info = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
229 my $warehouse_desc = $warehouse_info->{"warehouse_description"};
231 # Überprüfen, ob diese Anzahl gefertigt werden kann
232 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
233 warehouse_id => $currentPart_WH_ID);
235 if ($partsQTY > $max_parts){
236 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
237 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
239 $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
240 " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
241 " im Lager: " . $warehouse_desc .
242 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
243 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
246 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
247 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
248 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
249 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
250 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
251 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
253 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
254 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
255 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
257 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
258 my $tmpPartsQTY = $partsQTY;
260 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
261 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
262 my $temppart_chargenumber = $temphash_ref->{chargenumber};
263 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
264 my $temppart_qty = $temphash_ref->{sum};
266 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
267 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
268 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
269 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
270 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
271 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
272 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
273 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
274 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
275 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
277 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
278 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
279 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
280 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
281 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
283 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
284 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
285 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
286 last; # beendet die schleife (springt zum letzten element)
288 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
289 } #ende while select parts_id,qty from assembly where id = ?
291 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
292 # keine einzelteile definiert
293 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
294 Dementsprechend kann auch nichts hergestellt werden";
296 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
297 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
298 if ($kannNichtFertigen) {
299 return $kannNichtFertigen;
302 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
303 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
304 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
305 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
306 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
307 (select current_date))|;
308 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
309 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
310 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
313 $main::lxdebug->leave_sub();
314 return 1; # Alles erfolgreich
317 sub get_warehouse_journal {
318 $main::lxdebug->enter_sub();
323 my $myconfig = \%main::myconfig;
324 my $form = $main::form;
326 my $all_units = AM->retrieve_units($myconfig, $form);
328 # connect to database
329 my $dbh = $form->get_standard_dbh($myconfig);
332 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
334 if ($filter{warehouse_id}) {
335 push @filter_ary, "w1.id = ? OR w2.id = ?";
336 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
339 if ($filter{bin_id}) {
340 push @filter_ary, "b1.id = ? OR b2.id = ?";
341 push @filter_vars, $filter{bin_id}, $filter{bin_id};
344 if ($filter{partnumber}) {
345 push @filter_ary, "p.partnumber ILIKE ?";
346 push @filter_vars, like($filter{partnumber});
349 if ($filter{description}) {
350 push @filter_ary, "(p.description ILIKE ?)";
351 push @filter_vars, like($filter{description});
354 if ($filter{chargenumber}) {
355 push @filter_ary, "i1.chargenumber ILIKE ?";
356 push @filter_vars, like($filter{chargenumber});
359 if (trim($form->{bestbefore})) {
360 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
361 push @filter_vars, trim($form->{bestbefore});
364 if (trim($form->{fromdate})) {
365 push @filter_ary, "? <= i1.shippingdate";
366 push @filter_vars, trim($form->{fromdate});
369 if (trim($form->{todate})) {
370 push @filter_ary, "? >= i1.shippingdate";
371 push @filter_vars, trim($form->{todate});
374 if ($form->{l_employee}) {
378 # prepare qty comparison for later filtering
379 my ($f_qty_op, $f_qty, $f_qty_base_unit);
380 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
381 $f_qty_op = $filter{qty_op};
382 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
383 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
386 map { $_ = "(${_})"; } @filter_ary;
388 # if of a property number or description is requested,
389 # automatically check the matching id too.
390 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
392 # customize shown entry for not available fields.
393 $filter{na} = '-' unless $filter{na};
395 # make order, search in $filter and $form
396 my $sort_col = $form->{sort};
397 my $sort_order = $form->{order};
399 $sort_col = $filter{sort} unless $sort_col;
400 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
401 $sort_col = 'shippingdate' if $sort_col eq 'date';
402 $sort_order = $filter{order} unless $sort_order;
403 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
405 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
407 $select_tokens{'trans'} = {
408 "parts_id" => "i1.parts_id",
409 "qty" => "ABS(SUM(i1.qty))",
410 "partnumber" => "p.partnumber",
411 "partdescription" => "p.description",
412 "bindescription" => "b.description",
413 "chargenumber" => "i1.chargenumber",
414 "bestbefore" => "i1.bestbefore",
415 "warehousedescription" => "w.description",
416 "partunit" => "p.unit",
417 "bin_from" => "b1.description",
418 "bin_to" => "b2.description",
419 "warehouse_from" => "w1.description",
420 "warehouse_to" => "w2.description",
421 "comment" => "i1.comment",
422 "trans_type" => "tt.description",
423 "trans_id" => "i1.trans_id",
424 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
425 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
426 "date" => "i1.shippingdate",
427 "itime" => "i1.itime",
428 "shippingdate" => "i1.shippingdate",
429 "employee" => "e.name",
430 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
433 $select_tokens{'out'} = {
434 "bin_to" => "'$filter{na}'",
435 "warehouse_to" => "'$filter{na}'",
438 $select_tokens{'in'} = {
439 "bin_from" => "'$filter{na}'",
440 "warehouse_from" => "'$filter{na}'",
443 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
445 # build the select clauses.
446 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
447 for my $i ('trans', 'out', 'in') {
448 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
449 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
452 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
453 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
455 $where_clause = defined($where_clause) ? $where_clause : '';
458 qq|SELECT DISTINCT $select{trans}
460 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
461 LEFT JOIN parts p ON i1.parts_id = p.id
462 LEFT JOIN bin b1 ON i1.bin_id = b1.id
463 LEFT JOIN bin b2 ON i2.bin_id = b2.id
464 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
465 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
466 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
467 LEFT JOIN project pr ON i1.project_id = pr.id
468 LEFT JOIN employee e ON i1.employee_id = e.id
469 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
470 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
471 GROUP BY $group_clause
475 SELECT DISTINCT $select{out}
477 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
478 LEFT JOIN parts p ON i1.parts_id = p.id
479 LEFT JOIN bin b1 ON i1.bin_id = b1.id
480 LEFT JOIN bin b2 ON i2.bin_id = b2.id
481 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
482 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
483 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
484 LEFT JOIN project pr ON i1.project_id = pr.id
485 LEFT JOIN employee e ON i1.employee_id = e.id
486 WHERE $where_clause i1.qty < 0 AND
487 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
488 GROUP BY $group_clause
492 SELECT DISTINCT $select{in}
494 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
495 LEFT JOIN parts p ON i1.parts_id = p.id
496 LEFT JOIN bin b1 ON i1.bin_id = b1.id
497 LEFT JOIN bin b2 ON i2.bin_id = b2.id
498 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
499 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
500 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
501 LEFT JOIN project pr ON i1.project_id = pr.id
502 LEFT JOIN employee e ON i1.employee_id = e.id
503 WHERE $where_clause i1.qty > 0 AND
504 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
505 GROUP BY $group_clause
506 ORDER BY r_${sort_spec}|;
508 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
510 my ($h_oe_id, $q_oe_id);
511 if ($form->{l_oe_id}) {
514 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
516 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
517 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
518 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
519 ELSE 'purchase_order'
526 SELECT dord.id AS id, dord.donumber AS number,
528 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
529 ELSE 'sales_delivery_order'
531 FROM delivery_orders dord
536 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
542 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
548 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
550 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
554 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
556 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
558 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
562 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
563 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
564 my $qty = $ref->{"qty"} * 1;
566 next unless ($qty > 0);
569 my $part_unit = $all_units->{$ref->{"partunit"}};
570 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
571 $qty *= $part_unit->{"factor"};
572 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
573 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
574 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
577 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
578 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
579 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
580 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
583 push @contents, $ref;
587 $h_oe_id->finish() if $h_oe_id;
589 $main::lxdebug->leave_sub();
595 # This sub is the primary function to retrieve information about items in warehouses.
596 # $filter is a hashref and supports the following keys:
597 # - warehouse_id - will return matches with this warehouse_id only
598 # - partnumber - will return only matches where the given string is a substring of the partnumber
599 # - partsid - will return matches with this parts_id only
600 # - description - will return only matches where the given string is a substring of the description
601 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
602 # - bestbefore - will return only matches with this bestbefore date
603 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
604 # - charge_ids - must be an arrayref. will return contents with these ids only
605 # - expires_in - will only return matches that expire within the given number of days
606 # will also add a column named 'has_expired' containing if the match has already expired or not
607 # - hazardous - will return matches with the flag hazardous only
608 # - oil - will return matches with the flag oil only
609 # - qty, qty_op - quantity filter (more info to come)
610 # - sort, order_by - sorting (more to come)
611 # - reservation - will provide an extra column containing the amount reserved of this match
612 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
614 sub get_warehouse_report {
615 $main::lxdebug->enter_sub();
620 my $myconfig = \%main::myconfig;
621 my $form = $main::form;
623 my $all_units = AM->retrieve_units($myconfig, $form);
625 # connect to database
626 my $dbh = $form->get_standard_dbh($myconfig);
629 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
631 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
633 if ($filter{warehouse_id}) {
634 push @wh_bin_filter_ary, "w.id = ?";
635 push @wh_bin_filter_vars, $filter{warehouse_id};
638 if ($filter{bin_id}) {
639 push @wh_bin_filter_ary, "b.id = ?";
640 push @wh_bin_filter_vars, $filter{bin_id};
643 push @filter_ary, @wh_bin_filter_ary;
644 push @filter_vars, @wh_bin_filter_vars;
646 if ($filter{partnumber}) {
647 push @filter_ary, "p.partnumber ILIKE ?";
648 push @filter_vars, like($filter{partnumber});
651 if ($filter{description}) {
652 push @filter_ary, "p.description ILIKE ?";
653 push @filter_vars, like($filter{description});
656 if ($filter{partsid}) {
657 push @filter_ary, "p.id = ?";
658 push @filter_vars, $filter{partsid};
661 if ($filter{chargenumber}) {
662 push @filter_ary, "i.chargenumber ILIKE ?";
663 push @filter_vars, like($filter{chargenumber});
666 if (trim($form->{bestbefore})) {
667 push @filter_ary, "?::DATE = i.bestbefore::DATE";
668 push @filter_vars, trim($form->{bestbefore});
672 push @filter_ary, "p.ean ILIKE ?";
673 push @filter_vars, like($filter{ean});
676 if (trim($filter{date})) {
677 push @filter_ary, "i.shippingdate <= ?";
678 push @filter_vars, trim($filter{date});
680 if (!$filter{include_invalid_warehouses}){
681 push @filter_ary, "NOT (w.invalid)";
684 # prepare qty comparison for later filtering
685 my ($f_qty_op, $f_qty, $f_qty_base_unit);
687 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
688 $f_qty_op = $filter{qty_op};
689 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
690 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
693 map { $_ = "(${_})"; } @filter_ary;
695 # if of a property number or description is requested,
696 # automatically check the matching id too.
697 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
699 # make order, search in $filter and $form
700 my $sort_col = $form->{sort};
701 my $sort_order = $form->{order};
703 $sort_col = $filter{sort} unless $sort_col;
704 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
705 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
706 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
707 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
708 # S.a. Bug 1597 jb 12.5.2011
709 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
710 $sort_order = $filter{order} unless $sort_order;
711 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
712 my $orderby = $sort_col;
713 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
715 my $where_clause = join " AND ", ("1=1", @filter_ary);
717 my %select_tokens = (
718 "parts_id" => "i.parts_id",
719 "qty" => "SUM(i.qty)",
720 "warehouseid" => "i.warehouse_id",
721 "partnumber" => "p.partnumber",
722 "partdescription" => "p.description",
723 "bindescription" => "b.description",
725 "chargenumber" => "i.chargenumber",
726 "bestbefore" => "i.bestbefore",
728 "chargeid" => "c.id",
729 "warehousedescription" => "w.description",
730 "partunit" => "p.unit",
731 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
733 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
734 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
735 qw(l_parts_id l_qty l_partunit) );
737 my $group_clause = join ", ", map { +/^l_/; "$'" }
738 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
739 qw(l_parts_id l_partunit) );
742 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
745 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
746 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
747 qw(l_parts_id l_qty l_partunit) );
750 qq|SELECT $select_clause
752 LEFT JOIN parts p ON i.parts_id = p.id
753 LEFT JOIN bin b ON i.bin_id = b.id
754 LEFT JOIN warehouse w ON i.warehouse_id = w.id
757 GROUP BY $group_clause
758 ORDER BY $sort_spec|;
760 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
762 my (%non_empty_bins, @all_fields, @contents);
764 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
766 my $qty = $ref->{qty};
768 next unless ($qty != 0);
771 my $part_unit = $all_units->{$ref->{partunit}};
772 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
773 $qty *= $part_unit->{factor};
774 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
775 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
776 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
779 if ($form->{include_empty_bins}) {
780 $non_empty_bins{$ref->{binid}} = 1;
781 @all_fields = keys %{ $ref } unless (@all_fields);
784 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
786 push @contents, $ref;
791 if ($form->{include_empty_bins}) {
794 w.id AS warehouseid, w.description AS warehousedescription,
795 b.id AS binid, b.description AS bindescription
797 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
799 @filter_ary = @wh_bin_filter_ary;
800 @filter_vars = @wh_bin_filter_vars;
802 my @non_empty_bin_ids = keys %non_empty_bins;
803 if (@non_empty_bin_ids) {
804 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
805 push @filter_vars, @non_empty_bin_ids;
808 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
810 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
812 while (my $ref = $sth->fetchrow_hashref()) {
813 map { $ref->{$_} ||= "" } @all_fields;
814 push @contents, $ref;
818 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
819 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
823 $main::lxdebug->leave_sub();
829 $main::lxdebug->enter_sub();
831 my ($self, $qty_op) = @_;
833 if (!$qty_op || ($qty_op eq "dontcare")) {
834 $main::lxdebug->leave_sub();
838 if ($qty_op eq "atleast") {
840 } elsif ($qty_op eq "atmost") {
846 $main::lxdebug->leave_sub();
851 sub retrieve_transfer_types {
852 $main::lxdebug->enter_sub();
855 my $direction = shift;
857 my $myconfig = \%main::myconfig;
858 my $form = $main::form;
860 my $dbh = $form->get_standard_dbh($myconfig);
862 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
864 $main::lxdebug->leave_sub();
869 sub get_basic_bin_info {
870 $main::lxdebug->enter_sub();
875 Common::check_params(\%params, qw(id));
877 my $myconfig = \%main::myconfig;
878 my $form = $main::form;
880 my $dbh = $params{dbh} || $form->get_standard_dbh();
882 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
885 qq|SELECT b.id AS bin_id, b.description AS bin_description,
886 w.id AS warehouse_id, w.description AS warehouse_description
888 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
889 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
891 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
893 if ('' eq ref $params{id}) {
894 $result = $result->[0] || { };
895 $main::lxdebug->leave_sub();
900 $main::lxdebug->leave_sub();
902 return map { $_->{bin_id} => $_ } @{ $result };
905 sub get_basic_warehouse_info {
906 $main::lxdebug->enter_sub();
911 Common::check_params(\%params, qw(id));
913 my $myconfig = \%main::myconfig;
914 my $form = $main::form;
916 my $dbh = $params{dbh} || $form->get_standard_dbh();
918 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
921 qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
923 WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
925 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
927 if ('' eq ref $params{id}) {
928 $result = $result->[0] || { };
929 $main::lxdebug->leave_sub();
934 $main::lxdebug->leave_sub();
936 return map { $_->{warehouse_id} => $_ } @{ $result };
939 # Eingabe: Teilenummer, Lagernummer (warehouse)
940 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
942 sub get_max_qty_parts {
943 $main::lxdebug->enter_sub();
948 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
950 my $myconfig = \%main::myconfig;
951 my $form = $main::form;
953 my $dbh = $params{dbh} || $form->get_standard_dbh();
955 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
956 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
959 my $max_qty_parts = 0; #Initialisierung mit 0
960 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
961 $max_qty_parts += $ref->{sum};
964 $main::lxdebug->leave_sub();
966 return $max_qty_parts;
970 # Eingabe: Teilenummer, Lagernummer (warehouse)
971 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
973 sub get_part_description {
974 $main::lxdebug->enter_sub();
979 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
981 my $myconfig = \%main::myconfig;
982 my $form = $main::form;
984 my $dbh = $params{dbh} || $form->get_standard_dbh();
986 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
988 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
990 my $ref = $sth->fetchrow_hashref();
991 my $part_description = $ref->{partnumber} . " " . $ref->{description};
993 $main::lxdebug->leave_sub();
995 return $part_description;
998 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
999 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
1000 # Bzw. Fehler, falls Chargen oder bestbefore
1001 # bei eingelagerten Teilen definiert sind.
1003 sub get_max_qty_parts_bin {
1004 $main::lxdebug->enter_sub();
1009 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
1011 my $myconfig = \%main::myconfig;
1012 my $form = $main::form;
1014 my $dbh = $params{dbh} || $form->get_standard_dbh();
1016 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
1017 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1019 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1021 my $max_qty_parts = 0; #Initialisierung mit 0
1022 # falls derselbe artikel mehrmals eingelagert ist
1023 # chargennummer, muss entsprechend händisch agiert werden
1026 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1027 $max_qty_parts += $ref->{sum};
1029 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1033 $main::lxdebug->leave_sub();
1035 return ($max_qty_parts, $error);
1044 SL::WH - Warehouse backend
1049 WH->transfer(\%params);
1053 Backend for kivitendo warehousing functions.
1057 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1059 This is the main function to manipulate warehouse contents. A typical transfer
1060 is called like this:
1065 transfer_type => 'transfer',
1066 src_warehouse_id => 12,
1068 dst_warehouse_id => 25,
1072 It will generate an entry in inventory representing the transfer. Note that
1073 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1074 a destination or a src is mandatory.
1076 transfer accepts more than one transaction parameter, each being a hash ref. If
1077 more than one is supplied, it is guaranteed, that all are processed in the same
1080 Here is a full list of parameters. All "_id" parameters except oe and
1081 orderitems can be called without id with RDB objects as well.
1087 The id of the article transferred. Does not check if the article is a service.
1092 Quantity of the transaction. Mandatory.
1096 Unit of the transaction. Optional.
1100 =item transfer_type_id
1102 The type of transaction. The first version is a string describing the
1103 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1104 every system), the id is the hard id of a transfer_type from the database.
1106 Depending of the direction of the transfer_type, source and/or destination must
1109 One of transfer_type or transfer_type_id is mandatory.
1111 =item src_warehouse_id
1115 Warehouse and bin from which to transfer. Mandatory in transfer and out
1116 directions. Ignored in in directions.
1118 =item dst_warehouse_id
1122 Warehouse and bin to which to transfer. Mandatory in transfer and in
1123 directions. Ignored in out directions.
1127 If given, the transfer will transfer only articles with this chargenumber.
1132 Reference to an orderitem for which this transfer happened. Optional
1136 Reference to an order for which this transfer happened. Optional
1140 An optional comment.
1144 An expiration date. Note that this is not by default used by C<warehouse_report>.