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 parts_id,qty 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};
208 # Überprüfen, ob diese Anzahl gefertigt werden kann
209 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
210 warehouse_id => $params{dst_warehouse_id});
212 if ($partsQTY > $max_parts){
213 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
214 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
216 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
217 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
218 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
219 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
222 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
223 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
224 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
225 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
226 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
227 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
229 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
230 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
231 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
233 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
234 my $tmpPartsQTY = $partsQTY;
236 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
237 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
238 my $temppart_chargenumber = $temphash_ref->{chargenumber};
239 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
240 my $temppart_qty = $temphash_ref->{sum};
242 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
243 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
244 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
245 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
246 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
247 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
248 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
249 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
250 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
251 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
253 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
254 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
255 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
256 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
257 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
259 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
260 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
261 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
262 last; # beendet die schleife (springt zum letzten element)
264 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
265 } #ende while select parts_id,qty from assembly where id = ?
267 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
268 # keine einzelteile definiert
269 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
270 Dementsprechend kann auch nichts hergestellt werden";
272 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
273 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
274 if ($kannNichtFertigen) {
275 return $kannNichtFertigen;
278 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
279 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
280 comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
281 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
282 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
283 (select current_date))|;
284 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
285 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
286 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
289 $main::lxdebug->leave_sub();
290 return 1; # Alles erfolgreich
293 sub get_warehouse_journal {
294 $main::lxdebug->enter_sub();
299 my $myconfig = \%main::myconfig;
300 my $form = $main::form;
302 my $all_units = AM->retrieve_units($myconfig, $form);
304 # connect to database
305 my $dbh = $form->get_standard_dbh($myconfig);
308 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
310 if ($filter{warehouse_id}) {
311 push @filter_ary, "w1.id = ? OR w2.id = ?";
312 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
315 if ($filter{bin_id}) {
316 push @filter_ary, "b1.id = ? OR b2.id = ?";
317 push @filter_vars, $filter{bin_id}, $filter{bin_id};
320 if ($filter{partnumber}) {
321 push @filter_ary, "p.partnumber ILIKE ?";
322 push @filter_vars, like($filter{partnumber});
325 if ($filter{description}) {
326 push @filter_ary, "(p.description ILIKE ?)";
327 push @filter_vars, like($filter{description});
330 if ($filter{chargenumber}) {
331 push @filter_ary, "i1.chargenumber ILIKE ?";
332 push @filter_vars, like($filter{chargenumber});
335 if (trim($form->{bestbefore})) {
336 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
337 push @filter_vars, trim($form->{bestbefore});
340 if (trim($form->{fromdate})) {
341 push @filter_ary, "? <= i1.shippingdate";
342 push @filter_vars, trim($form->{fromdate});
345 if (trim($form->{todate})) {
346 push @filter_ary, "? >= i1.shippingdate";
347 push @filter_vars, trim($form->{todate});
350 if ($form->{l_employee}) {
354 # prepare qty comparison for later filtering
355 my ($f_qty_op, $f_qty, $f_qty_base_unit);
356 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
357 $f_qty_op = $filter{qty_op};
358 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
359 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
362 map { $_ = "(${_})"; } @filter_ary;
364 # if of a property number or description is requested,
365 # automatically check the matching id too.
366 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
368 # customize shown entry for not available fields.
369 $filter{na} = '-' unless $filter{na};
371 # make order, search in $filter and $form
372 my $sort_col = $form->{sort};
373 my $sort_order = $form->{order};
375 $sort_col = $filter{sort} unless $sort_col;
376 $sort_order = ($sort_col = 'shippingdate') unless $sort_col;
377 $sort_col = 'shippingdate' if $sort_col eq 'date';
378 $sort_order = $filter{order} unless $sort_order;
379 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
381 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
383 $select_tokens{'trans'} = {
384 "parts_id" => "i1.parts_id",
385 "qty" => "ABS(SUM(i1.qty))",
386 "partnumber" => "p.partnumber",
387 "partdescription" => "p.description",
388 "bindescription" => "b.description",
389 "chargenumber" => "i1.chargenumber",
390 "bestbefore" => "i1.bestbefore",
391 "warehousedescription" => "w.description",
392 "partunit" => "p.unit",
393 "bin_from" => "b1.description",
394 "bin_to" => "b2.description",
395 "warehouse_from" => "w1.description",
396 "warehouse_to" => "w2.description",
397 "comment" => "i1.comment",
398 "trans_type" => "tt.description",
399 "trans_id" => "i1.trans_id",
400 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
401 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
402 "date" => "i1.shippingdate",
403 "itime" => "i1.itime",
404 "shippingdate" => "i1.shippingdate",
405 "employee" => "e.name",
406 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
409 $select_tokens{'out'} = {
410 "bin_to" => "'$filter{na}'",
411 "warehouse_to" => "'$filter{na}'",
414 $select_tokens{'in'} = {
415 "bin_from" => "'$filter{na}'",
416 "warehouse_from" => "'$filter{na}'",
419 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
421 # build the select clauses.
422 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
423 for my $i ('trans', 'out', 'in') {
424 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
425 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
428 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
429 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate) );
431 $where_clause = defined($where_clause) ? $where_clause : '';
434 qq|SELECT DISTINCT $select{trans}
436 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
437 LEFT JOIN parts p ON i1.parts_id = p.id
438 LEFT JOIN bin b1 ON i1.bin_id = b1.id
439 LEFT JOIN bin b2 ON i2.bin_id = b2.id
440 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
441 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
442 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
443 LEFT JOIN project pr ON i1.project_id = pr.id
444 LEFT JOIN employee e ON i1.employee_id = e.id
445 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
446 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
447 GROUP BY $group_clause
451 SELECT DISTINCT $select{out}
453 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
454 LEFT JOIN parts p ON i1.parts_id = p.id
455 LEFT JOIN bin b1 ON i1.bin_id = b1.id
456 LEFT JOIN bin b2 ON i2.bin_id = b2.id
457 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
458 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
459 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
460 LEFT JOIN project pr ON i1.project_id = pr.id
461 LEFT JOIN employee e ON i1.employee_id = e.id
462 WHERE $where_clause i1.qty < 0 AND
463 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
464 GROUP BY $group_clause
468 SELECT DISTINCT $select{in}
470 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
471 LEFT JOIN parts p ON i1.parts_id = p.id
472 LEFT JOIN bin b1 ON i1.bin_id = b1.id
473 LEFT JOIN bin b2 ON i2.bin_id = b2.id
474 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
475 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
476 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
477 LEFT JOIN project pr ON i1.project_id = pr.id
478 LEFT JOIN employee e ON i1.employee_id = e.id
479 WHERE $where_clause i1.qty > 0 AND
480 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
481 GROUP BY $group_clause
482 ORDER BY r_${sort_spec}|;
484 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
486 my ($h_oe_id, $q_oe_id);
487 if ($form->{l_oe_id}) {
490 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
492 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
493 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
494 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
495 ELSE 'purchase_order'
502 SELECT dord.id AS id, dord.donumber AS number,
504 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
505 ELSE 'sales_delivery_order'
507 FROM delivery_orders dord
512 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
518 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
524 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
526 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
530 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
532 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
534 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
538 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
539 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
540 my $qty = $ref->{"qty"} * 1;
542 next unless ($qty > 0);
545 my $part_unit = $all_units->{$ref->{"partunit"}};
546 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
547 $qty *= $part_unit->{"factor"};
548 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
549 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
550 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
553 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
554 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
555 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
556 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
559 push @contents, $ref;
563 $h_oe_id->finish() if $h_oe_id;
565 $main::lxdebug->leave_sub();
571 # This sub is the primary function to retrieve information about items in warehouses.
572 # $filter is a hashref and supports the following keys:
573 # - warehouse_id - will return matches with this warehouse_id only
574 # - partnumber - will return only matches where the given string is a substring of the partnumber
575 # - partsid - will return matches with this parts_id only
576 # - description - will return only matches where the given string is a substring of the description
577 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
578 # - bestbefore - will return only matches with this bestbefore date
579 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
580 # - charge_ids - must be an arrayref. will return contents with these ids only
581 # - expires_in - will only return matches that expire within the given number of days
582 # will also add a column named 'has_expired' containing if the match has already expired or not
583 # - hazardous - will return matches with the flag hazardous only
584 # - oil - will return matches with the flag oil only
585 # - qty, qty_op - quantity filter (more info to come)
586 # - sort, order_by - sorting (more to come)
587 # - reservation - will provide an extra column containing the amount reserved of this match
588 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
590 sub get_warehouse_report {
591 $main::lxdebug->enter_sub();
596 my $myconfig = \%main::myconfig;
597 my $form = $main::form;
599 my $all_units = AM->retrieve_units($myconfig, $form);
601 # connect to database
602 my $dbh = $form->get_standard_dbh($myconfig);
605 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
607 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
609 if ($filter{warehouse_id}) {
610 push @wh_bin_filter_ary, "w.id = ?";
611 push @wh_bin_filter_vars, $filter{warehouse_id};
614 if ($filter{bin_id}) {
615 push @wh_bin_filter_ary, "b.id = ?";
616 push @wh_bin_filter_vars, $filter{bin_id};
619 push @filter_ary, @wh_bin_filter_ary;
620 push @filter_vars, @wh_bin_filter_vars;
622 if ($filter{partnumber}) {
623 push @filter_ary, "p.partnumber ILIKE ?";
624 push @filter_vars, like($filter{partnumber});
627 if ($filter{description}) {
628 push @filter_ary, "p.description ILIKE ?";
629 push @filter_vars, like($filter{description});
632 if ($filter{partsid}) {
633 push @filter_ary, "p.id = ?";
634 push @filter_vars, $filter{partsid};
637 if ($filter{chargenumber}) {
638 push @filter_ary, "i.chargenumber ILIKE ?";
639 push @filter_vars, like($filter{chargenumber});
642 if (trim($form->{bestbefore})) {
643 push @filter_ary, "?::DATE = i.bestbefore::DATE";
644 push @filter_vars, trim($form->{bestbefore});
648 push @filter_ary, "p.ean ILIKE ?";
649 push @filter_vars, like($filter{ean});
652 if (trim($filter{date})) {
653 push @filter_ary, "i.shippingdate <= ?";
654 push @filter_vars, trim($filter{date});
656 if (!$filter{include_invalid_warehouses}){
657 push @filter_ary, "NOT (w.invalid)";
660 # prepare qty comparison for later filtering
661 my ($f_qty_op, $f_qty, $f_qty_base_unit);
663 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
664 $f_qty_op = $filter{qty_op};
665 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
666 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
669 map { $_ = "(${_})"; } @filter_ary;
671 # if of a property number or description is requested,
672 # automatically check the matching id too.
673 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
675 # make order, search in $filter and $form
676 my $sort_col = $form->{sort};
677 my $sort_order = $form->{order};
679 $sort_col = $filter{sort} unless $sort_col;
680 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
681 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
682 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
683 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
684 # S.a. Bug 1597 jb 12.5.2011
685 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
686 $sort_order = $filter{order} unless $sort_order;
687 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
688 my $orderby = $sort_col;
689 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
691 my $where_clause = join " AND ", ("1=1", @filter_ary);
693 my %select_tokens = (
694 "parts_id" => "i.parts_id",
695 "qty" => "SUM(i.qty)",
696 "warehouseid" => "i.warehouse_id",
697 "partnumber" => "p.partnumber",
698 "partdescription" => "p.description",
699 "bindescription" => "b.description",
701 "chargenumber" => "i.chargenumber",
702 "bestbefore" => "i.bestbefore",
704 "chargeid" => "c.id",
705 "warehousedescription" => "w.description",
706 "partunit" => "p.unit",
707 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
709 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
710 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
711 qw(l_parts_id l_qty l_partunit) );
713 my $group_clause = join ", ", map { +/^l_/; "$'" }
714 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
715 qw(l_parts_id l_partunit) );
718 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
721 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
722 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
723 qw(l_parts_id l_qty l_partunit) );
726 qq|SELECT $select_clause
728 LEFT JOIN parts p ON i.parts_id = p.id
729 LEFT JOIN bin b ON i.bin_id = b.id
730 LEFT JOIN warehouse w ON i.warehouse_id = w.id
733 GROUP BY $group_clause
734 ORDER BY $sort_spec|;
736 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
738 my (%non_empty_bins, @all_fields, @contents);
740 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
742 my $qty = $ref->{qty};
744 next unless ($qty != 0);
747 my $part_unit = $all_units->{$ref->{partunit}};
748 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
749 $qty *= $part_unit->{factor};
750 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
751 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
752 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
755 if ($form->{include_empty_bins}) {
756 $non_empty_bins{$ref->{binid}} = 1;
757 @all_fields = keys %{ $ref } unless (@all_fields);
760 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
762 push @contents, $ref;
767 if ($form->{include_empty_bins}) {
770 w.id AS warehouseid, w.description AS warehousedescription,
771 b.id AS binid, b.description AS bindescription
773 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
775 @filter_ary = @wh_bin_filter_ary;
776 @filter_vars = @wh_bin_filter_vars;
778 my @non_empty_bin_ids = keys %non_empty_bins;
779 if (@non_empty_bin_ids) {
780 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
781 push @filter_vars, @non_empty_bin_ids;
784 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
786 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
788 while (my $ref = $sth->fetchrow_hashref()) {
789 map { $ref->{$_} ||= "" } @all_fields;
790 push @contents, $ref;
794 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
795 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
799 $main::lxdebug->leave_sub();
805 $main::lxdebug->enter_sub();
807 my ($self, $qty_op) = @_;
809 if (!$qty_op || ($qty_op eq "dontcare")) {
810 $main::lxdebug->leave_sub();
814 if ($qty_op eq "atleast") {
816 } elsif ($qty_op eq "atmost") {
822 $main::lxdebug->leave_sub();
827 sub retrieve_transfer_types {
828 $main::lxdebug->enter_sub();
831 my $direction = shift;
833 my $myconfig = \%main::myconfig;
834 my $form = $main::form;
836 my $dbh = $form->get_standard_dbh($myconfig);
838 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
840 $main::lxdebug->leave_sub();
845 sub get_basic_bin_info {
846 $main::lxdebug->enter_sub();
851 Common::check_params(\%params, qw(id));
853 my $myconfig = \%main::myconfig;
854 my $form = $main::form;
856 my $dbh = $params{dbh} || $form->get_standard_dbh();
858 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
861 qq|SELECT b.id AS bin_id, b.description AS bin_description,
862 w.id AS warehouse_id, w.description AS warehouse_description
864 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
865 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
867 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
869 if ('' eq ref $params{id}) {
870 $result = $result->[0] || { };
871 $main::lxdebug->leave_sub();
876 $main::lxdebug->leave_sub();
878 return map { $_->{bin_id} => $_ } @{ $result };
881 # Eingabe: Teilenummer, Lagernummer (warehouse)
882 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
884 sub get_max_qty_parts {
885 $main::lxdebug->enter_sub();
890 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
892 my $myconfig = \%main::myconfig;
893 my $form = $main::form;
895 my $dbh = $params{dbh} || $form->get_standard_dbh();
897 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
899 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
901 my $max_qty_parts = 0; #Initialisierung mit 0
902 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
903 $max_qty_parts += $ref->{sum};
906 $main::lxdebug->leave_sub();
908 return $max_qty_parts;
912 # Eingabe: Teilenummer, Lagernummer (warehouse)
913 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
915 sub get_part_description {
916 $main::lxdebug->enter_sub();
921 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
923 my $myconfig = \%main::myconfig;
924 my $form = $main::form;
926 my $dbh = $params{dbh} || $form->get_standard_dbh();
928 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
930 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
932 my $ref = $sth->fetchrow_hashref();
933 my $part_description = $ref->{partnumber} . " " . $ref->{description};
935 $main::lxdebug->leave_sub();
937 return $part_description;
940 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
941 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
942 # Bzw. Fehler, falls Chargen oder bestbefore
943 # bei eingelagerten Teilen definiert sind.
945 sub get_max_qty_parts_bin {
946 $main::lxdebug->enter_sub();
951 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
953 my $myconfig = \%main::myconfig;
954 my $form = $main::form;
956 my $dbh = $params{dbh} || $form->get_standard_dbh();
958 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
959 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
961 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
963 my $max_qty_parts = 0; #Initialisierung mit 0
964 # falls derselbe artikel mehrmals eingelagert ist
965 # chargennummer, muss entsprechend händisch agiert werden
968 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
969 $max_qty_parts += $ref->{sum};
971 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
975 $main::lxdebug->leave_sub();
977 return ($max_qty_parts, $error);
986 SL::WH - Warehouse backend
991 WH->transfer(\%params);
995 Backend for kivitendo warehousing functions.
999 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1001 This is the main function to manipulate warehouse contents. A typical transfer
1002 is called like this:
1007 transfer_type => 'transfer',
1008 src_warehouse_id => 12,
1010 dst_warehouse_id => 25,
1014 It will generate an entry in inventory representing the transfer. Note that
1015 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1016 a destination or a src is mandatory.
1018 transfer accepts more than one transaction parameter, each being a hash ref. If
1019 more than one is supplied, it is guaranteed, that all are processed in the same
1022 Here is a full list of parameters. All "_id" parameters except oe and
1023 orderitems can be called without id with RDB objects as well.
1029 The id of the article transferred. Does not check if the article is a service.
1034 Quantity of the transaction. Mandatory.
1038 Unit of the transaction. Optional.
1042 =item transfer_type_id
1044 The type of transaction. The first version is a string describing the
1045 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1046 every system), the id is the hard id of a transfer_type from the database.
1048 Depending of the direction of the transfer_type, source and/or destination must
1051 One of transfer_type or transfer_type_id is mandatory.
1053 =item src_warehouse_id
1057 Warehouse and bin from which to transfer. Mandatory in transfer and out
1058 directions. Ignored in in directions.
1060 =item dst_warehouse_id
1064 Warehouse and bin to which to transfer. Mandatory in transfer and in
1065 directions. Ignored in out directions.
1069 If given, the transfer will transfer only articles with this chargenumber.
1074 Reference to an orderitem for which this transfer happened. Optional
1078 Reference to an order for which this transfer happened. Optional
1082 An optional comment.
1086 An expiration date. Note that this is not by default used by C<warehouse_report>.