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 # Fertigen ohne Prüfung nach Bestand
232 if ($currentPart_WH_ID == $::instance_conf->get_warehouse_id_ignore_onhand) {
233 my $temppart_bin_id = $::instance_conf->get_bin_id_ignore_onhand;
234 my $temppart_chargenumber = "";
235 my $temppart_bestbefore = localtime();
236 my $temppart_qty = $partsQTY * -1;
238 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
239 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
240 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
243 # Überprüfen, ob diese Anzahl gefertigt werden kann
244 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
245 warehouse_id => $currentPart_WH_ID);
247 if ($partsQTY > $max_parts){
248 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
249 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
251 $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
252 " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
253 " im Lager: " . $warehouse_desc .
254 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
255 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
258 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
259 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
260 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
261 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
262 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
263 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
265 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
266 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
267 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
269 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
270 my $tmpPartsQTY = $partsQTY;
272 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
273 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
274 my $temppart_chargenumber = $temphash_ref->{chargenumber};
275 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
276 my $temppart_qty = $temphash_ref->{sum};
278 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
279 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
280 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
281 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
282 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
283 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
284 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
285 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
286 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
287 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
289 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
290 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
291 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
292 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
293 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
295 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
296 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
297 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
298 last; # beendet die schleife (springt zum letzten element)
300 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
301 } #ende while select parts_id,qty from assembly where id = ?
303 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
304 # keine einzelteile definiert
305 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
306 Dementsprechend kann auch nichts hergestellt werden";
308 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
309 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
310 if ($kannNichtFertigen) {
311 return $kannNichtFertigen;
314 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
315 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
316 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
317 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
318 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
319 (select current_date))|;
320 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
321 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
322 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
325 $main::lxdebug->leave_sub();
326 return 1; # Alles erfolgreich
329 sub get_warehouse_journal {
330 $main::lxdebug->enter_sub();
335 my $myconfig = \%main::myconfig;
336 my $form = $main::form;
338 my $all_units = AM->retrieve_units($myconfig, $form);
340 # connect to database
341 my $dbh = $form->get_standard_dbh($myconfig);
344 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
346 if ($filter{warehouse_id}) {
347 push @filter_ary, "w1.id = ? OR w2.id = ?";
348 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
351 if ($filter{bin_id}) {
352 push @filter_ary, "b1.id = ? OR b2.id = ?";
353 push @filter_vars, $filter{bin_id}, $filter{bin_id};
356 if ($filter{partnumber}) {
357 push @filter_ary, "p.partnumber ILIKE ?";
358 push @filter_vars, like($filter{partnumber});
361 if ($filter{description}) {
362 push @filter_ary, "(p.description ILIKE ?)";
363 push @filter_vars, like($filter{description});
366 if ($filter{chargenumber}) {
367 push @filter_ary, "i1.chargenumber ILIKE ?";
368 push @filter_vars, like($filter{chargenumber});
371 if (trim($form->{bestbefore})) {
372 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
373 push @filter_vars, trim($form->{bestbefore});
376 if (trim($form->{fromdate})) {
377 push @filter_ary, "? <= i1.shippingdate";
378 push @filter_vars, trim($form->{fromdate});
381 if (trim($form->{todate})) {
382 push @filter_ary, "? >= i1.shippingdate";
383 push @filter_vars, trim($form->{todate});
386 if ($form->{l_employee}) {
390 # prepare qty comparison for later filtering
391 my ($f_qty_op, $f_qty, $f_qty_base_unit);
392 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
393 $f_qty_op = $filter{qty_op};
394 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
395 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
398 map { $_ = "(${_})"; } @filter_ary;
400 # if of a property number or description is requested,
401 # automatically check the matching id too.
402 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
404 # customize shown entry for not available fields.
405 $filter{na} = '-' unless $filter{na};
407 # make order, search in $filter and $form
408 my $sort_col = $form->{sort};
409 my $sort_order = $form->{order};
411 $sort_col = $filter{sort} unless $sort_col;
412 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
413 $sort_col = 'shippingdate' if $sort_col eq 'date';
414 $sort_order = $filter{order} unless $sort_order;
415 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
417 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
419 $select_tokens{'trans'} = {
420 "parts_id" => "i1.parts_id",
421 "qty" => "ABS(SUM(i1.qty))",
422 "partnumber" => "p.partnumber",
423 "partdescription" => "p.description",
424 "bindescription" => "b.description",
425 "chargenumber" => "i1.chargenumber",
426 "bestbefore" => "i1.bestbefore",
427 "warehousedescription" => "w.description",
428 "partunit" => "p.unit",
429 "bin_from" => "b1.description",
430 "bin_to" => "b2.description",
431 "warehouse_from" => "w1.description",
432 "warehouse_to" => "w2.description",
433 "comment" => "i1.comment",
434 "trans_type" => "tt.description",
435 "trans_id" => "i1.trans_id",
436 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
437 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
438 "date" => "i1.shippingdate",
439 "itime" => "i1.itime",
440 "shippingdate" => "i1.shippingdate",
441 "employee" => "e.name",
442 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
445 $select_tokens{'out'} = {
446 "bin_to" => "'$filter{na}'",
447 "warehouse_to" => "'$filter{na}'",
450 $select_tokens{'in'} = {
451 "bin_from" => "'$filter{na}'",
452 "warehouse_from" => "'$filter{na}'",
455 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
457 # build the select clauses.
458 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
459 for my $i ('trans', 'out', 'in') {
460 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
461 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
464 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
465 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
467 $where_clause = defined($where_clause) ? $where_clause : '';
470 qq|SELECT DISTINCT $select{trans}
472 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
473 LEFT JOIN parts p ON i1.parts_id = p.id
474 LEFT JOIN bin b1 ON i1.bin_id = b1.id
475 LEFT JOIN bin b2 ON i2.bin_id = b2.id
476 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
477 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
478 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
479 LEFT JOIN project pr ON i1.project_id = pr.id
480 LEFT JOIN employee e ON i1.employee_id = e.id
481 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
482 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
483 GROUP BY $group_clause
487 SELECT DISTINCT $select{out}
489 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
490 LEFT JOIN parts p ON i1.parts_id = p.id
491 LEFT JOIN bin b1 ON i1.bin_id = b1.id
492 LEFT JOIN bin b2 ON i2.bin_id = b2.id
493 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
494 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
495 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
496 LEFT JOIN project pr ON i1.project_id = pr.id
497 LEFT JOIN employee e ON i1.employee_id = e.id
498 WHERE $where_clause i1.qty < 0 AND
499 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
500 GROUP BY $group_clause
504 SELECT DISTINCT $select{in}
506 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
507 LEFT JOIN parts p ON i1.parts_id = p.id
508 LEFT JOIN bin b1 ON i1.bin_id = b1.id
509 LEFT JOIN bin b2 ON i2.bin_id = b2.id
510 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
511 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
512 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
513 LEFT JOIN project pr ON i1.project_id = pr.id
514 LEFT JOIN employee e ON i1.employee_id = e.id
515 WHERE $where_clause i1.qty > 0 AND
516 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
517 GROUP BY $group_clause
518 ORDER BY r_${sort_spec}|;
520 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
522 my ($h_oe_id, $q_oe_id);
523 if ($form->{l_oe_id}) {
526 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
528 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
529 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
530 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
531 ELSE 'purchase_order'
538 SELECT dord.id AS id, dord.donumber AS number,
540 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
541 ELSE 'sales_delivery_order'
543 FROM delivery_orders dord
548 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
554 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
560 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
562 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
566 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
568 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
570 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
574 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
575 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
576 my $qty = $ref->{"qty"} * 1;
578 next unless ($qty > 0);
581 my $part_unit = $all_units->{$ref->{"partunit"}};
582 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
583 $qty *= $part_unit->{"factor"};
584 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
585 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
586 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
589 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
590 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
591 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
592 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
595 push @contents, $ref;
599 $h_oe_id->finish() if $h_oe_id;
601 $main::lxdebug->leave_sub();
607 # This sub is the primary function to retrieve information about items in warehouses.
608 # $filter is a hashref and supports the following keys:
609 # - warehouse_id - will return matches with this warehouse_id only
610 # - partnumber - will return only matches where the given string is a substring of the partnumber
611 # - partsid - will return matches with this parts_id only
612 # - description - will return only matches where the given string is a substring of the description
613 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
614 # - bestbefore - will return only matches with this bestbefore date
615 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
616 # - charge_ids - must be an arrayref. will return contents with these ids only
617 # - expires_in - will only return matches that expire within the given number of days
618 # will also add a column named 'has_expired' containing if the match has already expired or not
619 # - hazardous - will return matches with the flag hazardous only
620 # - oil - will return matches with the flag oil only
621 # - qty, qty_op - quantity filter (more info to come)
622 # - sort, order_by - sorting (more to come)
623 # - reservation - will provide an extra column containing the amount reserved of this match
624 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
626 sub get_warehouse_report {
627 $main::lxdebug->enter_sub();
632 my $myconfig = \%main::myconfig;
633 my $form = $main::form;
635 my $all_units = AM->retrieve_units($myconfig, $form);
637 # connect to database
638 my $dbh = $form->get_standard_dbh($myconfig);
641 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
643 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
645 if ($filter{warehouse_id}) {
646 push @wh_bin_filter_ary, "w.id = ?";
647 push @wh_bin_filter_vars, $filter{warehouse_id};
650 if ($filter{bin_id}) {
651 push @wh_bin_filter_ary, "b.id = ?";
652 push @wh_bin_filter_vars, $filter{bin_id};
655 push @filter_ary, @wh_bin_filter_ary;
656 push @filter_vars, @wh_bin_filter_vars;
658 if ($filter{partnumber}) {
659 push @filter_ary, "p.partnumber ILIKE ?";
660 push @filter_vars, like($filter{partnumber});
663 if ($filter{description}) {
664 push @filter_ary, "p.description ILIKE ?";
665 push @filter_vars, like($filter{description});
668 if ($filter{partsid}) {
669 push @filter_ary, "p.id = ?";
670 push @filter_vars, $filter{partsid};
673 if ($filter{chargenumber}) {
674 push @filter_ary, "i.chargenumber ILIKE ?";
675 push @filter_vars, like($filter{chargenumber});
678 if (trim($form->{bestbefore})) {
679 push @filter_ary, "?::DATE = i.bestbefore::DATE";
680 push @filter_vars, trim($form->{bestbefore});
684 push @filter_ary, "p.ean ILIKE ?";
685 push @filter_vars, like($filter{ean});
688 if (trim($filter{date})) {
689 push @filter_ary, "i.shippingdate <= ?";
690 push @filter_vars, trim($filter{date});
692 if (!$filter{include_invalid_warehouses}){
693 push @filter_ary, "NOT (w.invalid)";
696 # prepare qty comparison for later filtering
697 my ($f_qty_op, $f_qty, $f_qty_base_unit);
699 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
700 $f_qty_op = $filter{qty_op};
701 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
702 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
705 map { $_ = "(${_})"; } @filter_ary;
707 # if of a property number or description is requested,
708 # automatically check the matching id too.
709 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
711 # make order, search in $filter and $form
712 my $sort_col = $form->{sort};
713 my $sort_order = $form->{order};
715 $sort_col = $filter{sort} unless $sort_col;
716 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
717 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
718 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
719 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
720 # S.a. Bug 1597 jb 12.5.2011
721 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
722 $sort_order = $filter{order} unless $sort_order;
723 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
724 my $orderby = $sort_col;
725 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
727 my $where_clause = join " AND ", ("1=1", @filter_ary);
729 my %select_tokens = (
730 "parts_id" => "i.parts_id",
731 "qty" => "SUM(i.qty)",
732 "warehouseid" => "i.warehouse_id",
733 "partnumber" => "p.partnumber",
734 "partdescription" => "p.description",
735 "bindescription" => "b.description",
737 "chargenumber" => "i.chargenumber",
738 "bestbefore" => "i.bestbefore",
740 "chargeid" => "c.id",
741 "warehousedescription" => "w.description",
742 "partunit" => "p.unit",
743 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
745 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
746 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
747 qw(l_parts_id l_qty l_partunit) );
749 my $group_clause = join ", ", map { +/^l_/; "$'" }
750 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
751 qw(l_parts_id l_partunit) );
754 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
757 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
758 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
759 qw(l_parts_id l_qty l_partunit) );
762 qq|SELECT $select_clause
764 LEFT JOIN parts p ON i.parts_id = p.id
765 LEFT JOIN bin b ON i.bin_id = b.id
766 LEFT JOIN warehouse w ON i.warehouse_id = w.id
769 GROUP BY $group_clause
770 ORDER BY $sort_spec|;
772 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
774 my (%non_empty_bins, @all_fields, @contents);
776 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
778 my $qty = $ref->{qty};
780 next unless ($qty != 0);
783 my $part_unit = $all_units->{$ref->{partunit}};
784 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
785 $qty *= $part_unit->{factor};
786 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
787 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
788 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
791 if ($form->{include_empty_bins}) {
792 $non_empty_bins{$ref->{binid}} = 1;
793 @all_fields = keys %{ $ref } unless (@all_fields);
796 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
798 push @contents, $ref;
803 if ($form->{include_empty_bins}) {
806 w.id AS warehouseid, w.description AS warehousedescription,
807 b.id AS binid, b.description AS bindescription
809 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
811 @filter_ary = @wh_bin_filter_ary;
812 @filter_vars = @wh_bin_filter_vars;
814 my @non_empty_bin_ids = keys %non_empty_bins;
815 if (@non_empty_bin_ids) {
816 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
817 push @filter_vars, @non_empty_bin_ids;
820 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
822 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
824 while (my $ref = $sth->fetchrow_hashref()) {
825 map { $ref->{$_} ||= "" } @all_fields;
826 push @contents, $ref;
830 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
831 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
835 $main::lxdebug->leave_sub();
841 $main::lxdebug->enter_sub();
843 my ($self, $qty_op) = @_;
845 if (!$qty_op || ($qty_op eq "dontcare")) {
846 $main::lxdebug->leave_sub();
850 if ($qty_op eq "atleast") {
852 } elsif ($qty_op eq "atmost") {
858 $main::lxdebug->leave_sub();
863 sub retrieve_transfer_types {
864 $main::lxdebug->enter_sub();
867 my $direction = shift;
869 my $myconfig = \%main::myconfig;
870 my $form = $main::form;
872 my $dbh = $form->get_standard_dbh($myconfig);
874 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
876 $main::lxdebug->leave_sub();
881 sub get_basic_bin_info {
882 $main::lxdebug->enter_sub();
887 Common::check_params(\%params, qw(id));
889 my $myconfig = \%main::myconfig;
890 my $form = $main::form;
892 my $dbh = $params{dbh} || $form->get_standard_dbh();
894 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
897 qq|SELECT b.id AS bin_id, b.description AS bin_description,
898 w.id AS warehouse_id, w.description AS warehouse_description
900 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
901 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
903 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
905 if ('' eq ref $params{id}) {
906 $result = $result->[0] || { };
907 $main::lxdebug->leave_sub();
912 $main::lxdebug->leave_sub();
914 return map { $_->{bin_id} => $_ } @{ $result };
917 sub get_basic_warehouse_info {
918 $main::lxdebug->enter_sub();
923 Common::check_params(\%params, qw(id));
925 my $myconfig = \%main::myconfig;
926 my $form = $main::form;
928 my $dbh = $params{dbh} || $form->get_standard_dbh();
930 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
933 qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
935 WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
937 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
939 if ('' eq ref $params{id}) {
940 $result = $result->[0] || { };
941 $main::lxdebug->leave_sub();
946 $main::lxdebug->leave_sub();
948 return map { $_->{warehouse_id} => $_ } @{ $result };
951 # Eingabe: Teilenummer, Lagernummer (warehouse)
952 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
954 sub get_max_qty_parts {
955 $main::lxdebug->enter_sub();
960 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
962 my $myconfig = \%main::myconfig;
963 my $form = $main::form;
965 my $dbh = $params{dbh} || $form->get_standard_dbh();
967 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
968 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
971 my $max_qty_parts = 0; #Initialisierung mit 0
972 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
973 $max_qty_parts += $ref->{sum};
976 $main::lxdebug->leave_sub();
978 return $max_qty_parts;
982 # Eingabe: Teilenummer, Lagernummer (warehouse)
983 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
985 sub get_part_description {
986 $main::lxdebug->enter_sub();
991 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
993 my $myconfig = \%main::myconfig;
994 my $form = $main::form;
996 my $dbh = $params{dbh} || $form->get_standard_dbh();
998 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
1000 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
1002 my $ref = $sth->fetchrow_hashref();
1003 my $part_description = $ref->{partnumber} . " " . $ref->{description};
1005 $main::lxdebug->leave_sub();
1007 return $part_description;
1010 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
1011 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
1012 # Bzw. Fehler, falls Chargen oder bestbefore
1013 # bei eingelagerten Teilen definiert sind.
1015 sub get_max_qty_parts_bin {
1016 $main::lxdebug->enter_sub();
1021 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
1023 my $myconfig = \%main::myconfig;
1024 my $form = $main::form;
1026 my $dbh = $params{dbh} || $form->get_standard_dbh();
1028 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
1029 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1031 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1033 my $max_qty_parts = 0; #Initialisierung mit 0
1034 # falls derselbe artikel mehrmals eingelagert ist
1035 # chargennummer, muss entsprechend händisch agiert werden
1038 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1039 $max_qty_parts += $ref->{sum};
1041 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1045 $main::lxdebug->leave_sub();
1047 return ($max_qty_parts, $error);
1056 SL::WH - Warehouse backend
1061 WH->transfer(\%params);
1065 Backend for kivitendo warehousing functions.
1069 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1071 This is the main function to manipulate warehouse contents. A typical transfer
1072 is called like this:
1077 transfer_type => 'transfer',
1078 src_warehouse_id => 12,
1080 dst_warehouse_id => 25,
1084 It will generate an entry in inventory representing the transfer. Note that
1085 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1086 a destination or a src is mandatory.
1088 transfer accepts more than one transaction parameter, each being a hash ref. If
1089 more than one is supplied, it is guaranteed, that all are processed in the same
1092 Here is a full list of parameters. All "_id" parameters except oe and
1093 orderitems can be called without id with RDB objects as well.
1099 The id of the article transferred. Does not check if the article is a service.
1104 Quantity of the transaction. Mandatory.
1108 Unit of the transaction. Optional.
1112 =item transfer_type_id
1114 The type of transaction. The first version is a string describing the
1115 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1116 every system), the id is the hard id of a transfer_type from the database.
1118 Depending of the direction of the transfer_type, source and/or destination must
1121 One of transfer_type or transfer_type_id is mandatory.
1123 =item src_warehouse_id
1127 Warehouse and bin from which to transfer. Mandatory in transfer and out
1128 directions. Ignored in in directions.
1130 =item dst_warehouse_id
1134 Warehouse and bin to which to transfer. Mandatory in transfer and in
1135 directions. Ignored in out directions.
1139 If given, the transfer will transfer only articles with this chargenumber.
1144 Reference to an orderitem for which this transfer happened. Optional
1148 Reference to an order for which this transfer happened. Optional
1152 An optional comment.
1156 An expiration date. Note that this is not by default used by C<warehouse_report>.