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 my $currentPart_WH_ID = $use_default_warehouse && $hash_ref->{warehouse_id} ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
217 # Prüfen ob Erzeugnis-Teile Standardlager haben.
218 if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {
219 # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.
220 if ($::instance_conf->get_transfer_default_ignore_onhand) {
221 $currentPart_WH_ID = $::instance_conf->get_warehouse_id_ignore_onhand;
224 $kannNichtFertigen .= "Kein Standardlager: " .
225 " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .
226 " hat kein Standardlager definiert " .
227 ", um das Erzeugnis herzustellen. <br>";
231 my $warehouse_info = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
232 my $warehouse_desc = $warehouse_info->{"warehouse_description"};
234 # Fertigen ohne Prüfung nach Bestand
236 my $temppart_bin_id = $::instance_conf->get_bin_id_ignore_onhand;
237 my $temppart_chargenumber = "";
238 my $temppart_bestbefore = localtime();
239 my $temppart_qty = $partsQTY * -1;
241 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
242 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
243 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
246 # Überprüfen, ob diese Anzahl gefertigt werden kann
247 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
248 warehouse_id => $currentPart_WH_ID);
250 if ($partsQTY > $max_parts){
251 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
252 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
254 $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
255 " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
256 " im Lager: " . $warehouse_desc .
257 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
258 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
261 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
262 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
263 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
264 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
265 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
266 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
268 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
269 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
270 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
272 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
273 my $tmpPartsQTY = $partsQTY;
275 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
276 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
277 my $temppart_chargenumber = $temphash_ref->{chargenumber};
278 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
279 my $temppart_qty = $temphash_ref->{sum};
281 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
282 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
283 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
284 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
285 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
286 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
287 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
288 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
289 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
290 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
292 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
293 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
294 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
295 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
296 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
298 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
299 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
300 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
301 last; # beendet die schleife (springt zum letzten element)
303 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
304 } #ende while select parts_id,qty from assembly where id = ?
306 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
307 # keine einzelteile definiert
308 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
309 Dementsprechend kann auch nichts hergestellt werden";
311 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
312 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
313 if ($kannNichtFertigen) {
314 return $kannNichtFertigen;
317 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
318 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
319 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
320 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
321 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
322 (select current_date))|;
323 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
324 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
325 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
328 $main::lxdebug->leave_sub();
329 return 1; # Alles erfolgreich
332 sub get_warehouse_journal {
333 $main::lxdebug->enter_sub();
338 my $myconfig = \%main::myconfig;
339 my $form = $main::form;
341 my $all_units = AM->retrieve_units($myconfig, $form);
343 # connect to database
344 my $dbh = $form->get_standard_dbh($myconfig);
347 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
349 if ($filter{warehouse_id}) {
350 push @filter_ary, "w1.id = ? OR w2.id = ?";
351 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
354 if ($filter{bin_id}) {
355 push @filter_ary, "b1.id = ? OR b2.id = ?";
356 push @filter_vars, $filter{bin_id}, $filter{bin_id};
359 if ($filter{partnumber}) {
360 push @filter_ary, "p.partnumber ILIKE ?";
361 push @filter_vars, like($filter{partnumber});
364 if ($filter{description}) {
365 push @filter_ary, "(p.description ILIKE ?)";
366 push @filter_vars, like($filter{description});
369 if ($filter{chargenumber}) {
370 push @filter_ary, "i1.chargenumber ILIKE ?";
371 push @filter_vars, like($filter{chargenumber});
374 if (trim($form->{bestbefore})) {
375 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
376 push @filter_vars, trim($form->{bestbefore});
379 if (trim($form->{fromdate})) {
380 push @filter_ary, "? <= i1.shippingdate";
381 push @filter_vars, trim($form->{fromdate});
384 if (trim($form->{todate})) {
385 push @filter_ary, "? >= i1.shippingdate";
386 push @filter_vars, trim($form->{todate});
389 if ($form->{l_employee}) {
393 # prepare qty comparison for later filtering
394 my ($f_qty_op, $f_qty, $f_qty_base_unit);
395 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
396 $f_qty_op = $filter{qty_op};
397 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
398 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
401 map { $_ = "(${_})"; } @filter_ary;
403 # if of a property number or description is requested,
404 # automatically check the matching id too.
405 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
407 # customize shown entry for not available fields.
408 $filter{na} = '-' unless $filter{na};
410 # make order, search in $filter and $form
411 my $sort_col = $form->{sort};
412 my $sort_order = $form->{order};
414 $sort_col = $filter{sort} unless $sort_col;
415 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
416 $sort_col = 'shippingdate' if $sort_col eq 'date';
417 $sort_order = $filter{order} unless $sort_order;
418 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
420 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
422 $select_tokens{'trans'} = {
423 "parts_id" => "i1.parts_id",
424 "qty" => "ABS(SUM(i1.qty))",
425 "partnumber" => "p.partnumber",
426 "partdescription" => "p.description",
427 "bindescription" => "b.description",
428 "chargenumber" => "i1.chargenumber",
429 "bestbefore" => "i1.bestbefore",
430 "warehousedescription" => "w.description",
431 "partunit" => "p.unit",
432 "bin_from" => "b1.description",
433 "bin_to" => "b2.description",
434 "warehouse_from" => "w1.description",
435 "warehouse_to" => "w2.description",
436 "comment" => "i1.comment",
437 "trans_type" => "tt.description",
438 "trans_id" => "i1.trans_id",
439 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
440 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
441 "date" => "i1.shippingdate",
442 "itime" => "i1.itime",
443 "shippingdate" => "i1.shippingdate",
444 "employee" => "e.name",
445 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
448 $select_tokens{'out'} = {
449 "bin_to" => "'$filter{na}'",
450 "warehouse_to" => "'$filter{na}'",
453 $select_tokens{'in'} = {
454 "bin_from" => "'$filter{na}'",
455 "warehouse_from" => "'$filter{na}'",
458 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
460 # build the select clauses.
461 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
462 for my $i ('trans', 'out', 'in') {
463 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
464 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
467 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
468 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
470 $where_clause = defined($where_clause) ? $where_clause : '';
473 qq|SELECT DISTINCT $select{trans}
475 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
476 LEFT JOIN parts p ON i1.parts_id = p.id
477 LEFT JOIN bin b1 ON i1.bin_id = b1.id
478 LEFT JOIN bin b2 ON i2.bin_id = b2.id
479 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
480 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
481 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
482 LEFT JOIN project pr ON i1.project_id = pr.id
483 LEFT JOIN employee e ON i1.employee_id = e.id
484 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
485 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
486 GROUP BY $group_clause
490 SELECT DISTINCT $select{out}
492 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
493 LEFT JOIN parts p ON i1.parts_id = p.id
494 LEFT JOIN bin b1 ON i1.bin_id = b1.id
495 LEFT JOIN bin b2 ON i2.bin_id = b2.id
496 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
497 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
498 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
499 LEFT JOIN project pr ON i1.project_id = pr.id
500 LEFT JOIN employee e ON i1.employee_id = e.id
501 WHERE $where_clause i1.qty < 0 AND
502 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
503 GROUP BY $group_clause
507 SELECT DISTINCT $select{in}
509 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
510 LEFT JOIN parts p ON i1.parts_id = p.id
511 LEFT JOIN bin b1 ON i1.bin_id = b1.id
512 LEFT JOIN bin b2 ON i2.bin_id = b2.id
513 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
514 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
515 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
516 LEFT JOIN project pr ON i1.project_id = pr.id
517 LEFT JOIN employee e ON i1.employee_id = e.id
518 WHERE $where_clause i1.qty > 0 AND
519 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
520 GROUP BY $group_clause
521 ORDER BY r_${sort_spec}|;
523 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
525 my ($h_oe_id, $q_oe_id);
526 if ($form->{l_oe_id}) {
529 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
531 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
532 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
533 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
534 ELSE 'purchase_order'
541 SELECT dord.id AS id, dord.donumber AS number,
543 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
544 ELSE 'sales_delivery_order'
546 FROM delivery_orders dord
551 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
557 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
563 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
565 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
569 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
571 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
573 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
577 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
578 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
579 my $qty = $ref->{"qty"} * 1;
581 next unless ($qty > 0);
584 my $part_unit = $all_units->{$ref->{"partunit"}};
585 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
586 $qty *= $part_unit->{"factor"};
587 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
588 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
589 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
592 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
593 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
594 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
595 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
598 push @contents, $ref;
602 $h_oe_id->finish() if $h_oe_id;
604 $main::lxdebug->leave_sub();
610 # This sub is the primary function to retrieve information about items in warehouses.
611 # $filter is a hashref and supports the following keys:
612 # - warehouse_id - will return matches with this warehouse_id only
613 # - partnumber - will return only matches where the given string is a substring of the partnumber
614 # - partsid - will return matches with this parts_id only
615 # - description - will return only matches where the given string is a substring of the description
616 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
617 # - bestbefore - will return only matches with this bestbefore date
618 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
619 # - charge_ids - must be an arrayref. will return contents with these ids only
620 # - expires_in - will only return matches that expire within the given number of days
621 # will also add a column named 'has_expired' containing if the match has already expired or not
622 # - hazardous - will return matches with the flag hazardous only
623 # - oil - will return matches with the flag oil only
624 # - qty, qty_op - quantity filter (more info to come)
625 # - sort, order_by - sorting (more to come)
626 # - reservation - will provide an extra column containing the amount reserved of this match
627 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
629 sub get_warehouse_report {
630 $main::lxdebug->enter_sub();
635 my $myconfig = \%main::myconfig;
636 my $form = $main::form;
638 my $all_units = AM->retrieve_units($myconfig, $form);
640 # connect to database
641 my $dbh = $form->get_standard_dbh($myconfig);
644 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
646 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
648 if ($filter{warehouse_id}) {
649 push @wh_bin_filter_ary, "w.id = ?";
650 push @wh_bin_filter_vars, $filter{warehouse_id};
653 if ($filter{bin_id}) {
654 push @wh_bin_filter_ary, "b.id = ?";
655 push @wh_bin_filter_vars, $filter{bin_id};
658 push @filter_ary, @wh_bin_filter_ary;
659 push @filter_vars, @wh_bin_filter_vars;
661 if ($filter{partnumber}) {
662 push @filter_ary, "p.partnumber ILIKE ?";
663 push @filter_vars, like($filter{partnumber});
666 if ($filter{description}) {
667 push @filter_ary, "p.description ILIKE ?";
668 push @filter_vars, like($filter{description});
671 if ($filter{partsid}) {
672 push @filter_ary, "p.id = ?";
673 push @filter_vars, $filter{partsid};
676 if ($filter{chargenumber}) {
677 push @filter_ary, "i.chargenumber ILIKE ?";
678 push @filter_vars, like($filter{chargenumber});
681 if (trim($form->{bestbefore})) {
682 push @filter_ary, "?::DATE = i.bestbefore::DATE";
683 push @filter_vars, trim($form->{bestbefore});
687 push @filter_ary, "p.ean ILIKE ?";
688 push @filter_vars, like($filter{ean});
691 if (trim($filter{date})) {
692 push @filter_ary, "i.shippingdate <= ?";
693 push @filter_vars, trim($filter{date});
695 if (!$filter{include_invalid_warehouses}){
696 push @filter_ary, "NOT (w.invalid)";
699 # prepare qty comparison for later filtering
700 my ($f_qty_op, $f_qty, $f_qty_base_unit);
702 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
703 $f_qty_op = $filter{qty_op};
704 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
705 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
708 map { $_ = "(${_})"; } @filter_ary;
710 # if of a property number or description is requested,
711 # automatically check the matching id too.
712 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
714 # make order, search in $filter and $form
715 my $sort_col = $form->{sort};
716 my $sort_order = $form->{order};
718 $sort_col = $filter{sort} unless $sort_col;
719 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
720 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
721 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
722 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
723 # S.a. Bug 1597 jb 12.5.2011
724 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
725 $sort_order = $filter{order} unless $sort_order;
726 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
727 my $orderby = $sort_col;
728 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
730 my $where_clause = join " AND ", ("1=1", @filter_ary);
732 my %select_tokens = (
733 "parts_id" => "i.parts_id",
734 "qty" => "SUM(i.qty)",
735 "warehouseid" => "i.warehouse_id",
736 "partnumber" => "p.partnumber",
737 "partdescription" => "p.description",
738 "bindescription" => "b.description",
740 "chargenumber" => "i.chargenumber",
741 "bestbefore" => "i.bestbefore",
743 "chargeid" => "c.id",
744 "warehousedescription" => "w.description",
745 "partunit" => "p.unit",
746 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
748 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
749 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
750 qw(l_parts_id l_qty l_partunit) );
752 my $group_clause = join ", ", map { +/^l_/; "$'" }
753 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
754 qw(l_parts_id l_partunit) );
757 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
760 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
761 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
762 qw(l_parts_id l_qty l_partunit) );
765 qq|SELECT $select_clause
767 LEFT JOIN parts p ON i.parts_id = p.id
768 LEFT JOIN bin b ON i.bin_id = b.id
769 LEFT JOIN warehouse w ON i.warehouse_id = w.id
772 GROUP BY $group_clause
773 ORDER BY $sort_spec|;
775 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
777 my (%non_empty_bins, @all_fields, @contents);
779 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
781 my $qty = $ref->{qty};
783 next unless ($qty != 0);
786 my $part_unit = $all_units->{$ref->{partunit}};
787 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
788 $qty *= $part_unit->{factor};
789 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
790 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
791 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
794 if ($form->{include_empty_bins}) {
795 $non_empty_bins{$ref->{binid}} = 1;
796 @all_fields = keys %{ $ref } unless (@all_fields);
799 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
801 push @contents, $ref;
806 if ($form->{include_empty_bins}) {
809 w.id AS warehouseid, w.description AS warehousedescription,
810 b.id AS binid, b.description AS bindescription
812 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
814 @filter_ary = @wh_bin_filter_ary;
815 @filter_vars = @wh_bin_filter_vars;
817 my @non_empty_bin_ids = keys %non_empty_bins;
818 if (@non_empty_bin_ids) {
819 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
820 push @filter_vars, @non_empty_bin_ids;
823 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
825 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
827 while (my $ref = $sth->fetchrow_hashref()) {
828 map { $ref->{$_} ||= "" } @all_fields;
829 push @contents, $ref;
833 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
834 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
838 $main::lxdebug->leave_sub();
844 $main::lxdebug->enter_sub();
846 my ($self, $qty_op) = @_;
848 if (!$qty_op || ($qty_op eq "dontcare")) {
849 $main::lxdebug->leave_sub();
853 if ($qty_op eq "atleast") {
855 } elsif ($qty_op eq "atmost") {
861 $main::lxdebug->leave_sub();
866 sub retrieve_transfer_types {
867 $main::lxdebug->enter_sub();
870 my $direction = shift;
872 my $myconfig = \%main::myconfig;
873 my $form = $main::form;
875 my $dbh = $form->get_standard_dbh($myconfig);
877 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
879 $main::lxdebug->leave_sub();
884 sub get_basic_bin_info {
885 $main::lxdebug->enter_sub();
890 Common::check_params(\%params, qw(id));
892 my $myconfig = \%main::myconfig;
893 my $form = $main::form;
895 my $dbh = $params{dbh} || $form->get_standard_dbh();
897 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
900 qq|SELECT b.id AS bin_id, b.description AS bin_description,
901 w.id AS warehouse_id, w.description AS warehouse_description
903 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
904 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
906 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
908 if ('' eq ref $params{id}) {
909 $result = $result->[0] || { };
910 $main::lxdebug->leave_sub();
915 $main::lxdebug->leave_sub();
917 return map { $_->{bin_id} => $_ } @{ $result };
920 sub get_basic_warehouse_info {
921 $main::lxdebug->enter_sub();
926 Common::check_params(\%params, qw(id));
928 my $myconfig = \%main::myconfig;
929 my $form = $main::form;
931 my $dbh = $params{dbh} || $form->get_standard_dbh();
933 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
936 qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
938 WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
940 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
942 if ('' eq ref $params{id}) {
943 $result = $result->[0] || { };
944 $main::lxdebug->leave_sub();
949 $main::lxdebug->leave_sub();
951 return map { $_->{warehouse_id} => $_ } @{ $result };
954 # Eingabe: Teilenummer, Lagernummer (warehouse)
955 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
957 sub get_max_qty_parts {
958 $main::lxdebug->enter_sub();
963 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
965 my $myconfig = \%main::myconfig;
966 my $form = $main::form;
968 my $dbh = $params{dbh} || $form->get_standard_dbh();
970 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
971 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
974 my $max_qty_parts = 0; #Initialisierung mit 0
975 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
976 $max_qty_parts += $ref->{sum};
979 $main::lxdebug->leave_sub();
981 return $max_qty_parts;
985 # Eingabe: Teilenummer, Lagernummer (warehouse)
986 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
988 sub get_part_description {
989 $main::lxdebug->enter_sub();
994 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
996 my $myconfig = \%main::myconfig;
997 my $form = $main::form;
999 my $dbh = $params{dbh} || $form->get_standard_dbh();
1001 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
1003 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
1005 my $ref = $sth->fetchrow_hashref();
1006 my $part_description = $ref->{partnumber} . " " . $ref->{description};
1008 $main::lxdebug->leave_sub();
1010 return $part_description;
1013 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
1014 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
1015 # Bzw. Fehler, falls Chargen oder bestbefore
1016 # bei eingelagerten Teilen definiert sind.
1018 sub get_max_qty_parts_bin {
1019 $main::lxdebug->enter_sub();
1024 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
1026 my $myconfig = \%main::myconfig;
1027 my $form = $main::form;
1029 my $dbh = $params{dbh} || $form->get_standard_dbh();
1031 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
1032 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1034 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1036 my $max_qty_parts = 0; #Initialisierung mit 0
1037 # falls derselbe artikel mehrmals eingelagert ist
1038 # chargennummer, muss entsprechend händisch agiert werden
1041 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1042 $max_qty_parts += $ref->{sum};
1044 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1048 $main::lxdebug->leave_sub();
1050 return ($max_qty_parts, $error);
1059 SL::WH - Warehouse backend
1064 WH->transfer(\%params);
1068 Backend for kivitendo warehousing functions.
1072 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1074 This is the main function to manipulate warehouse contents. A typical transfer
1075 is called like this:
1080 transfer_type => 'transfer',
1081 src_warehouse_id => 12,
1083 dst_warehouse_id => 25,
1087 It will generate an entry in inventory representing the transfer. Note that
1088 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1089 a destination or a src is mandatory.
1091 transfer accepts more than one transaction parameter, each being a hash ref. If
1092 more than one is supplied, it is guaranteed, that all are processed in the same
1095 Here is a full list of parameters. All "_id" parameters except oe and
1096 orderitems can be called without id with RDB objects as well.
1102 The id of the article transferred. Does not check if the article is a service.
1107 Quantity of the transaction. Mandatory.
1111 Unit of the transaction. Optional.
1115 =item transfer_type_id
1117 The type of transaction. The first version is a string describing the
1118 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1119 every system), the id is the hard id of a transfer_type from the database.
1121 Depending of the direction of the transfer_type, source and/or destination must
1124 One of transfer_type or transfer_type_id is mandatory.
1126 =item src_warehouse_id
1130 Warehouse and bin from which to transfer. Mandatory in transfer and out
1131 directions. Ignored in in directions.
1133 =item dst_warehouse_id
1137 Warehouse and bin to which to transfer. Mandatory in transfer and in
1138 directions. Ignored in out directions.
1142 If given, the transfer will transfer only articles with this chargenumber.
1147 Reference to an orderitem for which this transfer happened. Optional
1151 Reference to an order for which this transfer happened. Optional
1155 An optional comment.
1159 An expiration date. Note that this is not by default used by C<warehouse_report>.
1163 =head2 create_assembly \%PARAMS, [ \%PARAMS, ... ]
1165 Creates an assembly if all defined items are available.
1167 Assembly item(s) will be stocked out and the assembly will be stocked in,
1168 taking into account the qty and units which can be defined for each
1169 assembly item seperately.
1171 The calling params originate from C<transfer> but only parts_id with the
1172 attribute assembly are processed.
1174 The typical params would be:
1177 'login' => $::myconfig{login},
1178 'dst_warehouse_id' => $form->{warehouse_id},
1179 'dst_bin_id' => $form->{bin_id},
1180 'chargenumber' => $form->{chargenumber},
1181 'bestbefore' => $form->{bestbefore},
1182 'assembly_id' => $form->{parts_id},
1183 'qty' => $form->{qty},
1184 'comment' => $form->{comment}
1187 =head3 Prerequisites
1189 All of these prerequisites have to be trueish, otherwise the function will exit
1190 unsuccessfully with a return value of undef.
1194 =item Mandantory params
1196 assembly_id, qty, login, dst_warehouse_id and dst_bin_id are mandatory.
1198 =item Subset named 'Assembly' of data set 'Part'
1200 assembly_id has to be an id in the table parts with the valid subset assembly.
1202 =item Assembly is composed of assembly item(s)
1204 There has to be at least one data set in the table assembly referenced to this assembly_id.
1206 =item Assembly cannot be destroyed or disassembled
1208 Assemblies are like cakes. You cannot disassemble it. NEVER.
1209 No negative nor zero qty's are valid inputs.
1211 =item The assembly item(s) have to be in the same warehouse
1213 inventory.warehouse_id equals dst_warehouse_id (client configurable).
1215 =item The assembly item(s) have to be in stock with the qty needed
1217 I can only make a cake by receipt if I have ALL ingredients and
1218 in the needed stock amount.
1219 The qty of stocked in assembly item(s) has to fit into the
1220 number of the qty of the assemblies, which are going to be created (client configurable).
1222 =item assembly item(s) with the parts set 'service' are ignored
1224 The subset 'Services' of part will not transferred for assembly item(s).
1228 Client configurable prerequisites can be changed with different
1229 prerequisites as described in client_config (s.a. next chapter).
1232 =head2 default creation of assembly
1234 The valid state of the assembly item(s) used for the assembly process are
1235 'out' for the general direction and 'used' as the specific reason.
1236 The valid state of the assembly is 'in' for the direction and 'assembled'
1237 as the specific reason.
1239 The method is transaction safe, in case of errors not a single entry will be made
1242 Two prerequisites can be changed with this global parameters
1246 =item $::instance_conf->get_transfer_default_warehouse_for_assembly
1248 If trueish we try to get all the items form the default bins defined in parts
1249 and do not try to find them in the destination warehouse. Returns an
1250 error if not all items have set a default bin in parts.
1252 =item $::instance_conf->get_bin_id_ignore_onhand
1254 If trueish we can create assemblies even if we do not have enough items in stock.
1255 The needed qty will be booked in a special bin, which has to be configured in