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 #======================================================================
45 $::lxdebug->enter_sub;
47 my ($self, @args) = @_;
50 $::lxdebug->leave_sub;
54 require SL::DB::TransferType;
56 require SL::DB::Employee;
57 require SL::DB::Inventory;
59 my $employee = SL::DB::Manager::Employee->find_by(login => $::form->{login});
60 my ($now) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
61 my @directions = (undef, qw(out in transfer));
62 my $db = SL::DB->create(undef, 'LXOFFICE'); # get handle for transaction
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"});
80 for my $transfer (@args) {
81 my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
83 my $part = $objectify->($transfer, 'parts', 'SL::DB::Part');
84 my $unit = $objectify->($transfer, 'unit', 'SL::DB::Unit', unit => $transfer->{unit});
85 my $qty = $transfer->{qty};
86 my $src_bin = $objectify->($transfer, 'src_bin', 'SL::DB::Bin');
87 my $dst_bin = $objectify->($transfer, 'dst_bin', 'SL::DB::Bin');
88 my $src_wh = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
89 my $dst_wh = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
90 my $project = $objectify->($transfer, 'project', 'SL::DB::Project');
92 $src_wh ||= $src_bin->warehouse if $src_bin;
93 $dst_wh ||= $dst_bin->warehouse if $dst_bin;
95 my $direction = 0; # bit mask
96 $direction |= 1 if $src_bin;
97 $direction |= 2 if $dst_bin;
99 my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction => $directions[$direction],
100 description => $transfer->{transfer_type});
104 employee => $employee,
105 trans_type => $transfer_type,
107 trans_id => $trans_id,
108 shippingdate => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
109 ? $now : $transfer->{shippingdate},
110 map { $_ => $transfer->{$_} } qw( chargenumber bestbefore oe_id orderitems_id comment),
114 $qty *= $unit->factor;
115 $qty /= $part->unit_obj->factor || 1 if $part->unit;
118 if ($direction & 1) {
119 SL::DB::Inventory->new(
121 warehouse => $src_wh,
127 if ($direction & 2) {
128 SL::DB::Inventory->new(
130 warehouse => $dst_wh->id,
145 $::lxdebug->leave_sub;
148 sub transfer_assembly {
149 $main::lxdebug->enter_sub();
153 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
155 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
157 my $myconfig = \%main::myconfig;
158 my $form = $main::form;
159 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
164 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
165 # select parts_id,qty from assembly where id=1064;
166 # Erweiterung für bug 935 am 23.4.09 -
167 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
168 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
169 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
171 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
172 # wenn assembly nicht überprüft wird ...
173 # patch von joachim eingespielt 24.4.2009:
174 # my $query = qq|select parts_id,qty from assembly inner join parts
175 # on assembly.parts_id = parts.id where assembly.id = ? and
176 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
179 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
180 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
182 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
184 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
185 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
186 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
187 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
188 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
190 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
192 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
193 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
194 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
195 $schleife_durchlaufen=1; # Erzeugnis definiert
196 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
197 my $currentPart_ID = $hash_ref->{parts_id};
199 # Überprüfen, ob diese Anzahl gefertigt werden kann
200 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
201 warehouse_id => $params{dst_warehouse_id});
203 if ($partsQTY > $max_parts){
204 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
205 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
207 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
208 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
209 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
210 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
213 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
214 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
215 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
216 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
217 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
218 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
220 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
221 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
222 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
224 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
225 my $tmpPartsQTY = $partsQTY;
227 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
228 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
229 my $temppart_chargenumber = $temphash_ref->{chargenumber};
230 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
231 my $temppart_qty = $temphash_ref->{sum};
233 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
234 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
235 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
236 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
237 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
238 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
239 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
240 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
241 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
242 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
244 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
245 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
246 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
247 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
248 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
250 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
251 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
252 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
253 last; # beendet die schleife (springt zum letzten element)
255 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
256 } #ende while select parts_id,qty from assembly where id = ?
258 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
259 # keine einzelteile definiert
260 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
261 Dementsprechend kann auch nichts hergestellt werden";
263 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
264 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
265 if ($kannNichtFertigen) {
266 return $kannNichtFertigen;
269 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
270 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
271 comment, employee_id, qty, trans_id, trans_type_id)
272 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
273 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
274 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
275 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
276 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
279 $main::lxdebug->leave_sub();
280 return 1; # Alles erfolgreich
283 sub get_warehouse_journal {
284 $main::lxdebug->enter_sub();
289 my $myconfig = \%main::myconfig;
290 my $form = $main::form;
292 my $all_units = AM->retrieve_units($myconfig, $form);
294 # connect to database
295 my $dbh = $form->get_standard_dbh($myconfig);
298 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
300 if ($filter{warehouse_id}) {
301 push @filter_ary, "w1.id = ? OR w2.id = ?";
302 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
305 if ($filter{bin_id}) {
306 push @filter_ary, "b1.id = ? OR b2.id = ?";
307 push @filter_vars, $filter{bin_id}, $filter{bin_id};
310 if ($filter{partnumber}) {
311 push @filter_ary, "p.partnumber ILIKE ?";
312 push @filter_vars, '%' . $filter{partnumber} . '%';
315 if ($filter{description}) {
316 push @filter_ary, "(p.description ILIKE ?)";
317 push @filter_vars, '%' . $filter{description} . '%';
320 if ($filter{chargenumber}) {
321 push @filter_ary, "i1.chargenumber ILIKE ?";
322 push @filter_vars, '%' . $filter{chargenumber} . '%';
325 if ($form->{bestbefore}) {
326 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
327 push @filter_vars, $form->{bestbefore};
330 if ($form->{fromdate}) {
331 push @filter_ary, "?::DATE <= i1.itime::DATE";
332 push @filter_vars, $form->{fromdate};
335 if ($form->{todate}) {
336 push @filter_ary, "?::DATE >= i1.itime::DATE";
337 push @filter_vars, $form->{todate};
340 if ($form->{l_employee}) {
344 # prepare qty comparison for later filtering
345 my ($f_qty_op, $f_qty, $f_qty_base_unit);
346 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
347 $f_qty_op = $filter{qty_op};
348 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
349 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
352 map { $_ = "(${_})"; } @filter_ary;
354 # if of a property number or description is requested,
355 # automatically check the matching id too.
356 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
358 # customize shown entry for not available fields.
359 $filter{na} = '-' unless $filter{na};
361 # make order, search in $filter and $form
362 my $sort_col = $form->{sort};
363 my $sort_order = $form->{order};
365 $sort_col = $filter{sort} unless $sort_col;
366 $sort_order = ($sort_col = 'itime') unless $sort_col;
367 $sort_col = 'itime' if $sort_col eq 'date';
368 $sort_order = $filter{order} unless $sort_order;
369 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
371 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
373 $select_tokens{'trans'} = {
374 "parts_id" => "i1.parts_id",
375 "qty" => "ABS(SUM(i1.qty))",
376 "partnumber" => "p.partnumber",
377 "partdescription" => "p.description",
378 "bindescription" => "b.description",
379 "chargenumber" => "i1.chargenumber",
380 "bestbefore" => "i1.bestbefore",
381 "warehousedescription" => "w.description",
382 "partunit" => "p.unit",
383 "bin_from" => "b1.description",
384 "bin_to" => "b2.description",
385 "warehouse_from" => "w1.description",
386 "warehouse_to" => "w2.description",
387 "comment" => "i1.comment",
388 "trans_type" => "tt.description",
389 "trans_id" => "i1.trans_id",
390 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
391 "date" => "i1.itime::DATE",
392 "itime" => "i1.itime",
393 "employee" => "e.name",
394 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
397 $select_tokens{'out'} = {
398 "bin_to" => "'$filter{na}'",
399 "warehouse_to" => "'$filter{na}'",
402 $select_tokens{'in'} = {
403 "bin_from" => "'$filter{na}'",
404 "warehouse_from" => "'$filter{na}'",
407 # build the select clauses.
408 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
409 for my $i ('trans', 'out', 'in') {
410 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
411 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
414 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
415 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
417 $where_clause = defined($where_clause) ? $where_clause : '';
419 qq|SELECT DISTINCT $select{trans}
421 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
422 LEFT JOIN parts p ON i1.parts_id = p.id
423 LEFT JOIN bin b1 ON i1.bin_id = b1.id
424 LEFT JOIN bin b2 ON i2.bin_id = b2.id
425 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
426 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
427 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
428 LEFT JOIN project pr ON i1.project_id = pr.id
429 LEFT JOIN employee e ON i1.employee_id = e.id
430 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
431 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
432 GROUP BY $group_clause
436 SELECT DISTINCT $select{out}
438 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
439 LEFT JOIN parts p ON i1.parts_id = p.id
440 LEFT JOIN bin b1 ON i1.bin_id = b1.id
441 LEFT JOIN bin b2 ON i2.bin_id = b2.id
442 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
443 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
444 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
445 LEFT JOIN project pr ON i1.project_id = pr.id
446 LEFT JOIN employee e ON i1.employee_id = e.id
447 WHERE $where_clause i1.qty < 0 AND
448 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
449 GROUP BY $group_clause
453 SELECT DISTINCT $select{in}
455 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
456 LEFT JOIN parts p ON i1.parts_id = p.id
457 LEFT JOIN bin b1 ON i1.bin_id = b1.id
458 LEFT JOIN bin b2 ON i2.bin_id = b2.id
459 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
460 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
461 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
462 LEFT JOIN project pr ON i1.project_id = pr.id
463 LEFT JOIN employee e ON i1.employee_id = e.id
464 WHERE $where_clause i1.qty > 0 AND
465 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
466 GROUP BY $group_clause
467 ORDER BY r_${sort_spec}|;
469 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
471 my ($h_oe_id, $q_oe_id);
472 if ($form->{l_oe_id}) {
475 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
477 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
478 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
479 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
480 ELSE 'purchase_order'
487 SELECT dord.id AS id, dord.donumber AS number,
489 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
490 ELSE 'sales_delivery_order'
492 FROM delivery_orders dord
497 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
503 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
507 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
511 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
512 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
513 my $qty = $ref->{"qty"} * 1;
515 next unless ($qty > 0);
518 my $part_unit = $all_units->{$ref->{"partunit"}};
519 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
520 $qty *= $part_unit->{"factor"};
521 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
522 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
523 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
526 if ($h_oe_id && $ref->{oe_id}) {
527 do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
528 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
531 push @contents, $ref;
535 $h_oe_id->finish() if $h_oe_id;
537 $main::lxdebug->leave_sub();
543 # This sub is the primary function to retrieve information about items in warehouses.
544 # $filter is a hashref and supports the following keys:
545 # - warehouse_id - will return matches with this warehouse_id only
546 # - partnumber - will return only matches where the given string is a substring of the partnumber
547 # - partsid - will return matches with this parts_id only
548 # - description - will return only matches where the given string is a substring of the description
549 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
550 # - bestbefore - will return only matches with this bestbefore date
551 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
552 # - charge_ids - must be an arrayref. will return contents with these ids only
553 # - expires_in - will only return matches that expire within the given number of days
554 # will also add a column named 'has_expired' containing if the match has already expired or not
555 # - hazardous - will return matches with the flag hazardous only
556 # - oil - will return matches with the flag oil only
557 # - qty, qty_op - quantity filter (more info to come)
558 # - sort, order_by - sorting (more to come)
559 # - reservation - will provide an extra column containing the amount reserved of this match
560 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
562 sub get_warehouse_report {
563 $main::lxdebug->enter_sub();
568 my $myconfig = \%main::myconfig;
569 my $form = $main::form;
571 my $all_units = AM->retrieve_units($myconfig, $form);
573 # connect to database
574 my $dbh = $form->get_standard_dbh($myconfig);
577 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
579 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
581 if ($filter{warehouse_id}) {
582 push @wh_bin_filter_ary, "w.id = ?";
583 push @wh_bin_filter_vars, $filter{warehouse_id};
586 if ($filter{bin_id}) {
587 push @wh_bin_filter_ary, "b.id = ?";
588 push @wh_bin_filter_vars, $filter{bin_id};
591 push @filter_ary, @wh_bin_filter_ary;
592 push @filter_vars, @wh_bin_filter_vars;
594 if ($filter{partnumber}) {
595 push @filter_ary, "p.partnumber ILIKE ?";
596 push @filter_vars, '%' . $filter{partnumber} . '%';
599 if ($filter{description}) {
600 push @filter_ary, "p.description ILIKE ?";
601 push @filter_vars, '%' . $filter{description} . '%';
604 if ($filter{partsid}) {
605 push @filter_ary, "p.id = ?";
606 push @filter_vars, $filter{partsid};
609 if ($filter{chargenumber}) {
610 push @filter_ary, "i.chargenumber ILIKE ?";
611 push @filter_vars, '%' . $filter{chargenumber} . '%';
614 if ($form->{bestbefore}) {
615 push @filter_ary, "?::DATE = i.bestbefore::DATE";
616 push @filter_vars, $form->{bestbefore};
620 push @filter_ary, "p.ean ILIKE ?";
621 push @filter_vars, '%' . $filter{ean} . '%';
624 # prepare qty comparison for later filtering
625 my ($f_qty_op, $f_qty, $f_qty_base_unit);
627 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
628 $f_qty_op = $filter{qty_op};
629 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
630 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
633 map { $_ = "(${_})"; } @filter_ary;
635 # if of a property number or description is requested,
636 # automatically check the matching id too.
637 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
639 # make order, search in $filter and $form
640 my $sort_col = $form->{sort};
641 my $sort_order = $form->{order};
643 $sort_col = $filter{sort} unless $sort_col;
644 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
645 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
646 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
647 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
648 # S.a. Bug 1597 jb 12.5.2011
649 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
650 $sort_order = $filter{order} unless $sort_order;
651 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
652 my $orderby = $sort_col;
653 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
655 my $where_clause = join " AND ", ("1=1", @filter_ary);
657 my %select_tokens = (
658 "parts_id" => "i.parts_id",
659 "qty" => "SUM(i.qty)",
660 "warehouseid" => "i.warehouse_id",
661 "partnumber" => "p.partnumber",
662 "partdescription" => "p.description",
663 "bindescription" => "b.description",
665 "chargenumber" => "i.chargenumber",
666 "bestbefore" => "i.bestbefore",
668 "chargeid" => "c.id",
669 "warehousedescription" => "w.description",
670 "partunit" => "p.unit",
671 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
673 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
674 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
675 qw(l_parts_id l_qty l_partunit) );
677 my $group_clause = join ", ", map { +/^l_/; "$'" }
678 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
679 qw(l_parts_id l_partunit) );
682 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
685 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
686 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
687 qw(l_parts_id l_qty l_partunit) );
690 qq|SELECT $select_clause
692 LEFT JOIN parts p ON i.parts_id = p.id
693 LEFT JOIN bin b ON i.bin_id = b.id
694 LEFT JOIN warehouse w ON i.warehouse_id = w.id
697 GROUP BY $group_clause
698 ORDER BY $sort_spec|;
700 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
702 my (%non_empty_bins, @all_fields, @contents);
704 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
706 my $qty = $ref->{qty};
708 next unless ($qty != 0);
711 my $part_unit = $all_units->{$ref->{partunit}};
712 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
713 $qty *= $part_unit->{factor};
714 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
715 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
716 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
719 if ($form->{include_empty_bins}) {
720 $non_empty_bins{$ref->{binid}} = 1;
721 @all_fields = keys %{ $ref } unless (@all_fields);
724 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
726 push @contents, $ref;
731 if ($form->{include_empty_bins}) {
734 w.id AS warehouseid, w.description AS warehousedescription,
735 b.id AS binid, b.description AS bindescription
737 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
739 @filter_ary = @wh_bin_filter_ary;
740 @filter_vars = @wh_bin_filter_vars;
742 my @non_empty_bin_ids = keys %non_empty_bins;
743 if (@non_empty_bin_ids) {
744 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
745 push @filter_vars, @non_empty_bin_ids;
748 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
750 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
752 while (my $ref = $sth->fetchrow_hashref()) {
753 map { $ref->{$_} ||= "" } @all_fields;
754 push @contents, $ref;
758 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
759 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
763 $main::lxdebug->leave_sub();
769 $main::lxdebug->enter_sub();
771 my ($self, $qty_op) = @_;
773 if (!$qty_op || ($qty_op eq "dontcare")) {
774 $main::lxdebug->leave_sub();
778 if ($qty_op eq "atleast") {
780 } elsif ($qty_op eq "atmost") {
786 $main::lxdebug->leave_sub();
791 sub retrieve_transfer_types {
792 $main::lxdebug->enter_sub();
795 my $direction = shift;
797 my $myconfig = \%main::myconfig;
798 my $form = $main::form;
800 my $dbh = $form->get_standard_dbh($myconfig);
802 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
804 $main::lxdebug->leave_sub();
809 sub get_basic_bin_info {
810 $main::lxdebug->enter_sub();
815 Common::check_params(\%params, qw(id));
817 my $myconfig = \%main::myconfig;
818 my $form = $main::form;
820 my $dbh = $params{dbh} || $form->get_standard_dbh();
822 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
825 qq|SELECT b.id AS bin_id, b.description AS bin_description,
826 w.id AS warehouse_id, w.description AS warehouse_description
828 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
829 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
831 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
833 if ('' eq ref $params{id}) {
834 $result = $result->[0] || { };
835 $main::lxdebug->leave_sub();
840 $main::lxdebug->leave_sub();
842 return map { $_->{bin_id} => $_ } @{ $result };
845 # Eingabe: Teilenummer, Lagernummer (warehouse)
846 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
848 sub get_max_qty_parts {
849 $main::lxdebug->enter_sub();
854 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
856 my $myconfig = \%main::myconfig;
857 my $form = $main::form;
859 my $dbh = $params{dbh} || $form->get_standard_dbh();
861 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
863 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
865 my $max_qty_parts = 0; #Initialisierung mit 0
866 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
867 $max_qty_parts += $ref->{sum};
870 $main::lxdebug->leave_sub();
872 return $max_qty_parts;
876 # Eingabe: Teilenummer, Lagernummer (warehouse)
877 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
879 sub get_part_description {
880 $main::lxdebug->enter_sub();
885 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
887 my $myconfig = \%main::myconfig;
888 my $form = $main::form;
890 my $dbh = $params{dbh} || $form->get_standard_dbh();
892 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
894 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
896 my $ref = $sth->fetchrow_hashref();
897 my $part_description = $ref->{partnumber} . " " . $ref->{description};
899 $main::lxdebug->leave_sub();
901 return $part_description;
911 SL::WH - Warehouse backend
916 WH->transfer(\%params);
920 Backend for lx-office warehousing functions.
924 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
926 This is the main function to manipulate warehouse contents. A typical transfer
932 transfer_type => 'transfer',
933 src_warehouse_id => 12,
935 dst_warehouse_id => 25,
939 It will generate an entry in inventory representing the transfer. Note that
940 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
941 a destination or a src is mandatory.
943 transfer accepts more than one transaction parameter, each being a hash ref. If
944 more than one is supplied, it is guaranteed, that all are processed in the same
947 Here is a full list of parameters. All "_id" parameters except oe and
948 orderitems can be called without id with RDB objects as well.
954 The id of the article transferred. Does not check if the article is a service.
959 Quantity of the transaction. Mandatory.
963 Unit of the transaction. Optional.
967 =item transfer_type_id
969 The type of transaction. The first version is a string describing the
970 transaction (the types 'transfer' 'in' 'out' and a few others are present on
971 every system), the id is the hard id of a transfer_type from the database.
973 Depending of the direction of the transfer_type, source and/or destination must
976 One of transfer_type or transfer_type_id is mandatory.
978 =item src_warehouse_id
982 Warehouse and bin from which to transfer. Mandatory in transfer and out
983 directions. Ignored in in directions.
985 =item dst_warehouse_id
989 Warehouse and bin to which to transfer. Mandatory in transfer and in
990 directions. Ignored in out directions.
994 If given, the transfer will transfer only articles with this chargenumber.
999 Reference to an orderitem for which this transfer happened. Optional
1003 Reference to an order for which this transfer happened. Optional
1007 An optional comment.
1011 An expiration date. Note that this is not by default used by C<warehouse_report>.