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 #======================================================================
48 $::lxdebug->enter_sub;
50 my ($self, @args) = @_;
53 $::lxdebug->leave_sub;
57 require SL::DB::TransferType;
59 require SL::DB::Employee;
60 require SL::DB::Inventory;
62 my $employee = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
63 my ($now) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
64 my @directions = (undef, qw(out in transfer));
67 my ($transfer, $field, $class, @find_by) = @_;
69 @find_by = (description => $transfer->{$field}) unless @find_by;
71 if ($transfer->{$field} || $transfer->{"${field}_id"}) {
72 return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
73 : $transfer->{$field} ? $class->_get_manager_class->find_by(@find_by)
74 : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
81 my $db = SL::DB::Inventory->new->db;
82 $db->with_transaction(sub{
83 while (my $transfer = shift @args) {
84 my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
86 my $part = $objectify->($transfer, 'parts', 'SL::DB::Part');
87 my $unit = $objectify->($transfer, 'unit', 'SL::DB::Unit', name => $transfer->{unit});
88 my $qty = $transfer->{qty};
89 my $src_bin = $objectify->($transfer, 'src_bin', 'SL::DB::Bin');
90 my $dst_bin = $objectify->($transfer, 'dst_bin', 'SL::DB::Bin');
91 my $src_wh = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
92 my $dst_wh = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
93 my $project = $objectify->($transfer, 'project', 'SL::DB::Project');
95 $src_wh ||= $src_bin->warehouse if $src_bin;
96 $dst_wh ||= $dst_bin->warehouse if $dst_bin;
98 my $direction = 0; # bit mask
99 $direction |= 1 if $src_bin;
100 $direction |= 2 if $dst_bin;
102 my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction => $directions[$direction],
103 description => $transfer->{transfer_type});
107 employee => $employee,
108 trans_type => $transfer_type,
110 trans_id => $trans_id,
111 shippingdate => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
112 ? $now : $transfer->{shippingdate},
113 map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
117 $qty = $unit->convert_to($qty, $part->unit_obj);
120 $params{chargenumber} ||= '';
122 if ($direction & 1) {
123 SL::DB::Inventory->new(
125 warehouse => $src_wh,
131 if ($direction & 2) {
132 SL::DB::Inventory->new(
134 warehouse => $dst_wh->id,
138 # Standardlagerplatz in Stammdaten gleich mitverschieben
139 if (defined($transfer->{change_default_bin})){
140 $part->update_attributes(warehouse_id => $dst_wh->id, bin_id => $dst_bin->id);
144 push @trans_ids, $trans_id;
149 $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
152 $::lxdebug->leave_sub;
157 sub transfer_assembly {
158 $main::lxdebug->enter_sub();
162 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
165 my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
167 my $assembly = SL::DB::Manager::Assembly->get_all(
168 query => [ id => $params{assembly_id} ],
169 with_objects => ['part'],
172 $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
175 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
177 my $myconfig = \%main::myconfig;
178 my $form = $main::form;
179 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
184 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
185 # select parts_id,qty from assembly where id=1064;
186 # Erweiterung für bug 935 am 23.4.09 -
187 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
188 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
189 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
191 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
192 # wenn assembly nicht überprüft wird ...
193 # patch von joachim eingespielt 24.4.2009:
194 # my $query = qq|select parts_id,qty from assembly inner join parts
195 # on assembly.parts_id = parts.id where assembly.id = ? and
196 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
199 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
200 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
202 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
204 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
205 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
206 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
207 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
208 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
210 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
212 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
213 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
214 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
215 $schleife_durchlaufen=1; # Erzeugnis definiert
216 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
217 my $currentPart_ID = $hash_ref->{parts_id};
219 # Überprüfen, ob diese Anzahl gefertigt werden kann
220 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
221 warehouse_id => $params{dst_warehouse_id});
223 if ($partsQTY > $max_parts){
224 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
225 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
227 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
228 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
229 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
230 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
233 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
234 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
235 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
236 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
237 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
238 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
240 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
241 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
242 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
244 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
245 my $tmpPartsQTY = $partsQTY;
247 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
248 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
249 my $temppart_chargenumber = $temphash_ref->{chargenumber};
250 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
251 my $temppart_qty = $temphash_ref->{sum};
253 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
254 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
255 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
256 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
257 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
258 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
259 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
260 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
261 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
262 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
264 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
265 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
266 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
267 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
268 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
270 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
271 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
272 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
273 last; # beendet die schleife (springt zum letzten element)
275 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
276 } #ende while select parts_id,qty from assembly where id = ?
278 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
279 # keine einzelteile definiert
280 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
281 Dementsprechend kann auch nichts hergestellt werden";
283 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
284 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
285 if ($kannNichtFertigen) {
286 return $kannNichtFertigen;
289 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
290 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
291 comment, employee_id, qty, trans_id, trans_type_id)
292 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
293 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
294 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
295 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
296 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
299 $main::lxdebug->leave_sub();
300 return 1; # Alles erfolgreich
303 sub get_warehouse_journal {
304 $main::lxdebug->enter_sub();
309 my $myconfig = \%main::myconfig;
310 my $form = $main::form;
312 my $all_units = AM->retrieve_units($myconfig, $form);
314 # connect to database
315 my $dbh = $form->get_standard_dbh($myconfig);
318 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
320 if ($filter{warehouse_id}) {
321 push @filter_ary, "w1.id = ? OR w2.id = ?";
322 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
325 if ($filter{bin_id}) {
326 push @filter_ary, "b1.id = ? OR b2.id = ?";
327 push @filter_vars, $filter{bin_id}, $filter{bin_id};
330 if ($filter{partnumber}) {
331 push @filter_ary, "p.partnumber ILIKE ?";
332 push @filter_vars, '%' . $filter{partnumber} . '%';
335 if ($filter{description}) {
336 push @filter_ary, "(p.description ILIKE ?)";
337 push @filter_vars, '%' . $filter{description} . '%';
340 if ($filter{chargenumber}) {
341 push @filter_ary, "i1.chargenumber ILIKE ?";
342 push @filter_vars, '%' . $filter{chargenumber} . '%';
345 if ($form->{bestbefore}) {
346 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
347 push @filter_vars, $form->{bestbefore};
350 if ($form->{fromdate}) {
351 push @filter_ary, "?::DATE <= i1.itime::DATE";
352 push @filter_vars, $form->{fromdate};
355 if ($form->{todate}) {
356 push @filter_ary, "?::DATE >= i1.itime::DATE";
357 push @filter_vars, $form->{todate};
360 if ($form->{l_employee}) {
364 # prepare qty comparison for later filtering
365 my ($f_qty_op, $f_qty, $f_qty_base_unit);
366 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
367 $f_qty_op = $filter{qty_op};
368 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
369 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
372 map { $_ = "(${_})"; } @filter_ary;
374 # if of a property number or description is requested,
375 # automatically check the matching id too.
376 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
378 # customize shown entry for not available fields.
379 $filter{na} = '-' unless $filter{na};
381 # make order, search in $filter and $form
382 my $sort_col = $form->{sort};
383 my $sort_order = $form->{order};
385 $sort_col = $filter{sort} unless $sort_col;
386 $sort_order = ($sort_col = 'itime') unless $sort_col;
387 $sort_col = 'itime' if $sort_col eq 'date';
388 $sort_order = $filter{order} unless $sort_order;
389 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
391 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
393 $select_tokens{'trans'} = {
394 "parts_id" => "i1.parts_id",
395 "qty" => "ABS(SUM(i1.qty))",
396 "partnumber" => "p.partnumber",
397 "partdescription" => "p.description",
398 "bindescription" => "b.description",
399 "chargenumber" => "i1.chargenumber",
400 "bestbefore" => "i1.bestbefore",
401 "warehousedescription" => "w.description",
402 "partunit" => "p.unit",
403 "bin_from" => "b1.description",
404 "bin_to" => "b2.description",
405 "warehouse_from" => "w1.description",
406 "warehouse_to" => "w2.description",
407 "comment" => "i1.comment",
408 "trans_type" => "tt.description",
409 "trans_id" => "i1.trans_id",
410 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
411 "invoice_id" => "COALESCE(i1.invoice_id, i2.invoice_id)",
412 "date" => "i1.itime::DATE",
413 "itime" => "i1.itime",
414 "employee" => "e.name",
415 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
418 $select_tokens{'out'} = {
419 "bin_to" => "'$filter{na}'",
420 "warehouse_to" => "'$filter{na}'",
423 $select_tokens{'in'} = {
424 "bin_from" => "'$filter{na}'",
425 "warehouse_from" => "'$filter{na}'",
428 $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
430 # build the select clauses.
431 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
432 for my $i ('trans', 'out', 'in') {
433 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
434 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
437 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
438 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
440 $where_clause = defined($where_clause) ? $where_clause : '';
442 qq|SELECT DISTINCT $select{trans}
444 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
445 LEFT JOIN parts p ON i1.parts_id = p.id
446 LEFT JOIN bin b1 ON i1.bin_id = b1.id
447 LEFT JOIN bin b2 ON i2.bin_id = b2.id
448 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
449 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
450 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
451 LEFT JOIN project pr ON i1.project_id = pr.id
452 LEFT JOIN employee e ON i1.employee_id = e.id
453 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
454 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
455 GROUP BY $group_clause
459 SELECT DISTINCT $select{out}
461 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
462 LEFT JOIN parts p ON i1.parts_id = p.id
463 LEFT JOIN bin b1 ON i1.bin_id = b1.id
464 LEFT JOIN bin b2 ON i2.bin_id = b2.id
465 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
466 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
467 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
468 LEFT JOIN project pr ON i1.project_id = pr.id
469 LEFT JOIN employee e ON i1.employee_id = e.id
470 WHERE $where_clause i1.qty < 0 AND
471 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
472 GROUP BY $group_clause
476 SELECT DISTINCT $select{in}
478 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
479 LEFT JOIN parts p ON i1.parts_id = p.id
480 LEFT JOIN bin b1 ON i1.bin_id = b1.id
481 LEFT JOIN bin b2 ON i2.bin_id = b2.id
482 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
483 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
484 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
485 LEFT JOIN project pr ON i1.project_id = pr.id
486 LEFT JOIN employee e ON i1.employee_id = e.id
487 WHERE $where_clause i1.qty > 0 AND
488 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
489 GROUP BY $group_clause
490 ORDER BY r_${sort_spec}|;
492 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
494 my ($h_oe_id, $q_oe_id);
495 if ($form->{l_oe_id}) {
498 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
500 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
501 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
502 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
503 ELSE 'purchase_order'
510 SELECT dord.id AS id, dord.donumber AS number,
512 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
513 ELSE 'sales_delivery_order'
515 FROM delivery_orders dord
520 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
526 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
532 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
534 WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
538 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
540 WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
542 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
546 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
547 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
548 my $qty = $ref->{"qty"} * 1;
550 next unless ($qty > 0);
553 my $part_unit = $all_units->{$ref->{"partunit"}};
554 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
555 $qty *= $part_unit->{"factor"};
556 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
557 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
558 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
561 if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
562 my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
563 do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
564 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
567 push @contents, $ref;
571 $h_oe_id->finish() if $h_oe_id;
573 $main::lxdebug->leave_sub();
579 # This sub is the primary function to retrieve information about items in warehouses.
580 # $filter is a hashref and supports the following keys:
581 # - warehouse_id - will return matches with this warehouse_id only
582 # - partnumber - will return only matches where the given string is a substring of the partnumber
583 # - partsid - will return matches with this parts_id only
584 # - description - will return only matches where the given string is a substring of the description
585 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
586 # - bestbefore - will return only matches with this bestbefore date
587 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
588 # - charge_ids - must be an arrayref. will return contents with these ids only
589 # - expires_in - will only return matches that expire within the given number of days
590 # will also add a column named 'has_expired' containing if the match has already expired or not
591 # - hazardous - will return matches with the flag hazardous only
592 # - oil - will return matches with the flag oil only
593 # - qty, qty_op - quantity filter (more info to come)
594 # - sort, order_by - sorting (more to come)
595 # - reservation - will provide an extra column containing the amount reserved of this match
596 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
598 sub get_warehouse_report {
599 $main::lxdebug->enter_sub();
604 my $myconfig = \%main::myconfig;
605 my $form = $main::form;
607 my $all_units = AM->retrieve_units($myconfig, $form);
609 # connect to database
610 my $dbh = $form->get_standard_dbh($myconfig);
613 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
615 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
617 if ($filter{warehouse_id}) {
618 push @wh_bin_filter_ary, "w.id = ?";
619 push @wh_bin_filter_vars, $filter{warehouse_id};
622 if ($filter{bin_id}) {
623 push @wh_bin_filter_ary, "b.id = ?";
624 push @wh_bin_filter_vars, $filter{bin_id};
627 push @filter_ary, @wh_bin_filter_ary;
628 push @filter_vars, @wh_bin_filter_vars;
630 if ($filter{partnumber}) {
631 push @filter_ary, "p.partnumber ILIKE ?";
632 push @filter_vars, '%' . $filter{partnumber} . '%';
635 if ($filter{description}) {
636 push @filter_ary, "p.description ILIKE ?";
637 push @filter_vars, '%' . $filter{description} . '%';
640 if ($filter{partsid}) {
641 push @filter_ary, "p.id = ?";
642 push @filter_vars, $filter{partsid};
645 if ($filter{chargenumber}) {
646 push @filter_ary, "i.chargenumber ILIKE ?";
647 push @filter_vars, '%' . $filter{chargenumber} . '%';
650 if ($form->{bestbefore}) {
651 push @filter_ary, "?::DATE = i.bestbefore::DATE";
652 push @filter_vars, $form->{bestbefore};
656 push @filter_ary, "p.ean ILIKE ?";
657 push @filter_vars, '%' . $filter{ean} . '%';
661 push @filter_ary, "i.itime <= ?";
662 push @filter_vars, $filter{date};
664 if (!$filter{include_invalid_warehouses}){
665 push @filter_ary, "NOT (w.invalid)";
668 # prepare qty comparison for later filtering
669 my ($f_qty_op, $f_qty, $f_qty_base_unit);
671 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
672 $f_qty_op = $filter{qty_op};
673 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
674 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
677 map { $_ = "(${_})"; } @filter_ary;
679 # if of a property number or description is requested,
680 # automatically check the matching id too.
681 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
683 # make order, search in $filter and $form
684 my $sort_col = $form->{sort};
685 my $sort_order = $form->{order};
687 $sort_col = $filter{sort} unless $sort_col;
688 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
689 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
690 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
691 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
692 # S.a. Bug 1597 jb 12.5.2011
693 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
694 $sort_order = $filter{order} unless $sort_order;
695 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
696 my $orderby = $sort_col;
697 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
699 my $where_clause = join " AND ", ("1=1", @filter_ary);
701 my %select_tokens = (
702 "parts_id" => "i.parts_id",
703 "qty" => "SUM(i.qty)",
704 "warehouseid" => "i.warehouse_id",
705 "partnumber" => "p.partnumber",
706 "partdescription" => "p.description",
707 "bindescription" => "b.description",
709 "chargenumber" => "i.chargenumber",
710 "bestbefore" => "i.bestbefore",
712 "chargeid" => "c.id",
713 "warehousedescription" => "w.description",
714 "partunit" => "p.unit",
715 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
717 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
718 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
719 qw(l_parts_id l_qty l_partunit) );
721 my $group_clause = join ", ", map { +/^l_/; "$'" }
722 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
723 qw(l_parts_id l_partunit) );
726 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
729 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
730 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
731 qw(l_parts_id l_qty l_partunit) );
734 qq|SELECT $select_clause
736 LEFT JOIN parts p ON i.parts_id = p.id
737 LEFT JOIN bin b ON i.bin_id = b.id
738 LEFT JOIN warehouse w ON i.warehouse_id = w.id
741 GROUP BY $group_clause
742 ORDER BY $sort_spec|;
744 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
746 my (%non_empty_bins, @all_fields, @contents);
748 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
750 my $qty = $ref->{qty};
752 next unless ($qty != 0);
755 my $part_unit = $all_units->{$ref->{partunit}};
756 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
757 $qty *= $part_unit->{factor};
758 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
759 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
760 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
763 if ($form->{include_empty_bins}) {
764 $non_empty_bins{$ref->{binid}} = 1;
765 @all_fields = keys %{ $ref } unless (@all_fields);
768 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
770 push @contents, $ref;
775 if ($form->{include_empty_bins}) {
778 w.id AS warehouseid, w.description AS warehousedescription,
779 b.id AS binid, b.description AS bindescription
781 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
783 @filter_ary = @wh_bin_filter_ary;
784 @filter_vars = @wh_bin_filter_vars;
786 my @non_empty_bin_ids = keys %non_empty_bins;
787 if (@non_empty_bin_ids) {
788 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
789 push @filter_vars, @non_empty_bin_ids;
792 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
794 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
796 while (my $ref = $sth->fetchrow_hashref()) {
797 map { $ref->{$_} ||= "" } @all_fields;
798 push @contents, $ref;
802 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
803 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
807 $main::lxdebug->leave_sub();
813 $main::lxdebug->enter_sub();
815 my ($self, $qty_op) = @_;
817 if (!$qty_op || ($qty_op eq "dontcare")) {
818 $main::lxdebug->leave_sub();
822 if ($qty_op eq "atleast") {
824 } elsif ($qty_op eq "atmost") {
830 $main::lxdebug->leave_sub();
835 sub retrieve_transfer_types {
836 $main::lxdebug->enter_sub();
839 my $direction = shift;
841 my $myconfig = \%main::myconfig;
842 my $form = $main::form;
844 my $dbh = $form->get_standard_dbh($myconfig);
846 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
848 $main::lxdebug->leave_sub();
853 sub get_basic_bin_info {
854 $main::lxdebug->enter_sub();
859 Common::check_params(\%params, qw(id));
861 my $myconfig = \%main::myconfig;
862 my $form = $main::form;
864 my $dbh = $params{dbh} || $form->get_standard_dbh();
866 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
869 qq|SELECT b.id AS bin_id, b.description AS bin_description,
870 w.id AS warehouse_id, w.description AS warehouse_description
872 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
873 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
875 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
877 if ('' eq ref $params{id}) {
878 $result = $result->[0] || { };
879 $main::lxdebug->leave_sub();
884 $main::lxdebug->leave_sub();
886 return map { $_->{bin_id} => $_ } @{ $result };
889 # Eingabe: Teilenummer, Lagernummer (warehouse)
890 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
892 sub get_max_qty_parts {
893 $main::lxdebug->enter_sub();
898 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
900 my $myconfig = \%main::myconfig;
901 my $form = $main::form;
903 my $dbh = $params{dbh} || $form->get_standard_dbh();
905 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
907 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
909 my $max_qty_parts = 0; #Initialisierung mit 0
910 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
911 $max_qty_parts += $ref->{sum};
914 $main::lxdebug->leave_sub();
916 return $max_qty_parts;
920 # Eingabe: Teilenummer, Lagernummer (warehouse)
921 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
923 sub get_part_description {
924 $main::lxdebug->enter_sub();
929 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
931 my $myconfig = \%main::myconfig;
932 my $form = $main::form;
934 my $dbh = $params{dbh} || $form->get_standard_dbh();
936 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
938 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
940 my $ref = $sth->fetchrow_hashref();
941 my $part_description = $ref->{partnumber} . " " . $ref->{description};
943 $main::lxdebug->leave_sub();
945 return $part_description;
948 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
949 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
950 # Bzw. Fehler, falls Chargen oder bestbefore
951 # bei eingelagerten Teilen definiert sind.
953 sub get_max_qty_parts_bin {
954 $main::lxdebug->enter_sub();
959 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
961 my $myconfig = \%main::myconfig;
962 my $form = $main::form;
964 my $dbh = $params{dbh} || $form->get_standard_dbh();
966 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
967 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
969 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
971 my $max_qty_parts = 0; #Initialisierung mit 0
972 # falls derselbe artikel mehrmals eingelagert ist
973 # chargennummer, muss entsprechend händisch agiert werden
976 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
977 $max_qty_parts += $ref->{sum};
979 if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
987 $main::lxdebug->leave_sub();
989 return ($max_qty_parts, $error);
998 SL::WH - Warehouse backend
1003 WH->transfer(\%params);
1007 Backend for lx-office warehousing functions.
1011 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1013 This is the main function to manipulate warehouse contents. A typical transfer
1014 is called like this:
1019 transfer_type => 'transfer',
1020 src_warehouse_id => 12,
1022 dst_warehouse_id => 25,
1026 It will generate an entry in inventory representing the transfer. Note that
1027 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1028 a destination or a src is mandatory.
1030 transfer accepts more than one transaction parameter, each being a hash ref. If
1031 more than one is supplied, it is guaranteed, that all are processed in the same
1034 Here is a full list of parameters. All "_id" parameters except oe and
1035 orderitems can be called without id with RDB objects as well.
1041 The id of the article transferred. Does not check if the article is a service.
1046 Quantity of the transaction. Mandatory.
1050 Unit of the transaction. Optional.
1054 =item transfer_type_id
1056 The type of transaction. The first version is a string describing the
1057 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1058 every system), the id is the hard id of a transfer_type from the database.
1060 Depending of the direction of the transfer_type, source and/or destination must
1063 One of transfer_type or transfer_type_id is mandatory.
1065 =item src_warehouse_id
1069 Warehouse and bin from which to transfer. Mandatory in transfer and out
1070 directions. Ignored in in directions.
1072 =item dst_warehouse_id
1076 Warehouse and bin to which to transfer. Mandatory in transfer and in
1077 directions. Ignored in out directions.
1081 If given, the transfer will transfer only articles with this chargenumber.
1086 Reference to an orderitem for which this transfer happened. Optional
1090 Reference to an order for which this transfer happened. Optional
1094 An optional comment.
1098 An expiration date. Note that this is not by default used by C<warehouse_report>.