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 $kannNichtFertigen =""; # Falls leer dann erfolgreich
168 SL::DB->client->with_transaction(sub {
169 my $dbh = $params{dbh} || SL::DB->client->dbh;
173 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
174 # select parts_id,qty from assembly where id=1064;
175 # Erweiterung für bug 935 am 23.4.09 -
176 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
177 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
178 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
180 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
181 # wenn assembly nicht überprüft wird ...
182 # patch von joachim eingespielt 24.4.2009:
183 # my $query = qq|select parts_id,qty from assembly inner join parts
184 # on assembly.parts_id = parts.id where assembly.id = ? and
185 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
187 # Lager in dem die Bestandteile gesucht werden kann entweder das Ziellager sein oder ist per Mandantenkonfig
188 # auf das Standardlager des Bestandteiles schaltbar
190 my $use_default_warehouse = $::instance_conf->get_transfer_default_warehouse_for_assembly;
192 my $query = qq|SELECT assembly.parts_id, assembly.qty, parts.warehouse_id
193 FROM assembly INNER JOIN parts ON assembly.parts_id = parts.id
194 WHERE assembly.id = ? AND parts.part_type != 'service'|;
196 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
198 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
199 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
200 trans_id, trans_type_id, shippingdate)
201 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
202 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
203 (SELECT current_date))|;
204 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
206 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
208 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
209 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
210 $schleife_durchlaufen=1; # Erzeugnis definiert
212 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
213 my $currentPart_ID = $hash_ref->{parts_id};
215 my $currentPart_WH_ID = $use_default_warehouse && $hash_ref->{warehouse_id} ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
218 # Prüfen ob Erzeugnis-Teile Standardlager haben.
219 if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {
220 # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.
221 if ($::instance_conf->get_transfer_default_ignore_onhand) {
222 $currentPart_WH_ID = $::instance_conf->get_warehouse_id_ignore_onhand;
225 $kannNichtFertigen .= "Kein Standardlager: " .
226 " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .
227 " hat kein Standardlager definiert " .
228 ", um das Erzeugnis herzustellen. <br>";
232 my $warehouse_info = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
233 my $warehouse_desc = $warehouse_info->{"warehouse_description"};
235 # Fertigen ohne Prüfung nach Bestand
237 my $temppart_bin_id = $::instance_conf->get_bin_id_ignore_onhand;
238 my $temppart_chargenumber = "";
239 my $temppart_bestbefore = localtime();
240 my $temppart_qty = $partsQTY * -1;
242 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
243 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
244 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
247 # Überprüfen, ob diese Anzahl gefertigt werden kann
248 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
249 warehouse_id => $currentPart_WH_ID);
251 if ($partsQTY > $max_parts){
252 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
253 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
255 $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
256 " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
257 " im Lager: " . $warehouse_desc .
258 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
259 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
262 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
263 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
264 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
265 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
266 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
267 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
269 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
270 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
271 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
273 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
274 my $tmpPartsQTY = $partsQTY;
276 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
277 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
278 my $temppart_chargenumber = $temphash_ref->{chargenumber};
279 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
280 my $temppart_qty = $temphash_ref->{sum};
282 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
283 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
284 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
285 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
286 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
287 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
288 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
289 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
290 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
291 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
293 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
294 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
295 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
296 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
297 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
299 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
300 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
301 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
302 last; # beendet die schleife (springt zum letzten element)
304 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
305 } #ende while select parts_id,qty from assembly where id = ?
307 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
308 # keine einzelteile definiert
309 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
310 Dementsprechend kann auch nichts hergestellt werden";
312 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
313 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
314 if ($kannNichtFertigen) {
318 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
319 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
320 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
321 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
322 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
323 (select current_date))|;
324 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
325 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
326 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
328 }) or do { return $kannNichtFertigen };
330 $main::lxdebug->leave_sub();
331 return 1; # Alles erfolgreich
334 sub get_warehouse_journal {
335 $main::lxdebug->enter_sub();
340 my $myconfig = \%main::myconfig;
341 my $form = $main::form;
343 my $all_units = AM->retrieve_units($myconfig, $form);
345 # connect to database
346 my $dbh = $form->get_standard_dbh($myconfig);
349 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
351 if ($filter{warehouse_id}) {
352 push @filter_ary, "w1.id = ? OR w2.id = ?";
353 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
356 if ($filter{bin_id}) {
357 push @filter_ary, "b1.id = ? OR b2.id = ?";
358 push @filter_vars, $filter{bin_id}, $filter{bin_id};
361 if ($filter{partnumber}) {
362 push @filter_ary, "p.partnumber ILIKE ?";
363 push @filter_vars, like($filter{partnumber});
366 if ($filter{description}) {
367 push @filter_ary, "(p.description ILIKE ?)";
368 push @filter_vars, like($filter{description});
371 if ($filter{classification_id}) {
372 push @filter_ary, "p.classification_id = ?";
373 push @filter_vars, $filter{classification_id};
376 if ($filter{chargenumber}) {
377 push @filter_ary, "i1.chargenumber ILIKE ?";
378 push @filter_vars, like($filter{chargenumber});
381 if (trim($form->{bestbefore})) {
382 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
383 push @filter_vars, trim($form->{bestbefore});
386 if (trim($form->{fromdate})) {
387 push @filter_ary, "? <= i1.shippingdate";
388 push @filter_vars, trim($form->{fromdate});
391 if (trim($form->{todate})) {
392 push @filter_ary, "? >= i1.shippingdate";
393 push @filter_vars, trim($form->{todate});
396 if ($form->{l_employee}) {
400 # prepare qty comparison for later filtering
401 my ($f_qty_op, $f_qty, $f_qty_base_unit);
402 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
403 $f_qty_op = $filter{qty_op};
404 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
405 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
408 map { $_ = "(${_})"; } @filter_ary;
410 # if of a property number or description is requested,
411 # automatically check the matching id too.
412 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
414 # customize shown entry for not available fields.
415 $filter{na} = '-' unless $filter{na};
417 # make order, search in $filter and $form
418 my $sort_col = $form->{sort};
419 my $sort_order = $form->{order};
421 $sort_col = $filter{sort} unless $sort_col;
422 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
423 $sort_col = 'shippingdate' if $sort_col eq 'date';
424 $sort_order = $filter{order} unless $sort_order;
425 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
427 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
429 $select_tokens{'trans'} = {
430 "parts_id" => "i1.parts_id",
431 "qty" => "ABS(SUM(i1.qty))",
432 "partnumber" => "p.partnumber",
433 "partdescription" => "p.description",
434 "classification_id" => "p.classification_id",
435 "assembly" => "p.assembly",
436 "inventory_accno_id" => "p.inventory_accno_id",
437 "bindescription" => "b.description",
438 "chargenumber" => "i1.chargenumber",
439 "bestbefore" => "i1.bestbefore",
440 "warehousedescription" => "w.description",
441 "partunit" => "p.unit",
442 "bin_from" => "b1.description",
443 "bin_to" => "b2.description",
444 "warehouse_from" => "w1.description",
445 "warehouse_to" => "w2.description",
446 "comment" => "i1.comment",
447 "trans_type" => "tt.description",
448 "trans_id" => "i1.trans_id",
449 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
450 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
451 "date" => "i1.shippingdate",
452 "itime" => "i1.itime",
453 "shippingdate" => "i1.shippingdate",
454 "employee" => "e.name",
455 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
458 $select_tokens{'out'} = {
459 "bin_to" => "'$filter{na}'",
460 "warehouse_to" => "'$filter{na}'",
463 $select_tokens{'in'} = {
464 "bin_from" => "'$filter{na}'",
465 "warehouse_from" => "'$filter{na}'",
468 $form->{l_classification_id} = 'Y';
469 $form->{l_assembly} = 'Y';
470 $form->{l_inventory_accno_id} = 'Y';
471 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
473 # build the select clauses.
474 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
475 for my $i ('trans', 'out', 'in') {
476 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
477 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
480 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
481 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
483 $where_clause = defined($where_clause) ? $where_clause : '';
486 qq|SELECT DISTINCT $select{trans}
488 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
489 LEFT JOIN parts p ON i1.parts_id = p.id
490 LEFT JOIN bin b1 ON i1.bin_id = b1.id
491 LEFT JOIN bin b2 ON i2.bin_id = b2.id
492 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
493 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
494 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
495 LEFT JOIN project pr ON i1.project_id = pr.id
496 LEFT JOIN employee e ON i1.employee_id = e.id
497 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
498 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
499 GROUP BY $group_clause
503 SELECT DISTINCT $select{out}
505 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
506 LEFT JOIN parts p ON i1.parts_id = p.id
507 LEFT JOIN bin b1 ON i1.bin_id = b1.id
508 LEFT JOIN bin b2 ON i2.bin_id = b2.id
509 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
510 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
511 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
512 LEFT JOIN project pr ON i1.project_id = pr.id
513 LEFT JOIN employee e ON i1.employee_id = e.id
514 WHERE $where_clause i1.qty < 0 AND
515 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
516 GROUP BY $group_clause
520 SELECT DISTINCT $select{in}
522 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
523 LEFT JOIN parts p ON i1.parts_id = p.id
524 LEFT JOIN bin b1 ON i1.bin_id = b1.id
525 LEFT JOIN bin b2 ON i2.bin_id = b2.id
526 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
527 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
528 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
529 LEFT JOIN project pr ON i1.project_id = pr.id
530 LEFT JOIN employee e ON i1.employee_id = e.id
531 WHERE $where_clause i1.qty > 0 AND
532 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
533 GROUP BY $group_clause
534 ORDER BY r_${sort_spec}|;
536 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
538 my ($h_oe_id, $q_oe_id);
539 if ($form->{l_oe_id}) {
542 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
544 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
545 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
546 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
547 ELSE 'purchase_order'
554 SELECT dord.id AS id, dord.donumber AS number,
556 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
557 ELSE 'sales_delivery_order'
559 FROM delivery_orders dord
564 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
570 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
576 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
578 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
582 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
584 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
586 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
590 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
591 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
592 my $qty = $ref->{"qty"} * 1;
594 next unless ($qty > 0);
597 my $part_unit = $all_units->{$ref->{"partunit"}};
598 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
599 $qty *= $part_unit->{"factor"};
600 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
601 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
602 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
605 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
606 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
607 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
608 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
611 push @contents, $ref;
615 $h_oe_id->finish() if $h_oe_id;
617 $main::lxdebug->leave_sub();
623 # This sub is the primary function to retrieve information about items in warehouses.
624 # $filter is a hashref and supports the following keys:
625 # - warehouse_id - will return matches with this warehouse_id only
626 # - partnumber - will return only matches where the given string is a substring of the partnumber
627 # - partsid - will return matches with this parts_id only
628 # - classification_id - will return matches with this parts with this classification only
629 # - description - will return only matches where the given string is a substring of the description
630 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
631 # - bestbefore - will return only matches with this bestbefore date
632 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
633 # - charge_ids - must be an arrayref. will return contents with these ids only
634 # - expires_in - will only return matches that expire within the given number of days
635 # will also add a column named 'has_expired' containing if the match has already expired or not
636 # - hazardous - will return matches with the flag hazardous only
637 # - oil - will return matches with the flag oil only
638 # - qty, qty_op - quantity filter (more info to come)
639 # - sort, order_by - sorting (more to come)
640 # - reservation - will provide an extra column containing the amount reserved of this match
641 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
643 sub get_warehouse_report {
644 $main::lxdebug->enter_sub();
649 my $myconfig = \%main::myconfig;
650 my $form = $main::form;
652 my $all_units = AM->retrieve_units($myconfig, $form);
654 # connect to database
655 my $dbh = $form->get_standard_dbh($myconfig);
658 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
660 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
662 if ($filter{warehouse_id}) {
663 push @wh_bin_filter_ary, "w.id = ?";
664 push @wh_bin_filter_vars, $filter{warehouse_id};
667 if ($filter{bin_id}) {
668 push @wh_bin_filter_ary, "b.id = ?";
669 push @wh_bin_filter_vars, $filter{bin_id};
672 push @filter_ary, @wh_bin_filter_ary;
673 push @filter_vars, @wh_bin_filter_vars;
675 if ($filter{partnumber}) {
676 push @filter_ary, "p.partnumber ILIKE ?";
677 push @filter_vars, like($filter{partnumber});
680 if ($filter{classification_id}) {
681 push @filter_ary, "p.classification_id = ?";
682 push @filter_vars, $filter{classification_id};
685 if ($filter{description}) {
686 push @filter_ary, "p.description ILIKE ?";
687 push @filter_vars, like($filter{description});
690 if ($filter{partsid}) {
691 push @filter_ary, "p.id = ?";
692 push @filter_vars, $filter{partsid};
695 if ($filter{chargenumber}) {
696 push @filter_ary, "i.chargenumber ILIKE ?";
697 push @filter_vars, like($filter{chargenumber});
700 if (trim($form->{bestbefore})) {
701 push @filter_ary, "?::DATE = i.bestbefore::DATE";
702 push @filter_vars, trim($form->{bestbefore});
706 push @filter_ary, "p.ean ILIKE ?";
707 push @filter_vars, like($filter{ean});
710 if (trim($filter{date})) {
711 push @filter_ary, "i.shippingdate <= ?";
712 push @filter_vars, trim($filter{date});
714 if (!$filter{include_invalid_warehouses}){
715 push @filter_ary, "NOT (w.invalid)";
718 # prepare qty comparison for later filtering
719 my ($f_qty_op, $f_qty, $f_qty_base_unit);
721 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
722 $f_qty_op = $filter{qty_op};
723 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
724 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
727 map { $_ = "(${_})"; } @filter_ary;
729 # if of a property number or description is requested,
730 # automatically check the matching id too.
731 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
733 # make order, search in $filter and $form
734 my $sort_col = $form->{sort};
735 my $sort_order = $form->{order};
737 $sort_col = $filter{sort} unless $sort_col;
738 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
739 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
740 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
741 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
742 # S.a. Bug 1597 jb 12.5.2011
743 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
744 $sort_order = $filter{order} unless $sort_order;
745 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
746 my $orderby = $sort_col;
747 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
749 my $where_clause = join " AND ", ("1=1", @filter_ary);
751 my %select_tokens = (
752 "parts_id" => "i.parts_id",
753 "qty" => "SUM(i.qty)",
754 "warehouseid" => "i.warehouse_id",
755 "partnumber" => "p.partnumber",
756 "partdescription" => "p.description",
757 "classification_id" => "p.classification_id",
758 "assembly" => "p.assembly",
759 "inventory_accno_id" => "p.inventory_accno_id",
760 "bindescription" => "b.description",
762 "chargenumber" => "i.chargenumber",
763 "bestbefore" => "i.bestbefore",
765 "chargeid" => "c.id",
766 "warehousedescription" => "w.description",
767 "partunit" => "p.unit",
768 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
770 $form->{l_classification_id} = 'Y';
771 $form->{l_assembly} = 'Y';
772 $form->{l_inventory_accno_id} = 'Y';
773 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
774 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
775 qw(l_parts_id l_qty l_partunit) );
777 my $group_clause = join ", ", map { +/^l_/; "$'" }
778 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
779 qw(l_parts_id l_partunit) );
782 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
785 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
786 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
787 qw(l_parts_id l_qty l_partunit) );
790 qq|SELECT $select_clause
792 LEFT JOIN parts p ON i.parts_id = p.id
793 LEFT JOIN bin b ON i.bin_id = b.id
794 LEFT JOIN warehouse w ON i.warehouse_id = w.id
797 GROUP BY $group_clause
798 ORDER BY $sort_spec|;
800 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
802 my (%non_empty_bins, @all_fields, @contents);
804 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
806 my $qty = $ref->{qty};
808 next unless ($qty != 0);
811 my $part_unit = $all_units->{$ref->{partunit}};
812 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
813 $qty *= $part_unit->{factor};
814 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
815 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
816 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
819 if ($form->{include_empty_bins}) {
820 $non_empty_bins{$ref->{binid}} = 1;
821 @all_fields = keys %{ $ref } unless (@all_fields);
824 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
826 push @contents, $ref;
831 if ($form->{include_empty_bins}) {
834 w.id AS warehouseid, w.description AS warehousedescription,
835 b.id AS binid, b.description AS bindescription
837 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
839 @filter_ary = @wh_bin_filter_ary;
840 @filter_vars = @wh_bin_filter_vars;
842 my @non_empty_bin_ids = keys %non_empty_bins;
843 if (@non_empty_bin_ids) {
844 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
845 push @filter_vars, @non_empty_bin_ids;
848 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
850 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
852 while (my $ref = $sth->fetchrow_hashref()) {
853 map { $ref->{$_} ||= "" } @all_fields;
854 push @contents, $ref;
858 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
859 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
863 $main::lxdebug->leave_sub();
869 $main::lxdebug->enter_sub();
871 my ($self, $qty_op) = @_;
873 if (!$qty_op || ($qty_op eq "dontcare")) {
874 $main::lxdebug->leave_sub();
878 if ($qty_op eq "atleast") {
880 } elsif ($qty_op eq "atmost") {
886 $main::lxdebug->leave_sub();
891 sub retrieve_transfer_types {
892 $main::lxdebug->enter_sub();
895 my $direction = shift;
897 my $myconfig = \%main::myconfig;
898 my $form = $main::form;
900 my $dbh = $form->get_standard_dbh($myconfig);
902 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
904 $main::lxdebug->leave_sub();
909 sub get_basic_bin_info {
910 $main::lxdebug->enter_sub();
915 Common::check_params(\%params, qw(id));
917 my $myconfig = \%main::myconfig;
918 my $form = $main::form;
920 my $dbh = $params{dbh} || $form->get_standard_dbh();
922 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
925 qq|SELECT b.id AS bin_id, b.description AS bin_description,
926 w.id AS warehouse_id, w.description AS warehouse_description
928 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
929 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
931 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
933 if ('' eq ref $params{id}) {
934 $result = $result->[0] || { };
935 $main::lxdebug->leave_sub();
940 $main::lxdebug->leave_sub();
942 return map { $_->{bin_id} => $_ } @{ $result };
945 sub get_basic_warehouse_info {
946 $main::lxdebug->enter_sub();
951 Common::check_params(\%params, qw(id));
953 my $myconfig = \%main::myconfig;
954 my $form = $main::form;
956 my $dbh = $params{dbh} || $form->get_standard_dbh();
958 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
961 qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
963 WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
965 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
967 if ('' eq ref $params{id}) {
968 $result = $result->[0] || { };
969 $main::lxdebug->leave_sub();
974 $main::lxdebug->leave_sub();
976 return map { $_->{warehouse_id} => $_ } @{ $result };
979 # Eingabe: Teilenummer, Lagernummer (warehouse)
980 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
982 sub get_max_qty_parts {
983 $main::lxdebug->enter_sub();
988 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
990 my $myconfig = \%main::myconfig;
991 my $form = $main::form;
993 my $dbh = $params{dbh} || $form->get_standard_dbh();
995 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
996 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
999 my $max_qty_parts = 0; #Initialisierung mit 0
1000 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
1001 $max_qty_parts += $ref->{sum};
1004 $main::lxdebug->leave_sub();
1006 return $max_qty_parts;
1010 # Eingabe: Teilenummer, Lagernummer (warehouse)
1011 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
1013 sub get_part_description {
1014 $main::lxdebug->enter_sub();
1019 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
1021 my $myconfig = \%main::myconfig;
1022 my $form = $main::form;
1024 my $dbh = $params{dbh} || $form->get_standard_dbh();
1026 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
1028 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
1030 my $ref = $sth->fetchrow_hashref();
1031 my $part_description = $ref->{partnumber} . " " . $ref->{description};
1033 $main::lxdebug->leave_sub();
1035 return $part_description;
1038 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
1039 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
1040 # Bzw. Fehler, falls Chargen oder bestbefore
1041 # bei eingelagerten Teilen definiert sind.
1043 sub get_max_qty_parts_bin {
1044 $main::lxdebug->enter_sub();
1049 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
1051 my $myconfig = \%main::myconfig;
1052 my $form = $main::form;
1054 my $dbh = $params{dbh} || $form->get_standard_dbh();
1056 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
1057 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1059 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1061 my $max_qty_parts = 0; #Initialisierung mit 0
1062 # falls derselbe artikel mehrmals eingelagert ist
1063 # chargennummer, muss entsprechend händisch agiert werden
1066 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1067 $max_qty_parts += $ref->{sum};
1069 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1073 $main::lxdebug->leave_sub();
1075 return ($max_qty_parts, $error);
1084 SL::WH - Warehouse backend
1089 WH->transfer(\%params);
1093 Backend for kivitendo warehousing functions.
1097 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1099 This is the main function to manipulate warehouse contents. A typical transfer
1100 is called like this:
1105 transfer_type => 'transfer',
1106 src_warehouse_id => 12,
1108 dst_warehouse_id => 25,
1112 It will generate an entry in inventory representing the transfer. Note that
1113 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1114 a destination or a src is mandatory.
1116 transfer accepts more than one transaction parameter, each being a hash ref. If
1117 more than one is supplied, it is guaranteed, that all are processed in the same
1120 Here is a full list of parameters. All "_id" parameters except oe and
1121 orderitems can be called without id with RDB objects as well.
1127 The id of the article transferred. Does not check if the article is a service.
1132 Quantity of the transaction. Mandatory.
1136 Unit of the transaction. Optional.
1140 =item transfer_type_id
1142 The type of transaction. The first version is a string describing the
1143 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1144 every system), the id is the hard id of a transfer_type from the database.
1146 Depending of the direction of the transfer_type, source and/or destination must
1149 One of transfer_type or transfer_type_id is mandatory.
1151 =item src_warehouse_id
1155 Warehouse and bin from which to transfer. Mandatory in transfer and out
1156 directions. Ignored in in directions.
1158 =item dst_warehouse_id
1162 Warehouse and bin to which to transfer. Mandatory in transfer and in
1163 directions. Ignored in out directions.
1167 If given, the transfer will transfer only articles with this chargenumber.
1172 Reference to an orderitem for which this transfer happened. Optional
1176 Reference to an order for which this transfer happened. Optional
1180 An optional comment.
1184 An expiration date. Note that this is not by default used by C<warehouse_report>.
1188 =head2 create_assembly \%PARAMS, [ \%PARAMS, ... ]
1190 Creates an assembly if all defined items are available.
1192 Assembly item(s) will be stocked out and the assembly will be stocked in,
1193 taking into account the qty and units which can be defined for each
1194 assembly item separately.
1196 The calling params originate from C<transfer> but only parts_id with the
1197 attribute assembly are processed.
1199 The typical params would be:
1202 'login' => $::myconfig{login},
1203 'dst_warehouse_id' => $form->{warehouse_id},
1204 'dst_bin_id' => $form->{bin_id},
1205 'chargenumber' => $form->{chargenumber},
1206 'bestbefore' => $form->{bestbefore},
1207 'assembly_id' => $form->{parts_id},
1208 'qty' => $form->{qty},
1209 'comment' => $form->{comment}
1212 =head3 Prerequisites
1214 All of these prerequisites have to be trueish, otherwise the function will exit
1215 unsuccessfully with a return value of undef.
1219 =item Mandantory params
1221 assembly_id, qty, login, dst_warehouse_id and dst_bin_id are mandatory.
1223 =item Subset named 'Assembly' of data set 'Part'
1225 assembly_id has to be an id in the table parts with the valid subset assembly.
1227 =item Assembly is composed of assembly item(s)
1229 There has to be at least one data set in the table assembly referenced to this assembly_id.
1231 =item Assembly cannot be destroyed or disassembled
1233 Assemblies are like cakes. You cannot disassemble it. NEVER.
1234 No negative nor zero qty's are valid inputs.
1236 =item The assembly item(s) have to be in the same warehouse
1238 inventory.warehouse_id equals dst_warehouse_id (client configurable).
1240 =item The assembly item(s) have to be in stock with the qty needed
1242 I can only make a cake by receipt if I have ALL ingredients and
1243 in the needed stock amount.
1244 The qty of stocked in assembly item(s) has to fit into the
1245 number of the qty of the assemblies, which are going to be created (client configurable).
1247 =item assembly item(s) with the parts set 'service' are ignored
1249 The subset 'Services' of part will not transferred for assembly item(s).
1253 Client configurable prerequisites can be changed with different
1254 prerequisites as described in client_config (s.a. next chapter).
1257 =head2 default creation of assembly
1259 The valid state of the assembly item(s) used for the assembly process are
1260 'out' for the general direction and 'used' as the specific reason.
1261 The valid state of the assembly is 'in' for the direction and 'assembled'
1262 as the specific reason.
1264 The method is transaction safe, in case of errors not a single entry will be made
1267 Two prerequisites can be changed with this global parameters
1271 =item $::instance_conf->get_transfer_default_warehouse_for_assembly
1273 If trueish we try to get all the items form the default bins defined in parts
1274 and do not try to find them in the destination warehouse. Returns an
1275 error if not all items have set a default bin in parts.
1277 =item $::instance_conf->get_bin_id_ignore_onhand
1279 If trueish we can create assemblies even if we do not have enough items in stock.
1280 The needed qty will be booked in a special bin, which has to be configured in