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)|;
186 my $query = qq|select assembly.parts_id, assembly.qty, parts.warehouse_id from assembly inner join parts on assembly.parts_id = parts.id
187 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
189 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
191 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
192 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
193 trans_id, trans_type_id, shippingdate)
194 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
195 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
196 (SELECT current_date))|;
197 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
199 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
201 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
202 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
203 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
204 $schleife_durchlaufen=1; # Erzeugnis definiert
205 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
206 my $currentPart_ID = $hash_ref->{parts_id};
207 my $currentPart_WH_ID = $hash_ref->{warehouse_id};
208 my $warehouse_info = $self->get_basic_warehouse_info('id' => $currentPart_WH_ID);
209 my $warehouse_desc = $warehouse_info->{"warehouse_description"};
211 # Überprüfen, ob diese Anzahl gefertigt werden kann
212 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
213 warehouse_id => $currentPart_WH_ID);
215 if ($partsQTY > $max_parts){
216 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
217 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
219 $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
220 " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
221 " im Lager: " . $warehouse_desc .
222 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
223 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
226 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
227 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
228 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
229 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
230 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
231 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
233 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
234 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
235 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
237 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
238 my $tmpPartsQTY = $partsQTY;
240 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
241 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
242 my $temppart_chargenumber = $temphash_ref->{chargenumber};
243 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
244 my $temppart_qty = $temphash_ref->{sum};
246 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
247 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
248 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
249 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
250 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
251 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
252 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
253 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
254 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
255 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
257 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
258 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
259 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
260 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
261 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
263 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
264 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
265 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
266 last; # beendet die schleife (springt zum letzten element)
268 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
269 } #ende while select parts_id,qty from assembly where id = ?
271 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
272 # keine einzelteile definiert
273 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
274 Dementsprechend kann auch nichts hergestellt werden";
276 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
277 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
278 if ($kannNichtFertigen) {
279 return $kannNichtFertigen;
282 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
283 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
284 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
285 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
286 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
287 (select current_date))|;
288 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
289 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
290 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
293 $main::lxdebug->leave_sub();
294 return 1; # Alles erfolgreich
297 sub get_warehouse_journal {
298 $main::lxdebug->enter_sub();
303 my $myconfig = \%main::myconfig;
304 my $form = $main::form;
306 my $all_units = AM->retrieve_units($myconfig, $form);
308 # connect to database
309 my $dbh = $form->get_standard_dbh($myconfig);
312 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
314 if ($filter{warehouse_id}) {
315 push @filter_ary, "w1.id = ? OR w2.id = ?";
316 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
319 if ($filter{bin_id}) {
320 push @filter_ary, "b1.id = ? OR b2.id = ?";
321 push @filter_vars, $filter{bin_id}, $filter{bin_id};
324 if ($filter{partnumber}) {
325 push @filter_ary, "p.partnumber ILIKE ?";
326 push @filter_vars, like($filter{partnumber});
329 if ($filter{description}) {
330 push @filter_ary, "(p.description ILIKE ?)";
331 push @filter_vars, like($filter{description});
334 if ($filter{chargenumber}) {
335 push @filter_ary, "i1.chargenumber ILIKE ?";
336 push @filter_vars, like($filter{chargenumber});
339 if (trim($form->{bestbefore})) {
340 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
341 push @filter_vars, trim($form->{bestbefore});
344 if (trim($form->{fromdate})) {
345 push @filter_ary, "? <= i1.shippingdate";
346 push @filter_vars, trim($form->{fromdate});
349 if (trim($form->{todate})) {
350 push @filter_ary, "? >= i1.shippingdate";
351 push @filter_vars, trim($form->{todate});
354 if ($form->{l_employee}) {
358 # prepare qty comparison for later filtering
359 my ($f_qty_op, $f_qty, $f_qty_base_unit);
360 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
361 $f_qty_op = $filter{qty_op};
362 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
363 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
366 map { $_ = "(${_})"; } @filter_ary;
368 # if of a property number or description is requested,
369 # automatically check the matching id too.
370 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
372 # customize shown entry for not available fields.
373 $filter{na} = '-' unless $filter{na};
375 # make order, search in $filter and $form
376 my $sort_col = $form->{sort};
377 my $sort_order = $form->{order};
379 $sort_col = $filter{sort} unless $sort_col;
380 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
381 $sort_col = 'shippingdate' if $sort_col eq 'date';
382 $sort_order = $filter{order} unless $sort_order;
383 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
385 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
387 $select_tokens{'trans'} = {
388 "parts_id" => "i1.parts_id",
389 "qty" => "ABS(SUM(i1.qty))",
390 "partnumber" => "p.partnumber",
391 "partdescription" => "p.description",
392 "bindescription" => "b.description",
393 "chargenumber" => "i1.chargenumber",
394 "bestbefore" => "i1.bestbefore",
395 "warehousedescription" => "w.description",
396 "partunit" => "p.unit",
397 "bin_from" => "b1.description",
398 "bin_to" => "b2.description",
399 "warehouse_from" => "w1.description",
400 "warehouse_to" => "w2.description",
401 "comment" => "i1.comment",
402 "trans_type" => "tt.description",
403 "trans_id" => "i1.trans_id",
404 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
405 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
406 "date" => "i1.shippingdate",
407 "itime" => "i1.itime",
408 "shippingdate" => "i1.shippingdate",
409 "employee" => "e.name",
410 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
413 $select_tokens{'out'} = {
414 "bin_to" => "'$filter{na}'",
415 "warehouse_to" => "'$filter{na}'",
418 $select_tokens{'in'} = {
419 "bin_from" => "'$filter{na}'",
420 "warehouse_from" => "'$filter{na}'",
423 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
425 # build the select clauses.
426 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
427 for my $i ('trans', 'out', 'in') {
428 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
429 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
432 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
433 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
435 $where_clause = defined($where_clause) ? $where_clause : '';
438 qq|SELECT DISTINCT $select{trans}
440 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
441 LEFT JOIN parts p ON i1.parts_id = p.id
442 LEFT JOIN bin b1 ON i1.bin_id = b1.id
443 LEFT JOIN bin b2 ON i2.bin_id = b2.id
444 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
445 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
446 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
447 LEFT JOIN project pr ON i1.project_id = pr.id
448 LEFT JOIN employee e ON i1.employee_id = e.id
449 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
450 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
451 GROUP BY $group_clause
455 SELECT DISTINCT $select{out}
457 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
458 LEFT JOIN parts p ON i1.parts_id = p.id
459 LEFT JOIN bin b1 ON i1.bin_id = b1.id
460 LEFT JOIN bin b2 ON i2.bin_id = b2.id
461 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
462 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
463 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
464 LEFT JOIN project pr ON i1.project_id = pr.id
465 LEFT JOIN employee e ON i1.employee_id = e.id
466 WHERE $where_clause i1.qty < 0 AND
467 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
468 GROUP BY $group_clause
472 SELECT DISTINCT $select{in}
474 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
475 LEFT JOIN parts p ON i1.parts_id = p.id
476 LEFT JOIN bin b1 ON i1.bin_id = b1.id
477 LEFT JOIN bin b2 ON i2.bin_id = b2.id
478 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
479 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
480 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
481 LEFT JOIN project pr ON i1.project_id = pr.id
482 LEFT JOIN employee e ON i1.employee_id = e.id
483 WHERE $where_clause i1.qty > 0 AND
484 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
485 GROUP BY $group_clause
486 ORDER BY r_${sort_spec}|;
488 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
490 my ($h_oe_id, $q_oe_id);
491 if ($form->{l_oe_id}) {
494 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
496 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
497 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
498 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
499 ELSE 'purchase_order'
506 SELECT dord.id AS id, dord.donumber AS number,
508 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
509 ELSE 'sales_delivery_order'
511 FROM delivery_orders dord
516 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
522 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
528 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
530 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
534 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
536 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
538 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
542 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
543 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
544 my $qty = $ref->{"qty"} * 1;
546 next unless ($qty > 0);
549 my $part_unit = $all_units->{$ref->{"partunit"}};
550 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
551 $qty *= $part_unit->{"factor"};
552 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
553 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
554 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
557 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
558 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
559 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
560 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
563 push @contents, $ref;
567 $h_oe_id->finish() if $h_oe_id;
569 $main::lxdebug->leave_sub();
575 # This sub is the primary function to retrieve information about items in warehouses.
576 # $filter is a hashref and supports the following keys:
577 # - warehouse_id - will return matches with this warehouse_id only
578 # - partnumber - will return only matches where the given string is a substring of the partnumber
579 # - partsid - will return matches with this parts_id only
580 # - description - will return only matches where the given string is a substring of the description
581 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
582 # - bestbefore - will return only matches with this bestbefore date
583 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
584 # - charge_ids - must be an arrayref. will return contents with these ids only
585 # - expires_in - will only return matches that expire within the given number of days
586 # will also add a column named 'has_expired' containing if the match has already expired or not
587 # - hazardous - will return matches with the flag hazardous only
588 # - oil - will return matches with the flag oil only
589 # - qty, qty_op - quantity filter (more info to come)
590 # - sort, order_by - sorting (more to come)
591 # - reservation - will provide an extra column containing the amount reserved of this match
592 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
594 sub get_warehouse_report {
595 $main::lxdebug->enter_sub();
600 my $myconfig = \%main::myconfig;
601 my $form = $main::form;
603 my $all_units = AM->retrieve_units($myconfig, $form);
605 # connect to database
606 my $dbh = $form->get_standard_dbh($myconfig);
609 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
611 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
613 if ($filter{warehouse_id}) {
614 push @wh_bin_filter_ary, "w.id = ?";
615 push @wh_bin_filter_vars, $filter{warehouse_id};
618 if ($filter{bin_id}) {
619 push @wh_bin_filter_ary, "b.id = ?";
620 push @wh_bin_filter_vars, $filter{bin_id};
623 push @filter_ary, @wh_bin_filter_ary;
624 push @filter_vars, @wh_bin_filter_vars;
626 if ($filter{partnumber}) {
627 push @filter_ary, "p.partnumber ILIKE ?";
628 push @filter_vars, like($filter{partnumber});
631 if ($filter{description}) {
632 push @filter_ary, "p.description ILIKE ?";
633 push @filter_vars, like($filter{description});
636 if ($filter{partsid}) {
637 push @filter_ary, "p.id = ?";
638 push @filter_vars, $filter{partsid};
641 if ($filter{chargenumber}) {
642 push @filter_ary, "i.chargenumber ILIKE ?";
643 push @filter_vars, like($filter{chargenumber});
646 if (trim($form->{bestbefore})) {
647 push @filter_ary, "?::DATE = i.bestbefore::DATE";
648 push @filter_vars, trim($form->{bestbefore});
652 push @filter_ary, "p.ean ILIKE ?";
653 push @filter_vars, like($filter{ean});
656 if (trim($filter{date})) {
657 push @filter_ary, "i.shippingdate <= ?";
658 push @filter_vars, trim($filter{date});
660 if (!$filter{include_invalid_warehouses}){
661 push @filter_ary, "NOT (w.invalid)";
664 # prepare qty comparison for later filtering
665 my ($f_qty_op, $f_qty, $f_qty_base_unit);
667 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
668 $f_qty_op = $filter{qty_op};
669 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
670 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
673 map { $_ = "(${_})"; } @filter_ary;
675 # if of a property number or description is requested,
676 # automatically check the matching id too.
677 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
679 # make order, search in $filter and $form
680 my $sort_col = $form->{sort};
681 my $sort_order = $form->{order};
683 $sort_col = $filter{sort} unless $sort_col;
684 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
685 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
686 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
687 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
688 # S.a. Bug 1597 jb 12.5.2011
689 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
690 $sort_order = $filter{order} unless $sort_order;
691 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
692 my $orderby = $sort_col;
693 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
695 my $where_clause = join " AND ", ("1=1", @filter_ary);
697 my %select_tokens = (
698 "parts_id" => "i.parts_id",
699 "qty" => "SUM(i.qty)",
700 "warehouseid" => "i.warehouse_id",
701 "partnumber" => "p.partnumber",
702 "partdescription" => "p.description",
703 "bindescription" => "b.description",
705 "chargenumber" => "i.chargenumber",
706 "bestbefore" => "i.bestbefore",
708 "chargeid" => "c.id",
709 "warehousedescription" => "w.description",
710 "partunit" => "p.unit",
711 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
713 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
714 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
715 qw(l_parts_id l_qty l_partunit) );
717 my $group_clause = join ", ", map { +/^l_/; "$'" }
718 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
719 qw(l_parts_id l_partunit) );
722 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
725 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
726 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
727 qw(l_parts_id l_qty l_partunit) );
730 qq|SELECT $select_clause
732 LEFT JOIN parts p ON i.parts_id = p.id
733 LEFT JOIN bin b ON i.bin_id = b.id
734 LEFT JOIN warehouse w ON i.warehouse_id = w.id
737 GROUP BY $group_clause
738 ORDER BY $sort_spec|;
740 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
742 my (%non_empty_bins, @all_fields, @contents);
744 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
746 my $qty = $ref->{qty};
748 next unless ($qty != 0);
751 my $part_unit = $all_units->{$ref->{partunit}};
752 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
753 $qty *= $part_unit->{factor};
754 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
755 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
756 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
759 if ($form->{include_empty_bins}) {
760 $non_empty_bins{$ref->{binid}} = 1;
761 @all_fields = keys %{ $ref } unless (@all_fields);
764 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
766 push @contents, $ref;
771 if ($form->{include_empty_bins}) {
774 w.id AS warehouseid, w.description AS warehousedescription,
775 b.id AS binid, b.description AS bindescription
777 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
779 @filter_ary = @wh_bin_filter_ary;
780 @filter_vars = @wh_bin_filter_vars;
782 my @non_empty_bin_ids = keys %non_empty_bins;
783 if (@non_empty_bin_ids) {
784 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
785 push @filter_vars, @non_empty_bin_ids;
788 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
790 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
792 while (my $ref = $sth->fetchrow_hashref()) {
793 map { $ref->{$_} ||= "" } @all_fields;
794 push @contents, $ref;
798 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
799 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
803 $main::lxdebug->leave_sub();
809 $main::lxdebug->enter_sub();
811 my ($self, $qty_op) = @_;
813 if (!$qty_op || ($qty_op eq "dontcare")) {
814 $main::lxdebug->leave_sub();
818 if ($qty_op eq "atleast") {
820 } elsif ($qty_op eq "atmost") {
826 $main::lxdebug->leave_sub();
831 sub retrieve_transfer_types {
832 $main::lxdebug->enter_sub();
835 my $direction = shift;
837 my $myconfig = \%main::myconfig;
838 my $form = $main::form;
840 my $dbh = $form->get_standard_dbh($myconfig);
842 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
844 $main::lxdebug->leave_sub();
849 sub get_basic_bin_info {
850 $main::lxdebug->enter_sub();
855 Common::check_params(\%params, qw(id));
857 my $myconfig = \%main::myconfig;
858 my $form = $main::form;
860 my $dbh = $params{dbh} || $form->get_standard_dbh();
862 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
865 qq|SELECT b.id AS bin_id, b.description AS bin_description,
866 w.id AS warehouse_id, w.description AS warehouse_description
868 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
869 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
871 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
873 if ('' eq ref $params{id}) {
874 $result = $result->[0] || { };
875 $main::lxdebug->leave_sub();
880 $main::lxdebug->leave_sub();
882 return map { $_->{bin_id} => $_ } @{ $result };
885 # Eingabe: Teilenummer, Lagernummer (warehouse)
886 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
888 sub get_max_qty_parts {
889 $main::lxdebug->enter_sub();
894 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
896 my $myconfig = \%main::myconfig;
897 my $form = $main::form;
899 my $dbh = $params{dbh} || $form->get_standard_dbh();
901 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
902 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
905 my $max_qty_parts = 0; #Initialisierung mit 0
906 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
907 $max_qty_parts += $ref->{sum};
910 $main::lxdebug->leave_sub();
912 return $max_qty_parts;
916 # Eingabe: Teilenummer, Lagernummer (warehouse)
917 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
919 sub get_part_description {
920 $main::lxdebug->enter_sub();
925 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
927 my $myconfig = \%main::myconfig;
928 my $form = $main::form;
930 my $dbh = $params{dbh} || $form->get_standard_dbh();
932 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
934 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
936 my $ref = $sth->fetchrow_hashref();
937 my $part_description = $ref->{partnumber} . " " . $ref->{description};
939 $main::lxdebug->leave_sub();
941 return $part_description;
944 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
945 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
946 # Bzw. Fehler, falls Chargen oder bestbefore
947 # bei eingelagerten Teilen definiert sind.
949 sub get_max_qty_parts_bin {
950 $main::lxdebug->enter_sub();
955 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
957 my $myconfig = \%main::myconfig;
958 my $form = $main::form;
960 my $dbh = $params{dbh} || $form->get_standard_dbh();
962 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
963 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
965 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
967 my $max_qty_parts = 0; #Initialisierung mit 0
968 # falls derselbe artikel mehrmals eingelagert ist
969 # chargennummer, muss entsprechend händisch agiert werden
972 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
973 $max_qty_parts += $ref->{sum};
975 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
979 $main::lxdebug->leave_sub();
981 return ($max_qty_parts, $error);
990 SL::WH - Warehouse backend
995 WH->transfer(\%params);
999 Backend for kivitendo warehousing functions.
1003 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1005 This is the main function to manipulate warehouse contents. A typical transfer
1006 is called like this:
1011 transfer_type => 'transfer',
1012 src_warehouse_id => 12,
1014 dst_warehouse_id => 25,
1018 It will generate an entry in inventory representing the transfer. Note that
1019 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1020 a destination or a src is mandatory.
1022 transfer accepts more than one transaction parameter, each being a hash ref. If
1023 more than one is supplied, it is guaranteed, that all are processed in the same
1026 Here is a full list of parameters. All "_id" parameters except oe and
1027 orderitems can be called without id with RDB objects as well.
1033 The id of the article transferred. Does not check if the article is a service.
1038 Quantity of the transaction. Mandatory.
1042 Unit of the transaction. Optional.
1046 =item transfer_type_id
1048 The type of transaction. The first version is a string describing the
1049 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1050 every system), the id is the hard id of a transfer_type from the database.
1052 Depending of the direction of the transfer_type, source and/or destination must
1055 One of transfer_type or transfer_type_id is mandatory.
1057 =item src_warehouse_id
1061 Warehouse and bin from which to transfer. Mandatory in transfer and out
1062 directions. Ignored in in directions.
1064 =item dst_warehouse_id
1068 Warehouse and bin to which to transfer. Mandatory in transfer and in
1069 directions. Ignored in out directions.
1073 If given, the transfer will transfer only articles with this chargenumber.
1078 Reference to an orderitem for which this transfer happened. Optional
1082 Reference to an order for which this transfer happened. Optional
1086 An optional comment.
1090 An expiration date. Note that this is not by default used by C<warehouse_report>.