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);
49 $::lxdebug->enter_sub;
51 my ($self, @args) = @_;
54 $::lxdebug->leave_sub;
58 require SL::DB::TransferType;
60 require SL::DB::Employee;
61 require SL::DB::Inventory;
63 my $employee = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
64 my ($now) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
65 my @directions = (undef, qw(out in transfer));
68 my ($transfer, $field, $class, @find_by) = @_;
70 @find_by = (description => $transfer->{$field}) unless @find_by;
72 if ($transfer->{$field} || $transfer->{"${field}_id"}) {
73 return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
74 : $transfer->{$field} ? $class->_get_manager_class->find_by(@find_by)
75 : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
82 my $db = SL::DB::Inventory->new->db;
83 $db->with_transaction(sub{
84 while (my $transfer = shift @args) {
85 my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
87 my $part = $objectify->($transfer, 'parts', 'SL::DB::Part');
88 my $unit = $objectify->($transfer, 'unit', 'SL::DB::Unit', name => $transfer->{unit});
89 my $qty = $transfer->{qty};
90 my $src_bin = $objectify->($transfer, 'src_bin', 'SL::DB::Bin');
91 my $dst_bin = $objectify->($transfer, 'dst_bin', 'SL::DB::Bin');
92 my $src_wh = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
93 my $dst_wh = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
94 my $project = $objectify->($transfer, 'project', 'SL::DB::Project');
96 $src_wh ||= $src_bin->warehouse if $src_bin;
97 $dst_wh ||= $dst_bin->warehouse if $dst_bin;
99 my $direction = 0; # bit mask
100 $direction |= 1 if $src_bin;
101 $direction |= 2 if $dst_bin;
103 my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction => $directions[$direction],
104 description => $transfer->{transfer_type});
108 employee => $employee,
109 trans_type => $transfer_type,
111 trans_id => $trans_id,
112 shippingdate => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
113 ? $now : $transfer->{shippingdate},
114 map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
118 $qty = $unit->convert_to($qty, $part->unit_obj);
121 $params{chargenumber} ||= '';
123 if ($direction & 1) {
124 SL::DB::Inventory->new(
126 warehouse => $src_wh,
132 if ($direction & 2) {
133 SL::DB::Inventory->new(
135 warehouse => $dst_wh->id,
139 # Standardlagerplatz in Stammdaten gleich mitverschieben
140 if (defined($transfer->{change_default_bin})){
141 $part->update_attributes(warehouse_id => $dst_wh->id, bin_id => $dst_bin->id);
145 push @trans_ids, $trans_id;
150 $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
153 $::lxdebug->leave_sub;
158 sub transfer_assembly {
159 $main::lxdebug->enter_sub();
163 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
166 my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
168 my $assembly = SL::DB::Manager::Assembly->get_all(
169 query => [ id => $params{assembly_id} ],
170 with_objects => ['part'],
173 $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
176 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
178 my $myconfig = \%main::myconfig;
179 my $form = $main::form;
180 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
185 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
186 # select parts_id,qty from assembly where id=1064;
187 # Erweiterung für bug 935 am 23.4.09 -
188 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
189 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
190 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
192 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
193 # wenn assembly nicht überprüft wird ...
194 # patch von joachim eingespielt 24.4.2009:
195 # my $query = qq|select parts_id,qty from assembly inner join parts
196 # on assembly.parts_id = parts.id where assembly.id = ? and
197 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
200 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
201 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
203 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
205 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
206 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
207 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
208 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
209 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
211 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
213 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
214 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
215 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
216 $schleife_durchlaufen=1; # Erzeugnis definiert
217 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
218 my $currentPart_ID = $hash_ref->{parts_id};
220 # Überprüfen, ob diese Anzahl gefertigt werden kann
221 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
222 warehouse_id => $params{dst_warehouse_id});
224 if ($partsQTY > $max_parts){
225 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
226 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
228 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
229 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
230 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
231 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
234 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
235 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
236 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
237 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
238 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
239 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
241 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
242 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
243 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
245 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
246 my $tmpPartsQTY = $partsQTY;
248 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
249 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
250 my $temppart_chargenumber = $temphash_ref->{chargenumber};
251 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
252 my $temppart_qty = $temphash_ref->{sum};
254 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
255 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
256 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
257 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
258 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
259 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
260 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
261 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
262 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
263 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
265 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
266 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
267 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
268 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
269 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
271 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
272 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
273 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
274 last; # beendet die schleife (springt zum letzten element)
276 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
277 } #ende while select parts_id,qty from assembly where id = ?
279 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
280 # keine einzelteile definiert
281 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
282 Dementsprechend kann auch nichts hergestellt werden";
284 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
285 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
286 if ($kannNichtFertigen) {
287 return $kannNichtFertigen;
290 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
291 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
292 comment, employee_id, qty, trans_id, trans_type_id)
293 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
294 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
295 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
296 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
297 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
300 $main::lxdebug->leave_sub();
301 return 1; # Alles erfolgreich
304 sub get_warehouse_journal {
305 $main::lxdebug->enter_sub();
310 my $myconfig = \%main::myconfig;
311 my $form = $main::form;
313 my $all_units = AM->retrieve_units($myconfig, $form);
315 # connect to database
316 my $dbh = $form->get_standard_dbh($myconfig);
319 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
321 if ($filter{warehouse_id}) {
322 push @filter_ary, "w1.id = ? OR w2.id = ?";
323 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
326 if ($filter{bin_id}) {
327 push @filter_ary, "b1.id = ? OR b2.id = ?";
328 push @filter_vars, $filter{bin_id}, $filter{bin_id};
331 if ($filter{partnumber}) {
332 push @filter_ary, "p.partnumber ILIKE ?";
333 push @filter_vars, $::form->like($filter{partnumber});
336 if ($filter{description}) {
337 push @filter_ary, "(p.description ILIKE ?)";
338 push @filter_vars, $::form->like($filter{description});
341 if ($filter{chargenumber}) {
342 push @filter_ary, "i1.chargenumber ILIKE ?";
343 push @filter_vars, $::form->like($filter{chargenumber});
346 if (trim($form->{bestbefore})) {
347 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
348 push @filter_vars, trim($form->{bestbefore});
351 if (trim($form->{fromdate})) {
352 push @filter_ary, "? <= i1.shippingdate";
353 push @filter_vars, trim($form->{fromdate});
356 if (trim($form->{todate})) {
357 push @filter_ary, "? >= i1.shippingdate";
358 push @filter_vars, trim($form->{todate});
361 if ($form->{l_employee}) {
365 # prepare qty comparison for later filtering
366 my ($f_qty_op, $f_qty, $f_qty_base_unit);
367 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
368 $f_qty_op = $filter{qty_op};
369 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
370 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
373 map { $_ = "(${_})"; } @filter_ary;
375 # if of a property number or description is requested,
376 # automatically check the matching id too.
377 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
379 # customize shown entry for not available fields.
380 $filter{na} = '-' unless $filter{na};
382 # make order, search in $filter and $form
383 my $sort_col = $form->{sort};
384 my $sort_order = $form->{order};
386 $sort_col = $filter{sort} unless $sort_col;
387 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
388 $sort_col = 'shippingdate' if $sort_col eq 'date';
389 $sort_order = $filter{order} unless $sort_order;
390 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
392 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
394 $select_tokens{'trans'} = {
395 "parts_id" => "i1.parts_id",
396 "qty" => "ABS(SUM(i1.qty))",
397 "partnumber" => "p.partnumber",
398 "partdescription" => "p.description",
399 "bindescription" => "b.description",
400 "chargenumber" => "i1.chargenumber",
401 "bestbefore" => "i1.bestbefore",
402 "warehousedescription" => "w.description",
403 "partunit" => "p.unit",
404 "bin_from" => "b1.description",
405 "bin_to" => "b2.description",
406 "warehouse_from" => "w1.description",
407 "warehouse_to" => "w2.description",
408 "comment" => "i1.comment",
409 "trans_type" => "tt.description",
410 "trans_id" => "i1.trans_id",
411 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
412 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
413 "date" => "i1.shippingdate",
414 "itime" => "i1.itime",
415 "shippingdate" => "i1.shippingdate",
416 "employee" => "e.name",
417 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
420 $select_tokens{'out'} = {
421 "bin_to" => "'$filter{na}'",
422 "warehouse_to" => "'$filter{na}'",
425 $select_tokens{'in'} = {
426 "bin_from" => "'$filter{na}'",
427 "warehouse_from" => "'$filter{na}'",
430 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
432 # build the select clauses.
433 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
434 for my $i ('trans', 'out', 'in') {
435 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
436 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
439 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
440 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
442 $where_clause = defined($where_clause) ? $where_clause : '';
445 qq|SELECT DISTINCT $select{trans}
447 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
448 LEFT JOIN parts p ON i1.parts_id = p.id
449 LEFT JOIN bin b1 ON i1.bin_id = b1.id
450 LEFT JOIN bin b2 ON i2.bin_id = b2.id
451 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
452 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
453 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
454 LEFT JOIN project pr ON i1.project_id = pr.id
455 LEFT JOIN employee e ON i1.employee_id = e.id
456 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
457 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
458 GROUP BY $group_clause
462 SELECT DISTINCT $select{out}
464 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
465 LEFT JOIN parts p ON i1.parts_id = p.id
466 LEFT JOIN bin b1 ON i1.bin_id = b1.id
467 LEFT JOIN bin b2 ON i2.bin_id = b2.id
468 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
469 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
470 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
471 LEFT JOIN project pr ON i1.project_id = pr.id
472 LEFT JOIN employee e ON i1.employee_id = e.id
473 WHERE $where_clause i1.qty < 0 AND
474 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
475 GROUP BY $group_clause
479 SELECT DISTINCT $select{in}
481 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
482 LEFT JOIN parts p ON i1.parts_id = p.id
483 LEFT JOIN bin b1 ON i1.bin_id = b1.id
484 LEFT JOIN bin b2 ON i2.bin_id = b2.id
485 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
486 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
487 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
488 LEFT JOIN project pr ON i1.project_id = pr.id
489 LEFT JOIN employee e ON i1.employee_id = e.id
490 WHERE $where_clause i1.qty > 0 AND
491 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
492 GROUP BY $group_clause
493 ORDER BY r_${sort_spec}|;
495 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
497 my ($h_oe_id, $q_oe_id);
498 if ($form->{l_oe_id}) {
501 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
503 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
504 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
505 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
506 ELSE 'purchase_order'
513 SELECT dord.id AS id, dord.donumber AS number,
515 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
516 ELSE 'sales_delivery_order'
518 FROM delivery_orders dord
523 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
529 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
535 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
537 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
541 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
543 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
545 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
549 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
550 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
551 my $qty = $ref->{"qty"} * 1;
553 next unless ($qty > 0);
556 my $part_unit = $all_units->{$ref->{"partunit"}};
557 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
558 $qty *= $part_unit->{"factor"};
559 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
560 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
561 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
564 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
565 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
566 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
567 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
570 push @contents, $ref;
574 $h_oe_id->finish() if $h_oe_id;
576 $main::lxdebug->leave_sub();
582 # This sub is the primary function to retrieve information about items in warehouses.
583 # $filter is a hashref and supports the following keys:
584 # - warehouse_id - will return matches with this warehouse_id only
585 # - partnumber - will return only matches where the given string is a substring of the partnumber
586 # - partsid - will return matches with this parts_id only
587 # - description - will return only matches where the given string is a substring of the description
588 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
589 # - bestbefore - will return only matches with this bestbefore date
590 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
591 # - charge_ids - must be an arrayref. will return contents with these ids only
592 # - expires_in - will only return matches that expire within the given number of days
593 # will also add a column named 'has_expired' containing if the match has already expired or not
594 # - hazardous - will return matches with the flag hazardous only
595 # - oil - will return matches with the flag oil only
596 # - qty, qty_op - quantity filter (more info to come)
597 # - sort, order_by - sorting (more to come)
598 # - reservation - will provide an extra column containing the amount reserved of this match
599 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
601 sub get_warehouse_report {
602 $main::lxdebug->enter_sub();
607 my $myconfig = \%main::myconfig;
608 my $form = $main::form;
610 my $all_units = AM->retrieve_units($myconfig, $form);
612 # connect to database
613 my $dbh = $form->get_standard_dbh($myconfig);
616 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
618 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
620 if ($filter{warehouse_id}) {
621 push @wh_bin_filter_ary, "w.id = ?";
622 push @wh_bin_filter_vars, $filter{warehouse_id};
625 if ($filter{bin_id}) {
626 push @wh_bin_filter_ary, "b.id = ?";
627 push @wh_bin_filter_vars, $filter{bin_id};
630 push @filter_ary, @wh_bin_filter_ary;
631 push @filter_vars, @wh_bin_filter_vars;
633 if ($filter{partnumber}) {
634 push @filter_ary, "p.partnumber ILIKE ?";
635 push @filter_vars, $::form->like($filter{partnumber});
638 if ($filter{description}) {
639 push @filter_ary, "p.description ILIKE ?";
640 push @filter_vars, $::form->like($filter{description});
643 if ($filter{partsid}) {
644 push @filter_ary, "p.id = ?";
645 push @filter_vars, $filter{partsid};
648 if ($filter{chargenumber}) {
649 push @filter_ary, "i.chargenumber ILIKE ?";
650 push @filter_vars, $::form->like($filter{chargenumber});
653 if (trim($form->{bestbefore})) {
654 push @filter_ary, "?::DATE = i.bestbefore::DATE";
655 push @filter_vars, trim($form->{bestbefore});
659 push @filter_ary, "p.ean ILIKE ?";
660 push @filter_vars, $::form->like($filter{ean});
663 if (trim($filter{date})) {
664 push @filter_ary, "i.shippingdate <= ?";
665 push @filter_vars, trim($filter{date});
667 if (!$filter{include_invalid_warehouses}){
668 push @filter_ary, "NOT (w.invalid)";
671 # prepare qty comparison for later filtering
672 my ($f_qty_op, $f_qty, $f_qty_base_unit);
674 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
675 $f_qty_op = $filter{qty_op};
676 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
677 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
680 map { $_ = "(${_})"; } @filter_ary;
682 # if of a property number or description is requested,
683 # automatically check the matching id too.
684 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
686 # make order, search in $filter and $form
687 my $sort_col = $form->{sort};
688 my $sort_order = $form->{order};
690 $sort_col = $filter{sort} unless $sort_col;
691 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
692 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
693 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
694 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
695 # S.a. Bug 1597 jb 12.5.2011
696 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
697 $sort_order = $filter{order} unless $sort_order;
698 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
699 my $orderby = $sort_col;
700 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
702 my $where_clause = join " AND ", ("1=1", @filter_ary);
704 my %select_tokens = (
705 "parts_id" => "i.parts_id",
706 "qty" => "SUM(i.qty)",
707 "warehouseid" => "i.warehouse_id",
708 "partnumber" => "p.partnumber",
709 "partdescription" => "p.description",
710 "bindescription" => "b.description",
712 "chargenumber" => "i.chargenumber",
713 "bestbefore" => "i.bestbefore",
715 "chargeid" => "c.id",
716 "warehousedescription" => "w.description",
717 "partunit" => "p.unit",
718 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
720 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
721 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
722 qw(l_parts_id l_qty l_partunit) );
724 my $group_clause = join ", ", map { +/^l_/; "$'" }
725 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
726 qw(l_parts_id l_partunit) );
729 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
732 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
733 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
734 qw(l_parts_id l_qty l_partunit) );
737 qq|SELECT $select_clause
739 LEFT JOIN parts p ON i.parts_id = p.id
740 LEFT JOIN bin b ON i.bin_id = b.id
741 LEFT JOIN warehouse w ON i.warehouse_id = w.id
744 GROUP BY $group_clause
745 ORDER BY $sort_spec|;
747 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
749 my (%non_empty_bins, @all_fields, @contents);
751 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
753 my $qty = $ref->{qty};
755 next unless ($qty != 0);
758 my $part_unit = $all_units->{$ref->{partunit}};
759 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
760 $qty *= $part_unit->{factor};
761 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
762 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
763 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
766 if ($form->{include_empty_bins}) {
767 $non_empty_bins{$ref->{binid}} = 1;
768 @all_fields = keys %{ $ref } unless (@all_fields);
771 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
773 push @contents, $ref;
778 if ($form->{include_empty_bins}) {
781 w.id AS warehouseid, w.description AS warehousedescription,
782 b.id AS binid, b.description AS bindescription
784 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
786 @filter_ary = @wh_bin_filter_ary;
787 @filter_vars = @wh_bin_filter_vars;
789 my @non_empty_bin_ids = keys %non_empty_bins;
790 if (@non_empty_bin_ids) {
791 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
792 push @filter_vars, @non_empty_bin_ids;
795 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
797 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
799 while (my $ref = $sth->fetchrow_hashref()) {
800 map { $ref->{$_} ||= "" } @all_fields;
801 push @contents, $ref;
805 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
806 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
810 $main::lxdebug->leave_sub();
816 $main::lxdebug->enter_sub();
818 my ($self, $qty_op) = @_;
820 if (!$qty_op || ($qty_op eq "dontcare")) {
821 $main::lxdebug->leave_sub();
825 if ($qty_op eq "atleast") {
827 } elsif ($qty_op eq "atmost") {
833 $main::lxdebug->leave_sub();
838 sub retrieve_transfer_types {
839 $main::lxdebug->enter_sub();
842 my $direction = shift;
844 my $myconfig = \%main::myconfig;
845 my $form = $main::form;
847 my $dbh = $form->get_standard_dbh($myconfig);
849 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
851 $main::lxdebug->leave_sub();
856 sub get_basic_bin_info {
857 $main::lxdebug->enter_sub();
862 Common::check_params(\%params, qw(id));
864 my $myconfig = \%main::myconfig;
865 my $form = $main::form;
867 my $dbh = $params{dbh} || $form->get_standard_dbh();
869 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
872 qq|SELECT b.id AS bin_id, b.description AS bin_description,
873 w.id AS warehouse_id, w.description AS warehouse_description
875 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
876 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
878 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
880 if ('' eq ref $params{id}) {
881 $result = $result->[0] || { };
882 $main::lxdebug->leave_sub();
887 $main::lxdebug->leave_sub();
889 return map { $_->{bin_id} => $_ } @{ $result };
892 # Eingabe: Teilenummer, Lagernummer (warehouse)
893 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
895 sub get_max_qty_parts {
896 $main::lxdebug->enter_sub();
901 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
903 my $myconfig = \%main::myconfig;
904 my $form = $main::form;
906 my $dbh = $params{dbh} || $form->get_standard_dbh();
908 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
910 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
912 my $max_qty_parts = 0; #Initialisierung mit 0
913 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
914 $max_qty_parts += $ref->{sum};
917 $main::lxdebug->leave_sub();
919 return $max_qty_parts;
923 # Eingabe: Teilenummer, Lagernummer (warehouse)
924 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
926 sub get_part_description {
927 $main::lxdebug->enter_sub();
932 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
934 my $myconfig = \%main::myconfig;
935 my $form = $main::form;
937 my $dbh = $params{dbh} || $form->get_standard_dbh();
939 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
941 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
943 my $ref = $sth->fetchrow_hashref();
944 my $part_description = $ref->{partnumber} . " " . $ref->{description};
946 $main::lxdebug->leave_sub();
948 return $part_description;
951 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
952 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
953 # Bzw. Fehler, falls Chargen oder bestbefore
954 # bei eingelagerten Teilen definiert sind.
956 sub get_max_qty_parts_bin {
957 $main::lxdebug->enter_sub();
962 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
964 my $myconfig = \%main::myconfig;
965 my $form = $main::form;
967 my $dbh = $params{dbh} || $form->get_standard_dbh();
969 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
970 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
972 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
974 my $max_qty_parts = 0; #Initialisierung mit 0
975 # falls derselbe artikel mehrmals eingelagert ist
976 # chargennummer, muss entsprechend händisch agiert werden
979 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
980 $max_qty_parts += $ref->{sum};
982 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
986 $main::lxdebug->leave_sub();
988 return ($max_qty_parts, $error);
997 SL::WH - Warehouse backend
1002 WH->transfer(\%params);
1006 Backend for kivitendo warehousing functions.
1010 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1012 This is the main function to manipulate warehouse contents. A typical transfer
1013 is called like this:
1018 transfer_type => 'transfer',
1019 src_warehouse_id => 12,
1021 dst_warehouse_id => 25,
1025 It will generate an entry in inventory representing the transfer. Note that
1026 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1027 a destination or a src is mandatory.
1029 transfer accepts more than one transaction parameter, each being a hash ref. If
1030 more than one is supplied, it is guaranteed, that all are processed in the same
1033 Here is a full list of parameters. All "_id" parameters except oe and
1034 orderitems can be called without id with RDB objects as well.
1040 The id of the article transferred. Does not check if the article is a service.
1045 Quantity of the transaction. Mandatory.
1049 Unit of the transaction. Optional.
1053 =item transfer_type_id
1055 The type of transaction. The first version is a string describing the
1056 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1057 every system), the id is the hard id of a transfer_type from the database.
1059 Depending of the direction of the transfer_type, source and/or destination must
1062 One of transfer_type or transfer_type_id is mandatory.
1064 =item src_warehouse_id
1068 Warehouse and bin from which to transfer. Mandatory in transfer and out
1069 directions. Ignored in in directions.
1071 =item dst_warehouse_id
1075 Warehouse and bin to which to transfer. Mandatory in transfer and in
1076 directions. Ignored in out directions.
1080 If given, the transfer will transfer only articles with this chargenumber.
1085 Reference to an orderitem for which this transfer happened. Optional
1089 Reference to an order for which this transfer happened. Optional
1093 An optional comment.
1097 An expiration date. Note that this is not by default used by C<warehouse_report>.