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,
207 trans_id, trans_type_id, shippingdate)
208 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
209 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
210 (SELECT current_date))|;
211 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
213 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
215 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
216 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
217 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
218 $schleife_durchlaufen=1; # Erzeugnis definiert
219 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
220 my $currentPart_ID = $hash_ref->{parts_id};
222 # Überprüfen, ob diese Anzahl gefertigt werden kann
223 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
224 warehouse_id => $params{dst_warehouse_id});
226 if ($partsQTY > $max_parts){
227 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
228 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
230 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
231 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
232 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
233 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
236 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
237 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
238 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
239 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
240 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
241 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
243 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
244 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
245 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
247 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
248 my $tmpPartsQTY = $partsQTY;
250 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
251 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
252 my $temppart_chargenumber = $temphash_ref->{chargenumber};
253 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
254 my $temppart_qty = $temphash_ref->{sum};
256 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
257 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
258 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
259 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
260 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
261 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
262 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
263 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
264 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
265 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
267 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
268 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
269 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
270 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
271 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
273 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
274 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
275 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
276 last; # beendet die schleife (springt zum letzten element)
278 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
279 } #ende while select parts_id,qty from assembly where id = ?
281 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
282 # keine einzelteile definiert
283 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
284 Dementsprechend kann auch nichts hergestellt werden";
286 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
287 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
288 if ($kannNichtFertigen) {
289 return $kannNichtFertigen;
292 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
293 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
294 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
295 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
296 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
297 (select current_date))|;
298 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
299 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
300 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
303 $main::lxdebug->leave_sub();
304 return 1; # Alles erfolgreich
307 sub get_warehouse_journal {
308 $main::lxdebug->enter_sub();
313 my $myconfig = \%main::myconfig;
314 my $form = $main::form;
316 my $all_units = AM->retrieve_units($myconfig, $form);
318 # connect to database
319 my $dbh = $form->get_standard_dbh($myconfig);
322 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
324 if ($filter{warehouse_id}) {
325 push @filter_ary, "w1.id = ? OR w2.id = ?";
326 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
329 if ($filter{bin_id}) {
330 push @filter_ary, "b1.id = ? OR b2.id = ?";
331 push @filter_vars, $filter{bin_id}, $filter{bin_id};
334 if ($filter{partnumber}) {
335 push @filter_ary, "p.partnumber ILIKE ?";
336 push @filter_vars, like($filter{partnumber});
339 if ($filter{description}) {
340 push @filter_ary, "(p.description ILIKE ?)";
341 push @filter_vars, like($filter{description});
344 if ($filter{chargenumber}) {
345 push @filter_ary, "i1.chargenumber ILIKE ?";
346 push @filter_vars, like($filter{chargenumber});
349 if (trim($form->{bestbefore})) {
350 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
351 push @filter_vars, trim($form->{bestbefore});
354 if (trim($form->{fromdate})) {
355 push @filter_ary, "? <= i1.shippingdate";
356 push @filter_vars, trim($form->{fromdate});
359 if (trim($form->{todate})) {
360 push @filter_ary, "? >= i1.shippingdate";
361 push @filter_vars, trim($form->{todate});
364 if ($form->{l_employee}) {
368 # prepare qty comparison for later filtering
369 my ($f_qty_op, $f_qty, $f_qty_base_unit);
370 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
371 $f_qty_op = $filter{qty_op};
372 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
373 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
376 map { $_ = "(${_})"; } @filter_ary;
378 # if of a property number or description is requested,
379 # automatically check the matching id too.
380 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
382 # customize shown entry for not available fields.
383 $filter{na} = '-' unless $filter{na};
385 # make order, search in $filter and $form
386 my $sort_col = $form->{sort};
387 my $sort_order = $form->{order};
389 $sort_col = $filter{sort} unless $sort_col;
390 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
391 $sort_col = 'shippingdate' if $sort_col eq 'date';
392 $sort_order = $filter{order} unless $sort_order;
393 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
395 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
397 $select_tokens{'trans'} = {
398 "parts_id" => "i1.parts_id",
399 "qty" => "ABS(SUM(i1.qty))",
400 "partnumber" => "p.partnumber",
401 "partdescription" => "p.description",
402 "bindescription" => "b.description",
403 "chargenumber" => "i1.chargenumber",
404 "bestbefore" => "i1.bestbefore",
405 "warehousedescription" => "w.description",
406 "partunit" => "p.unit",
407 "bin_from" => "b1.description",
408 "bin_to" => "b2.description",
409 "warehouse_from" => "w1.description",
410 "warehouse_to" => "w2.description",
411 "comment" => "i1.comment",
412 "trans_type" => "tt.description",
413 "trans_id" => "i1.trans_id",
414 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
415 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
416 "date" => "i1.shippingdate",
417 "itime" => "i1.itime",
418 "shippingdate" => "i1.shippingdate",
419 "employee" => "e.name",
420 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
423 $select_tokens{'out'} = {
424 "bin_to" => "'$filter{na}'",
425 "warehouse_to" => "'$filter{na}'",
428 $select_tokens{'in'} = {
429 "bin_from" => "'$filter{na}'",
430 "warehouse_from" => "'$filter{na}'",
433 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
435 # build the select clauses.
436 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
437 for my $i ('trans', 'out', 'in') {
438 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
439 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
442 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
443 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
445 $where_clause = defined($where_clause) ? $where_clause : '';
448 qq|SELECT DISTINCT $select{trans}
450 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
451 LEFT JOIN parts p ON i1.parts_id = p.id
452 LEFT JOIN bin b1 ON i1.bin_id = b1.id
453 LEFT JOIN bin b2 ON i2.bin_id = b2.id
454 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
455 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
456 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
457 LEFT JOIN project pr ON i1.project_id = pr.id
458 LEFT JOIN employee e ON i1.employee_id = e.id
459 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
460 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
461 GROUP BY $group_clause
465 SELECT DISTINCT $select{out}
467 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
468 LEFT JOIN parts p ON i1.parts_id = p.id
469 LEFT JOIN bin b1 ON i1.bin_id = b1.id
470 LEFT JOIN bin b2 ON i2.bin_id = b2.id
471 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
472 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
473 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
474 LEFT JOIN project pr ON i1.project_id = pr.id
475 LEFT JOIN employee e ON i1.employee_id = e.id
476 WHERE $where_clause i1.qty < 0 AND
477 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
478 GROUP BY $group_clause
482 SELECT DISTINCT $select{in}
484 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
485 LEFT JOIN parts p ON i1.parts_id = p.id
486 LEFT JOIN bin b1 ON i1.bin_id = b1.id
487 LEFT JOIN bin b2 ON i2.bin_id = b2.id
488 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
489 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
490 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
491 LEFT JOIN project pr ON i1.project_id = pr.id
492 LEFT JOIN employee e ON i1.employee_id = e.id
493 WHERE $where_clause i1.qty > 0 AND
494 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
495 GROUP BY $group_clause
496 ORDER BY r_${sort_spec}|;
498 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
500 my ($h_oe_id, $q_oe_id);
501 if ($form->{l_oe_id}) {
504 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
506 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
507 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
508 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
509 ELSE 'purchase_order'
516 SELECT dord.id AS id, dord.donumber AS number,
518 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
519 ELSE 'sales_delivery_order'
521 FROM delivery_orders dord
526 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
532 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
538 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
540 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
544 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
546 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
548 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
552 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
553 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
554 my $qty = $ref->{"qty"} * 1;
556 next unless ($qty > 0);
559 my $part_unit = $all_units->{$ref->{"partunit"}};
560 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
561 $qty *= $part_unit->{"factor"};
562 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
563 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
564 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
567 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
568 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
569 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
570 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
573 push @contents, $ref;
577 $h_oe_id->finish() if $h_oe_id;
579 $main::lxdebug->leave_sub();
585 # This sub is the primary function to retrieve information about items in warehouses.
586 # $filter is a hashref and supports the following keys:
587 # - warehouse_id - will return matches with this warehouse_id only
588 # - partnumber - will return only matches where the given string is a substring of the partnumber
589 # - partsid - will return matches with this parts_id only
590 # - description - will return only matches where the given string is a substring of the description
591 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
592 # - bestbefore - will return only matches with this bestbefore date
593 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
594 # - charge_ids - must be an arrayref. will return contents with these ids only
595 # - expires_in - will only return matches that expire within the given number of days
596 # will also add a column named 'has_expired' containing if the match has already expired or not
597 # - hazardous - will return matches with the flag hazardous only
598 # - oil - will return matches with the flag oil only
599 # - qty, qty_op - quantity filter (more info to come)
600 # - sort, order_by - sorting (more to come)
601 # - reservation - will provide an extra column containing the amount reserved of this match
602 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
604 sub get_warehouse_report {
605 $main::lxdebug->enter_sub();
610 my $myconfig = \%main::myconfig;
611 my $form = $main::form;
613 my $all_units = AM->retrieve_units($myconfig, $form);
615 # connect to database
616 my $dbh = $form->get_standard_dbh($myconfig);
619 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
621 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
623 if ($filter{warehouse_id}) {
624 push @wh_bin_filter_ary, "w.id = ?";
625 push @wh_bin_filter_vars, $filter{warehouse_id};
628 if ($filter{bin_id}) {
629 push @wh_bin_filter_ary, "b.id = ?";
630 push @wh_bin_filter_vars, $filter{bin_id};
633 push @filter_ary, @wh_bin_filter_ary;
634 push @filter_vars, @wh_bin_filter_vars;
636 if ($filter{partnumber}) {
637 push @filter_ary, "p.partnumber ILIKE ?";
638 push @filter_vars, like($filter{partnumber});
641 if ($filter{description}) {
642 push @filter_ary, "p.description ILIKE ?";
643 push @filter_vars, like($filter{description});
646 if ($filter{partsid}) {
647 push @filter_ary, "p.id = ?";
648 push @filter_vars, $filter{partsid};
651 if ($filter{chargenumber}) {
652 push @filter_ary, "i.chargenumber ILIKE ?";
653 push @filter_vars, like($filter{chargenumber});
656 if (trim($form->{bestbefore})) {
657 push @filter_ary, "?::DATE = i.bestbefore::DATE";
658 push @filter_vars, trim($form->{bestbefore});
662 push @filter_ary, "p.ean ILIKE ?";
663 push @filter_vars, like($filter{ean});
666 if (trim($filter{date})) {
667 push @filter_ary, "i.shippingdate <= ?";
668 push @filter_vars, trim($filter{date});
670 if (!$filter{include_invalid_warehouses}){
671 push @filter_ary, "NOT (w.invalid)";
674 # prepare qty comparison for later filtering
675 my ($f_qty_op, $f_qty, $f_qty_base_unit);
677 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
678 $f_qty_op = $filter{qty_op};
679 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
680 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
683 map { $_ = "(${_})"; } @filter_ary;
685 # if of a property number or description is requested,
686 # automatically check the matching id too.
687 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
689 # make order, search in $filter and $form
690 my $sort_col = $form->{sort};
691 my $sort_order = $form->{order};
693 $sort_col = $filter{sort} unless $sort_col;
694 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
695 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
696 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
697 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
698 # S.a. Bug 1597 jb 12.5.2011
699 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
700 $sort_order = $filter{order} unless $sort_order;
701 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
702 my $orderby = $sort_col;
703 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
705 my $where_clause = join " AND ", ("1=1", @filter_ary);
707 my %select_tokens = (
708 "parts_id" => "i.parts_id",
709 "qty" => "SUM(i.qty)",
710 "warehouseid" => "i.warehouse_id",
711 "partnumber" => "p.partnumber",
712 "partdescription" => "p.description",
713 "bindescription" => "b.description",
715 "chargenumber" => "i.chargenumber",
716 "bestbefore" => "i.bestbefore",
718 "chargeid" => "c.id",
719 "warehousedescription" => "w.description",
720 "partunit" => "p.unit",
721 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
723 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
724 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
725 qw(l_parts_id l_qty l_partunit) );
727 my $group_clause = join ", ", map { +/^l_/; "$'" }
728 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
729 qw(l_parts_id l_partunit) );
732 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
735 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
736 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
737 qw(l_parts_id l_qty l_partunit) );
740 qq|SELECT $select_clause
742 LEFT JOIN parts p ON i.parts_id = p.id
743 LEFT JOIN bin b ON i.bin_id = b.id
744 LEFT JOIN warehouse w ON i.warehouse_id = w.id
747 GROUP BY $group_clause
748 ORDER BY $sort_spec|;
750 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
752 my (%non_empty_bins, @all_fields, @contents);
754 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
756 my $qty = $ref->{qty};
758 next unless ($qty != 0);
761 my $part_unit = $all_units->{$ref->{partunit}};
762 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
763 $qty *= $part_unit->{factor};
764 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
765 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
766 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
769 if ($form->{include_empty_bins}) {
770 $non_empty_bins{$ref->{binid}} = 1;
771 @all_fields = keys %{ $ref } unless (@all_fields);
774 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
776 push @contents, $ref;
781 if ($form->{include_empty_bins}) {
784 w.id AS warehouseid, w.description AS warehousedescription,
785 b.id AS binid, b.description AS bindescription
787 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
789 @filter_ary = @wh_bin_filter_ary;
790 @filter_vars = @wh_bin_filter_vars;
792 my @non_empty_bin_ids = keys %non_empty_bins;
793 if (@non_empty_bin_ids) {
794 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
795 push @filter_vars, @non_empty_bin_ids;
798 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
800 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
802 while (my $ref = $sth->fetchrow_hashref()) {
803 map { $ref->{$_} ||= "" } @all_fields;
804 push @contents, $ref;
808 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
809 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
813 $main::lxdebug->leave_sub();
819 $main::lxdebug->enter_sub();
821 my ($self, $qty_op) = @_;
823 if (!$qty_op || ($qty_op eq "dontcare")) {
824 $main::lxdebug->leave_sub();
828 if ($qty_op eq "atleast") {
830 } elsif ($qty_op eq "atmost") {
836 $main::lxdebug->leave_sub();
841 sub retrieve_transfer_types {
842 $main::lxdebug->enter_sub();
845 my $direction = shift;
847 my $myconfig = \%main::myconfig;
848 my $form = $main::form;
850 my $dbh = $form->get_standard_dbh($myconfig);
852 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
854 $main::lxdebug->leave_sub();
859 sub get_basic_bin_info {
860 $main::lxdebug->enter_sub();
865 Common::check_params(\%params, qw(id));
867 my $myconfig = \%main::myconfig;
868 my $form = $main::form;
870 my $dbh = $params{dbh} || $form->get_standard_dbh();
872 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
875 qq|SELECT b.id AS bin_id, b.description AS bin_description,
876 w.id AS warehouse_id, w.description AS warehouse_description
878 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
879 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
881 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
883 if ('' eq ref $params{id}) {
884 $result = $result->[0] || { };
885 $main::lxdebug->leave_sub();
890 $main::lxdebug->leave_sub();
892 return map { $_->{bin_id} => $_ } @{ $result };
895 # Eingabe: Teilenummer, Lagernummer (warehouse)
896 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
898 sub get_max_qty_parts {
899 $main::lxdebug->enter_sub();
904 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
906 my $myconfig = \%main::myconfig;
907 my $form = $main::form;
909 my $dbh = $params{dbh} || $form->get_standard_dbh();
911 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
913 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
915 my $max_qty_parts = 0; #Initialisierung mit 0
916 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
917 $max_qty_parts += $ref->{sum};
920 $main::lxdebug->leave_sub();
922 return $max_qty_parts;
926 # Eingabe: Teilenummer, Lagernummer (warehouse)
927 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
929 sub get_part_description {
930 $main::lxdebug->enter_sub();
935 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
937 my $myconfig = \%main::myconfig;
938 my $form = $main::form;
940 my $dbh = $params{dbh} || $form->get_standard_dbh();
942 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
944 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
946 my $ref = $sth->fetchrow_hashref();
947 my $part_description = $ref->{partnumber} . " " . $ref->{description};
949 $main::lxdebug->leave_sub();
951 return $part_description;
954 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
955 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
956 # Bzw. Fehler, falls Chargen oder bestbefore
957 # bei eingelagerten Teilen definiert sind.
959 sub get_max_qty_parts_bin {
960 $main::lxdebug->enter_sub();
965 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
967 my $myconfig = \%main::myconfig;
968 my $form = $main::form;
970 my $dbh = $params{dbh} || $form->get_standard_dbh();
972 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
973 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
975 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
977 my $max_qty_parts = 0; #Initialisierung mit 0
978 # falls derselbe artikel mehrmals eingelagert ist
979 # chargennummer, muss entsprechend händisch agiert werden
982 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
983 $max_qty_parts += $ref->{sum};
985 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
989 $main::lxdebug->leave_sub();
991 return ($max_qty_parts, $error);
1000 SL::WH - Warehouse backend
1005 WH->transfer(\%params);
1009 Backend for kivitendo warehousing functions.
1013 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1015 This is the main function to manipulate warehouse contents. A typical transfer
1016 is called like this:
1021 transfer_type => 'transfer',
1022 src_warehouse_id => 12,
1024 dst_warehouse_id => 25,
1028 It will generate an entry in inventory representing the transfer. Note that
1029 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1030 a destination or a src is mandatory.
1032 transfer accepts more than one transaction parameter, each being a hash ref. If
1033 more than one is supplied, it is guaranteed, that all are processed in the same
1036 Here is a full list of parameters. All "_id" parameters except oe and
1037 orderitems can be called without id with RDB objects as well.
1043 The id of the article transferred. Does not check if the article is a service.
1048 Quantity of the transaction. Mandatory.
1052 Unit of the transaction. Optional.
1056 =item transfer_type_id
1058 The type of transaction. The first version is a string describing the
1059 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1060 every system), the id is the hard id of a transfer_type from the database.
1062 Depending of the direction of the transfer_type, source and/or destination must
1065 One of transfer_type or transfer_type_id is mandatory.
1067 =item src_warehouse_id
1071 Warehouse and bin from which to transfer. Mandatory in transfer and out
1072 directions. Ignored in in directions.
1074 =item dst_warehouse_id
1078 Warehouse and bin to which to transfer. Mandatory in transfer and in
1079 directions. Ignored in out directions.
1083 If given, the transfer will transfer only articles with this chargenumber.
1088 Reference to an orderitem for which this transfer happened. Optional
1092 Reference to an order for which this transfer happened. Optional
1096 An optional comment.
1100 An expiration date. Note that this is not by default used by C<warehouse_report>.