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 => $::form->{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 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 my $part = SL::DB::Part->new(id => conv_i($transfer->{parts_id}))->load;
141 $part->update_attributes(warehouse_id => conv_i($transfer->{dst_warehouse_id}));
142 $part->update_attributes(bin_id => conv_i($transfer->{dst_bin_id}));
146 push @trans_ids, $trans_id;
151 $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
154 $::lxdebug->leave_sub;
159 sub transfer_assembly {
160 $main::lxdebug->enter_sub();
164 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
167 my $unit = SL::DB::Manager::Unit->find_by(name => $params{unit});
169 my $assembly = SL::DB::Manager::Assembly->get_all(
170 query => [ id => $params{assembly_id} ],
171 with_objects => ['part'],
174 $params{qty} = $unit->convert_to($params{qty}, $assembly->part->unit_obj);
177 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
179 my $myconfig = \%main::myconfig;
180 my $form = $main::form;
181 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
186 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
187 # select parts_id,qty from assembly where id=1064;
188 # Erweiterung für bug 935 am 23.4.09 -
189 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
190 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
191 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
193 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
194 # wenn assembly nicht überprüft wird ...
195 # patch von joachim eingespielt 24.4.2009:
196 # my $query = qq|select parts_id,qty from assembly inner join parts
197 # on assembly.parts_id = parts.id where assembly.id = ? and
198 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
201 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
202 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
204 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
206 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
207 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
208 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
209 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
210 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
212 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
214 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
215 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
216 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
217 $schleife_durchlaufen=1; # Erzeugnis definiert
218 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
219 my $currentPart_ID = $hash_ref->{parts_id};
221 # Überprüfen, ob diese Anzahl gefertigt werden kann
222 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
223 warehouse_id => $params{dst_warehouse_id});
225 if ($partsQTY > $max_parts){
226 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
227 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
229 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
230 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
231 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
232 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
235 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
236 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
237 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
238 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
239 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
240 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
242 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
243 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
244 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
246 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
247 my $tmpPartsQTY = $partsQTY;
249 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
250 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
251 my $temppart_chargenumber = $temphash_ref->{chargenumber};
252 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
253 my $temppart_qty = $temphash_ref->{sum};
255 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
256 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
257 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
258 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
259 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
260 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
261 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
262 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
263 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
264 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
266 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
267 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
268 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
269 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
270 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
272 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
273 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
274 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
275 last; # beendet die schleife (springt zum letzten element)
277 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
278 } #ende while select parts_id,qty from assembly where id = ?
280 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
281 # keine einzelteile definiert
282 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
283 Dementsprechend kann auch nichts hergestellt werden";
285 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
286 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
287 if ($kannNichtFertigen) {
288 return $kannNichtFertigen;
291 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
292 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
293 comment, employee_id, qty, trans_id, trans_type_id)
294 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
295 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
296 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
297 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
298 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
301 $main::lxdebug->leave_sub();
302 return 1; # Alles erfolgreich
305 sub get_warehouse_journal {
306 $main::lxdebug->enter_sub();
311 my $myconfig = \%main::myconfig;
312 my $form = $main::form;
314 my $all_units = AM->retrieve_units($myconfig, $form);
316 # connect to database
317 my $dbh = $form->get_standard_dbh($myconfig);
320 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
322 if ($filter{warehouse_id}) {
323 push @filter_ary, "w1.id = ? OR w2.id = ?";
324 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
327 if ($filter{bin_id}) {
328 push @filter_ary, "b1.id = ? OR b2.id = ?";
329 push @filter_vars, $filter{bin_id}, $filter{bin_id};
332 if ($filter{partnumber}) {
333 push @filter_ary, "p.partnumber ILIKE ?";
334 push @filter_vars, '%' . $filter{partnumber} . '%';
337 if ($filter{description}) {
338 push @filter_ary, "(p.description ILIKE ?)";
339 push @filter_vars, '%' . $filter{description} . '%';
342 if ($filter{chargenumber}) {
343 push @filter_ary, "i1.chargenumber ILIKE ?";
344 push @filter_vars, '%' . $filter{chargenumber} . '%';
347 if ($form->{bestbefore}) {
348 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
349 push @filter_vars, $form->{bestbefore};
352 if ($form->{fromdate}) {
353 push @filter_ary, "?::DATE <= i1.itime::DATE";
354 push @filter_vars, $form->{fromdate};
357 if ($form->{todate}) {
358 push @filter_ary, "?::DATE >= i1.itime::DATE";
359 push @filter_vars, $form->{todate};
362 if ($form->{l_employee}) {
366 # prepare qty comparison for later filtering
367 my ($f_qty_op, $f_qty, $f_qty_base_unit);
368 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
369 $f_qty_op = $filter{qty_op};
370 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
371 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
374 map { $_ = "(${_})"; } @filter_ary;
376 # if of a property number or description is requested,
377 # automatically check the matching id too.
378 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
380 # customize shown entry for not available fields.
381 $filter{na} = '-' unless $filter{na};
383 # make order, search in $filter and $form
384 my $sort_col = $form->{sort};
385 my $sort_order = $form->{order};
387 $sort_col = $filter{sort} unless $sort_col;
388 $sort_order = ($sort_col = 'itime') unless $sort_col;
389 $sort_col = 'itime' if $sort_col eq 'date';
390 $sort_order = $filter{order} unless $sort_order;
391 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
393 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
395 $select_tokens{'trans'} = {
396 "parts_id" => "i1.parts_id",
397 "qty" => "ABS(SUM(i1.qty))",
398 "partnumber" => "p.partnumber",
399 "partdescription" => "p.description",
400 "bindescription" => "b.description",
401 "chargenumber" => "i1.chargenumber",
402 "bestbefore" => "i1.bestbefore",
403 "warehousedescription" => "w.description",
404 "partunit" => "p.unit",
405 "bin_from" => "b1.description",
406 "bin_to" => "b2.description",
407 "warehouse_from" => "w1.description",
408 "warehouse_to" => "w2.description",
409 "comment" => "i1.comment",
410 "trans_type" => "tt.description",
411 "trans_id" => "i1.trans_id",
412 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
413 "date" => "i1.itime::DATE",
414 "itime" => "i1.itime",
415 "employee" => "e.name",
416 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
419 $select_tokens{'out'} = {
420 "bin_to" => "'$filter{na}'",
421 "warehouse_to" => "'$filter{na}'",
424 $select_tokens{'in'} = {
425 "bin_from" => "'$filter{na}'",
426 "warehouse_from" => "'$filter{na}'",
429 # build the select clauses.
430 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
431 for my $i ('trans', 'out', 'in') {
432 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
433 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
436 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
437 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
439 $where_clause = defined($where_clause) ? $where_clause : '';
441 qq|SELECT DISTINCT $select{trans}
443 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
444 LEFT JOIN parts p ON i1.parts_id = p.id
445 LEFT JOIN bin b1 ON i1.bin_id = b1.id
446 LEFT JOIN bin b2 ON i2.bin_id = b2.id
447 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
448 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
449 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
450 LEFT JOIN project pr ON i1.project_id = pr.id
451 LEFT JOIN employee e ON i1.employee_id = e.id
452 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
453 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
454 GROUP BY $group_clause
458 SELECT DISTINCT $select{out}
460 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
461 LEFT JOIN parts p ON i1.parts_id = p.id
462 LEFT JOIN bin b1 ON i1.bin_id = b1.id
463 LEFT JOIN bin b2 ON i2.bin_id = b2.id
464 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
465 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
466 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
467 LEFT JOIN project pr ON i1.project_id = pr.id
468 LEFT JOIN employee e ON i1.employee_id = e.id
469 WHERE $where_clause i1.qty < 0 AND
470 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
471 GROUP BY $group_clause
475 SELECT DISTINCT $select{in}
477 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
478 LEFT JOIN parts p ON i1.parts_id = p.id
479 LEFT JOIN bin b1 ON i1.bin_id = b1.id
480 LEFT JOIN bin b2 ON i2.bin_id = b2.id
481 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
482 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
483 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
484 LEFT JOIN project pr ON i1.project_id = pr.id
485 LEFT JOIN employee e ON i1.employee_id = e.id
486 WHERE $where_clause i1.qty > 0 AND
487 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
488 GROUP BY $group_clause
489 ORDER BY r_${sort_spec}|;
491 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
493 my ($h_oe_id, $q_oe_id);
494 if ($form->{l_oe_id}) {
497 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
499 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
500 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
501 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
502 ELSE 'purchase_order'
509 SELECT dord.id AS id, dord.donumber AS number,
511 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
512 ELSE 'sales_delivery_order'
514 FROM delivery_orders dord
519 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
525 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
529 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
533 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
534 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
535 my $qty = $ref->{"qty"} * 1;
537 next unless ($qty > 0);
540 my $part_unit = $all_units->{$ref->{"partunit"}};
541 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
542 $qty *= $part_unit->{"factor"};
543 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
544 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
545 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
548 if ($h_oe_id && $ref->{oe_id}) {
549 do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
550 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
553 push @contents, $ref;
557 $h_oe_id->finish() if $h_oe_id;
559 $main::lxdebug->leave_sub();
565 # This sub is the primary function to retrieve information about items in warehouses.
566 # $filter is a hashref and supports the following keys:
567 # - warehouse_id - will return matches with this warehouse_id only
568 # - partnumber - will return only matches where the given string is a substring of the partnumber
569 # - partsid - will return matches with this parts_id only
570 # - description - will return only matches where the given string is a substring of the description
571 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
572 # - bestbefore - will return only matches with this bestbefore date
573 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
574 # - charge_ids - must be an arrayref. will return contents with these ids only
575 # - expires_in - will only return matches that expire within the given number of days
576 # will also add a column named 'has_expired' containing if the match has already expired or not
577 # - hazardous - will return matches with the flag hazardous only
578 # - oil - will return matches with the flag oil only
579 # - qty, qty_op - quantity filter (more info to come)
580 # - sort, order_by - sorting (more to come)
581 # - reservation - will provide an extra column containing the amount reserved of this match
582 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
584 sub get_warehouse_report {
585 $main::lxdebug->enter_sub();
590 my $myconfig = \%main::myconfig;
591 my $form = $main::form;
593 my $all_units = AM->retrieve_units($myconfig, $form);
595 # connect to database
596 my $dbh = $form->get_standard_dbh($myconfig);
599 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
601 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
603 if ($filter{warehouse_id}) {
604 push @wh_bin_filter_ary, "w.id = ?";
605 push @wh_bin_filter_vars, $filter{warehouse_id};
608 if ($filter{bin_id}) {
609 push @wh_bin_filter_ary, "b.id = ?";
610 push @wh_bin_filter_vars, $filter{bin_id};
613 push @filter_ary, @wh_bin_filter_ary;
614 push @filter_vars, @wh_bin_filter_vars;
616 if ($filter{partnumber}) {
617 push @filter_ary, "p.partnumber ILIKE ?";
618 push @filter_vars, '%' . $filter{partnumber} . '%';
621 if ($filter{description}) {
622 push @filter_ary, "p.description ILIKE ?";
623 push @filter_vars, '%' . $filter{description} . '%';
626 if ($filter{partsid}) {
627 push @filter_ary, "p.id = ?";
628 push @filter_vars, $filter{partsid};
631 if ($filter{chargenumber}) {
632 push @filter_ary, "i.chargenumber ILIKE ?";
633 push @filter_vars, '%' . $filter{chargenumber} . '%';
636 if ($form->{bestbefore}) {
637 push @filter_ary, "?::DATE = i.bestbefore::DATE";
638 push @filter_vars, $form->{bestbefore};
642 push @filter_ary, "p.ean ILIKE ?";
643 push @filter_vars, '%' . $filter{ean} . '%';
647 push @filter_ary, "i.itime <= ?";
648 push @filter_vars, $filter{date};
650 if (!$filter{include_invalid_warehouses}){
651 push @filter_ary, "NOT (w.invalid)";
654 # prepare qty comparison for later filtering
655 my ($f_qty_op, $f_qty, $f_qty_base_unit);
657 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
658 $f_qty_op = $filter{qty_op};
659 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
660 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
663 map { $_ = "(${_})"; } @filter_ary;
665 # if of a property number or description is requested,
666 # automatically check the matching id too.
667 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
669 # make order, search in $filter and $form
670 my $sort_col = $form->{sort};
671 my $sort_order = $form->{order};
673 $sort_col = $filter{sort} unless $sort_col;
674 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
675 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
676 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
677 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
678 # S.a. Bug 1597 jb 12.5.2011
679 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
680 $sort_order = $filter{order} unless $sort_order;
681 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
682 my $orderby = $sort_col;
683 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
685 my $where_clause = join " AND ", ("1=1", @filter_ary);
687 my %select_tokens = (
688 "parts_id" => "i.parts_id",
689 "qty" => "SUM(i.qty)",
690 "warehouseid" => "i.warehouse_id",
691 "partnumber" => "p.partnumber",
692 "partdescription" => "p.description",
693 "bindescription" => "b.description",
695 "chargenumber" => "i.chargenumber",
696 "bestbefore" => "i.bestbefore",
698 "chargeid" => "c.id",
699 "warehousedescription" => "w.description",
700 "partunit" => "p.unit",
701 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
703 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
704 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
705 qw(l_parts_id l_qty l_partunit) );
707 my $group_clause = join ", ", map { +/^l_/; "$'" }
708 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
709 qw(l_parts_id l_partunit) );
712 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
715 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
716 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
717 qw(l_parts_id l_qty l_partunit) );
720 qq|SELECT $select_clause
722 LEFT JOIN parts p ON i.parts_id = p.id
723 LEFT JOIN bin b ON i.bin_id = b.id
724 LEFT JOIN warehouse w ON i.warehouse_id = w.id
727 GROUP BY $group_clause
728 ORDER BY $sort_spec|;
730 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
732 my (%non_empty_bins, @all_fields, @contents);
734 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
736 my $qty = $ref->{qty};
738 next unless ($qty != 0);
741 my $part_unit = $all_units->{$ref->{partunit}};
742 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
743 $qty *= $part_unit->{factor};
744 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
745 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
746 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
749 if ($form->{include_empty_bins}) {
750 $non_empty_bins{$ref->{binid}} = 1;
751 @all_fields = keys %{ $ref } unless (@all_fields);
754 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
756 push @contents, $ref;
761 if ($form->{include_empty_bins}) {
764 w.id AS warehouseid, w.description AS warehousedescription,
765 b.id AS binid, b.description AS bindescription
767 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
769 @filter_ary = @wh_bin_filter_ary;
770 @filter_vars = @wh_bin_filter_vars;
772 my @non_empty_bin_ids = keys %non_empty_bins;
773 if (@non_empty_bin_ids) {
774 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
775 push @filter_vars, @non_empty_bin_ids;
778 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
780 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
782 while (my $ref = $sth->fetchrow_hashref()) {
783 map { $ref->{$_} ||= "" } @all_fields;
784 push @contents, $ref;
788 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
789 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
793 $main::lxdebug->leave_sub();
799 $main::lxdebug->enter_sub();
801 my ($self, $qty_op) = @_;
803 if (!$qty_op || ($qty_op eq "dontcare")) {
804 $main::lxdebug->leave_sub();
808 if ($qty_op eq "atleast") {
810 } elsif ($qty_op eq "atmost") {
816 $main::lxdebug->leave_sub();
821 sub retrieve_transfer_types {
822 $main::lxdebug->enter_sub();
825 my $direction = shift;
827 my $myconfig = \%main::myconfig;
828 my $form = $main::form;
830 my $dbh = $form->get_standard_dbh($myconfig);
832 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
834 $main::lxdebug->leave_sub();
839 sub get_basic_bin_info {
840 $main::lxdebug->enter_sub();
845 Common::check_params(\%params, qw(id));
847 my $myconfig = \%main::myconfig;
848 my $form = $main::form;
850 my $dbh = $params{dbh} || $form->get_standard_dbh();
852 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
855 qq|SELECT b.id AS bin_id, b.description AS bin_description,
856 w.id AS warehouse_id, w.description AS warehouse_description
858 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
859 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
861 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
863 if ('' eq ref $params{id}) {
864 $result = $result->[0] || { };
865 $main::lxdebug->leave_sub();
870 $main::lxdebug->leave_sub();
872 return map { $_->{bin_id} => $_ } @{ $result };
875 # Eingabe: Teilenummer, Lagernummer (warehouse)
876 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
878 sub get_max_qty_parts {
879 $main::lxdebug->enter_sub();
884 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
886 my $myconfig = \%main::myconfig;
887 my $form = $main::form;
889 my $dbh = $params{dbh} || $form->get_standard_dbh();
891 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
893 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
895 my $max_qty_parts = 0; #Initialisierung mit 0
896 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
897 $max_qty_parts += $ref->{sum};
900 $main::lxdebug->leave_sub();
902 return $max_qty_parts;
906 # Eingabe: Teilenummer, Lagernummer (warehouse)
907 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
909 sub get_part_description {
910 $main::lxdebug->enter_sub();
915 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
917 my $myconfig = \%main::myconfig;
918 my $form = $main::form;
920 my $dbh = $params{dbh} || $form->get_standard_dbh();
922 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
924 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
926 my $ref = $sth->fetchrow_hashref();
927 my $part_description = $ref->{partnumber} . " " . $ref->{description};
929 $main::lxdebug->leave_sub();
931 return $part_description;
934 # Eingabe: Teilenummer, Lagerplatz_Id (bin_id)
935 # Ausgabe: Die maximale Anzahl der Teile in diesem Lagerplatz
936 # Bzw. Fehler, falls Chargen oder bestbefore
937 # bei eingelagerten Teilen definiert sind.
939 sub get_max_qty_parts_bin {
940 $main::lxdebug->enter_sub();
945 Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
947 my $myconfig = \%main::myconfig;
948 my $form = $main::form;
950 my $dbh = $params{dbh} || $form->get_standard_dbh();
952 my $query = qq| SELECT SUM(qty), chargenumber, bestbefore FROM inventory where parts_id = ?
953 AND bin_id = ? GROUP BY chargenumber, bestbefore|;
955 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
957 my $max_qty_parts = 0; #Initialisierung mit 0
958 # falls derselbe artikel mehrmals eingelagert ist
959 # chargennummer, muss entsprechend händisch agiert werden
962 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
963 $max_qty_parts += $ref->{sum};
965 if ($ref->{chargenumber} || $ref->{bestbefore}){
973 $main::lxdebug->leave_sub();
975 return ($max_qty_parts, $error);
984 SL::WH - Warehouse backend
989 WH->transfer(\%params);
993 Backend for lx-office warehousing functions.
997 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
999 This is the main function to manipulate warehouse contents. A typical transfer
1000 is called like this:
1005 transfer_type => 'transfer',
1006 src_warehouse_id => 12,
1008 dst_warehouse_id => 25,
1012 It will generate an entry in inventory representing the transfer. Note that
1013 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1014 a destination or a src is mandatory.
1016 transfer accepts more than one transaction parameter, each being a hash ref. If
1017 more than one is supplied, it is guaranteed, that all are processed in the same
1020 Here is a full list of parameters. All "_id" parameters except oe and
1021 orderitems can be called without id with RDB objects as well.
1027 The id of the article transferred. Does not check if the article is a service.
1032 Quantity of the transaction. Mandatory.
1036 Unit of the transaction. Optional.
1040 =item transfer_type_id
1042 The type of transaction. The first version is a string describing the
1043 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1044 every system), the id is the hard id of a transfer_type from the database.
1046 Depending of the direction of the transfer_type, source and/or destination must
1049 One of transfer_type or transfer_type_id is mandatory.
1051 =item src_warehouse_id
1055 Warehouse and bin from which to transfer. Mandatory in transfer and out
1056 directions. Ignored in in directions.
1058 =item dst_warehouse_id
1062 Warehouse and bin to which to transfer. Mandatory in transfer and in
1063 directions. Ignored in out directions.
1067 If given, the transfer will transfer only articles with this chargenumber.
1072 Reference to an orderitem for which this transfer happened. Optional
1076 Reference to an order for which this transfer happened. Optional
1080 An optional comment.
1084 An expiration date. Note that this is not by default used by C<warehouse_report>.