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));
64 my ($transfer, $field, $class, @find_by) = @_;
66 @find_by = (description => $transfer->{$field}) unless @find_by;
68 if ($transfer->{$field} || $transfer->{"${field}_id"}) {
69 return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
70 : $transfer->{$field} ? $class->_get_manager_class->find_by(@find_by)
71 : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
78 my $db = SL::DB::Inventory->new->db;
79 $db->do_transaction(sub{
80 while (my $transfer = shift @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', name => $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 || 1;
115 $qty /= $part->unit_obj->factor || 1 if $part->unit;
118 $params{chargenumber} ||= '';
120 if ($direction & 1) {
121 SL::DB::Inventory->new(
123 warehouse => $src_wh,
129 if ($direction & 2) {
130 SL::DB::Inventory->new(
132 warehouse => $dst_wh->id,
138 push @trans_ids, $trans_id;
141 $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
144 $::lxdebug->leave_sub;
149 sub transfer_assembly {
150 $main::lxdebug->enter_sub();
154 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
156 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
158 my $myconfig = \%main::myconfig;
159 my $form = $main::form;
160 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
165 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
166 # select parts_id,qty from assembly where id=1064;
167 # Erweiterung für bug 935 am 23.4.09 -
168 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
169 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
170 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
172 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
173 # wenn assembly nicht überprüft wird ...
174 # patch von joachim eingespielt 24.4.2009:
175 # my $query = qq|select parts_id,qty from assembly inner join parts
176 # on assembly.parts_id = parts.id where assembly.id = ? and
177 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
180 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
181 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
183 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
185 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
186 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
187 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
188 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
189 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
191 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
193 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
194 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
195 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
196 $schleife_durchlaufen=1; # Erzeugnis definiert
197 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
198 my $currentPart_ID = $hash_ref->{parts_id};
200 # Überprüfen, ob diese Anzahl gefertigt werden kann
201 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
202 warehouse_id => $params{dst_warehouse_id});
204 if ($partsQTY > $max_parts){
205 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
206 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
208 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
209 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
210 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
211 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
214 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
215 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
216 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
217 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
218 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
219 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
221 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
222 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
223 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
225 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
226 my $tmpPartsQTY = $partsQTY;
228 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
229 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
230 my $temppart_chargenumber = $temphash_ref->{chargenumber};
231 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
232 my $temppart_qty = $temphash_ref->{sum};
234 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
235 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
236 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
237 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
238 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
239 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
240 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
241 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
242 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
243 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
245 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
246 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
247 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
248 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
249 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
251 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
252 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
253 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
254 last; # beendet die schleife (springt zum letzten element)
256 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
257 } #ende while select parts_id,qty from assembly where id = ?
259 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
260 # keine einzelteile definiert
261 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
262 Dementsprechend kann auch nichts hergestellt werden";
264 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
265 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
266 if ($kannNichtFertigen) {
267 return $kannNichtFertigen;
270 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
271 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
272 comment, employee_id, qty, trans_id, trans_type_id)
273 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
274 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
275 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
276 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
277 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
280 $main::lxdebug->leave_sub();
281 return 1; # Alles erfolgreich
284 sub get_warehouse_journal {
285 $main::lxdebug->enter_sub();
290 my $myconfig = \%main::myconfig;
291 my $form = $main::form;
293 my $all_units = AM->retrieve_units($myconfig, $form);
295 # connect to database
296 my $dbh = $form->get_standard_dbh($myconfig);
299 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
301 if ($filter{warehouse_id}) {
302 push @filter_ary, "w1.id = ? OR w2.id = ?";
303 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
306 if ($filter{bin_id}) {
307 push @filter_ary, "b1.id = ? OR b2.id = ?";
308 push @filter_vars, $filter{bin_id}, $filter{bin_id};
311 if ($filter{partnumber}) {
312 push @filter_ary, "p.partnumber ILIKE ?";
313 push @filter_vars, '%' . $filter{partnumber} . '%';
316 if ($filter{description}) {
317 push @filter_ary, "(p.description ILIKE ?)";
318 push @filter_vars, '%' . $filter{description} . '%';
321 if ($filter{chargenumber}) {
322 push @filter_ary, "i1.chargenumber ILIKE ?";
323 push @filter_vars, '%' . $filter{chargenumber} . '%';
326 if ($form->{bestbefore}) {
327 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
328 push @filter_vars, $form->{bestbefore};
331 if ($form->{fromdate}) {
332 push @filter_ary, "?::DATE <= i1.itime::DATE";
333 push @filter_vars, $form->{fromdate};
336 if ($form->{todate}) {
337 push @filter_ary, "?::DATE >= i1.itime::DATE";
338 push @filter_vars, $form->{todate};
341 if ($form->{l_employee}) {
345 # prepare qty comparison for later filtering
346 my ($f_qty_op, $f_qty, $f_qty_base_unit);
347 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
348 $f_qty_op = $filter{qty_op};
349 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
350 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
353 map { $_ = "(${_})"; } @filter_ary;
355 # if of a property number or description is requested,
356 # automatically check the matching id too.
357 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
359 # customize shown entry for not available fields.
360 $filter{na} = '-' unless $filter{na};
362 # make order, search in $filter and $form
363 my $sort_col = $form->{sort};
364 my $sort_order = $form->{order};
366 $sort_col = $filter{sort} unless $sort_col;
367 $sort_order = ($sort_col = 'itime') unless $sort_col;
368 $sort_col = 'itime' if $sort_col eq 'date';
369 $sort_order = $filter{order} unless $sort_order;
370 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
372 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
374 $select_tokens{'trans'} = {
375 "parts_id" => "i1.parts_id",
376 "qty" => "ABS(SUM(i1.qty))",
377 "partnumber" => "p.partnumber",
378 "partdescription" => "p.description",
379 "bindescription" => "b.description",
380 "chargenumber" => "i1.chargenumber",
381 "bestbefore" => "i1.bestbefore",
382 "warehousedescription" => "w.description",
383 "partunit" => "p.unit",
384 "bin_from" => "b1.description",
385 "bin_to" => "b2.description",
386 "warehouse_from" => "w1.description",
387 "warehouse_to" => "w2.description",
388 "comment" => "i1.comment",
389 "trans_type" => "tt.description",
390 "trans_id" => "i1.trans_id",
391 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
392 "date" => "i1.itime::DATE",
393 "itime" => "i1.itime",
394 "employee" => "e.name",
395 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
398 $select_tokens{'out'} = {
399 "bin_to" => "'$filter{na}'",
400 "warehouse_to" => "'$filter{na}'",
403 $select_tokens{'in'} = {
404 "bin_from" => "'$filter{na}'",
405 "warehouse_from" => "'$filter{na}'",
408 # build the select clauses.
409 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
410 for my $i ('trans', 'out', 'in') {
411 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
412 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
415 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
416 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
418 $where_clause = defined($where_clause) ? $where_clause : '';
420 qq|SELECT DISTINCT $select{trans}
422 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
423 LEFT JOIN parts p ON i1.parts_id = p.id
424 LEFT JOIN bin b1 ON i1.bin_id = b1.id
425 LEFT JOIN bin b2 ON i2.bin_id = b2.id
426 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
427 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
428 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
429 LEFT JOIN project pr ON i1.project_id = pr.id
430 LEFT JOIN employee e ON i1.employee_id = e.id
431 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
432 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
433 GROUP BY $group_clause
437 SELECT DISTINCT $select{out}
439 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
440 LEFT JOIN parts p ON i1.parts_id = p.id
441 LEFT JOIN bin b1 ON i1.bin_id = b1.id
442 LEFT JOIN bin b2 ON i2.bin_id = b2.id
443 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
444 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
445 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
446 LEFT JOIN project pr ON i1.project_id = pr.id
447 LEFT JOIN employee e ON i1.employee_id = e.id
448 WHERE $where_clause i1.qty < 0 AND
449 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
450 GROUP BY $group_clause
454 SELECT DISTINCT $select{in}
456 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
457 LEFT JOIN parts p ON i1.parts_id = p.id
458 LEFT JOIN bin b1 ON i1.bin_id = b1.id
459 LEFT JOIN bin b2 ON i2.bin_id = b2.id
460 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
461 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
462 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
463 LEFT JOIN project pr ON i1.project_id = pr.id
464 LEFT JOIN employee e ON i1.employee_id = e.id
465 WHERE $where_clause i1.qty > 0 AND
466 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
467 GROUP BY $group_clause
468 ORDER BY r_${sort_spec}|;
470 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
472 my ($h_oe_id, $q_oe_id);
473 if ($form->{l_oe_id}) {
476 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
478 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
479 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
480 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
481 ELSE 'purchase_order'
488 SELECT dord.id AS id, dord.donumber AS number,
490 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
491 ELSE 'sales_delivery_order'
493 FROM delivery_orders dord
498 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
504 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
508 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
512 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
513 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
514 my $qty = $ref->{"qty"} * 1;
516 next unless ($qty > 0);
519 my $part_unit = $all_units->{$ref->{"partunit"}};
520 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
521 $qty *= $part_unit->{"factor"};
522 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
523 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
524 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
527 if ($h_oe_id && $ref->{oe_id}) {
528 do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
529 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
532 push @contents, $ref;
536 $h_oe_id->finish() if $h_oe_id;
538 $main::lxdebug->leave_sub();
544 # This sub is the primary function to retrieve information about items in warehouses.
545 # $filter is a hashref and supports the following keys:
546 # - warehouse_id - will return matches with this warehouse_id only
547 # - partnumber - will return only matches where the given string is a substring of the partnumber
548 # - partsid - will return matches with this parts_id only
549 # - description - will return only matches where the given string is a substring of the description
550 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
551 # - bestbefore - will return only matches with this bestbefore date
552 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
553 # - charge_ids - must be an arrayref. will return contents with these ids only
554 # - expires_in - will only return matches that expire within the given number of days
555 # will also add a column named 'has_expired' containing if the match has already expired or not
556 # - hazardous - will return matches with the flag hazardous only
557 # - oil - will return matches with the flag oil only
558 # - qty, qty_op - quantity filter (more info to come)
559 # - sort, order_by - sorting (more to come)
560 # - reservation - will provide an extra column containing the amount reserved of this match
561 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
563 sub get_warehouse_report {
564 $main::lxdebug->enter_sub();
569 my $myconfig = \%main::myconfig;
570 my $form = $main::form;
572 my $all_units = AM->retrieve_units($myconfig, $form);
574 # connect to database
575 my $dbh = $form->get_standard_dbh($myconfig);
578 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
580 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
582 if ($filter{warehouse_id}) {
583 push @wh_bin_filter_ary, "w.id = ?";
584 push @wh_bin_filter_vars, $filter{warehouse_id};
587 if ($filter{bin_id}) {
588 push @wh_bin_filter_ary, "b.id = ?";
589 push @wh_bin_filter_vars, $filter{bin_id};
592 push @filter_ary, @wh_bin_filter_ary;
593 push @filter_vars, @wh_bin_filter_vars;
595 if ($filter{partnumber}) {
596 push @filter_ary, "p.partnumber ILIKE ?";
597 push @filter_vars, '%' . $filter{partnumber} . '%';
600 if ($filter{description}) {
601 push @filter_ary, "p.description ILIKE ?";
602 push @filter_vars, '%' . $filter{description} . '%';
605 if ($filter{partsid}) {
606 push @filter_ary, "p.id = ?";
607 push @filter_vars, $filter{partsid};
610 if ($filter{chargenumber}) {
611 push @filter_ary, "i.chargenumber ILIKE ?";
612 push @filter_vars, '%' . $filter{chargenumber} . '%';
615 if ($form->{bestbefore}) {
616 push @filter_ary, "?::DATE = i.bestbefore::DATE";
617 push @filter_vars, $form->{bestbefore};
621 push @filter_ary, "p.ean ILIKE ?";
622 push @filter_vars, '%' . $filter{ean} . '%';
626 push @filter_ary, "i.itime <= ?";
627 push @filter_vars, $filter{date};
629 if (!$filter{include_invalid_warehouses}){
630 push @filter_ary, "NOT (w.invalid)";
633 # prepare qty comparison for later filtering
634 my ($f_qty_op, $f_qty, $f_qty_base_unit);
636 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
637 $f_qty_op = $filter{qty_op};
638 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
639 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
642 map { $_ = "(${_})"; } @filter_ary;
644 # if of a property number or description is requested,
645 # automatically check the matching id too.
646 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
648 # make order, search in $filter and $form
649 my $sort_col = $form->{sort};
650 my $sort_order = $form->{order};
652 $sort_col = $filter{sort} unless $sort_col;
653 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
654 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
655 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
656 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
657 # S.a. Bug 1597 jb 12.5.2011
658 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
659 $sort_order = $filter{order} unless $sort_order;
660 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
661 my $orderby = $sort_col;
662 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
664 my $where_clause = join " AND ", ("1=1", @filter_ary);
666 my %select_tokens = (
667 "parts_id" => "i.parts_id",
668 "qty" => "SUM(i.qty)",
669 "warehouseid" => "i.warehouse_id",
670 "partnumber" => "p.partnumber",
671 "partdescription" => "p.description",
672 "bindescription" => "b.description",
674 "chargenumber" => "i.chargenumber",
675 "bestbefore" => "i.bestbefore",
677 "chargeid" => "c.id",
678 "warehousedescription" => "w.description",
679 "partunit" => "p.unit",
680 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
682 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
683 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
684 qw(l_parts_id l_qty l_partunit) );
686 my $group_clause = join ", ", map { +/^l_/; "$'" }
687 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
688 qw(l_parts_id l_partunit) );
691 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
694 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
695 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
696 qw(l_parts_id l_qty l_partunit) );
699 qq|SELECT $select_clause
701 LEFT JOIN parts p ON i.parts_id = p.id
702 LEFT JOIN bin b ON i.bin_id = b.id
703 LEFT JOIN warehouse w ON i.warehouse_id = w.id
706 GROUP BY $group_clause
707 ORDER BY $sort_spec|;
709 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
711 my (%non_empty_bins, @all_fields, @contents);
713 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
715 my $qty = $ref->{qty};
717 next unless ($qty != 0);
720 my $part_unit = $all_units->{$ref->{partunit}};
721 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
722 $qty *= $part_unit->{factor};
723 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
724 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
725 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
728 if ($form->{include_empty_bins}) {
729 $non_empty_bins{$ref->{binid}} = 1;
730 @all_fields = keys %{ $ref } unless (@all_fields);
733 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
735 push @contents, $ref;
740 if ($form->{include_empty_bins}) {
743 w.id AS warehouseid, w.description AS warehousedescription,
744 b.id AS binid, b.description AS bindescription
746 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
748 @filter_ary = @wh_bin_filter_ary;
749 @filter_vars = @wh_bin_filter_vars;
751 my @non_empty_bin_ids = keys %non_empty_bins;
752 if (@non_empty_bin_ids) {
753 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
754 push @filter_vars, @non_empty_bin_ids;
757 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
759 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
761 while (my $ref = $sth->fetchrow_hashref()) {
762 map { $ref->{$_} ||= "" } @all_fields;
763 push @contents, $ref;
767 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
768 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
772 $main::lxdebug->leave_sub();
778 $main::lxdebug->enter_sub();
780 my ($self, $qty_op) = @_;
782 if (!$qty_op || ($qty_op eq "dontcare")) {
783 $main::lxdebug->leave_sub();
787 if ($qty_op eq "atleast") {
789 } elsif ($qty_op eq "atmost") {
795 $main::lxdebug->leave_sub();
800 sub retrieve_transfer_types {
801 $main::lxdebug->enter_sub();
804 my $direction = shift;
806 my $myconfig = \%main::myconfig;
807 my $form = $main::form;
809 my $dbh = $form->get_standard_dbh($myconfig);
811 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
813 $main::lxdebug->leave_sub();
818 sub get_basic_bin_info {
819 $main::lxdebug->enter_sub();
824 Common::check_params(\%params, qw(id));
826 my $myconfig = \%main::myconfig;
827 my $form = $main::form;
829 my $dbh = $params{dbh} || $form->get_standard_dbh();
831 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
834 qq|SELECT b.id AS bin_id, b.description AS bin_description,
835 w.id AS warehouse_id, w.description AS warehouse_description
837 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
838 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
840 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
842 if ('' eq ref $params{id}) {
843 $result = $result->[0] || { };
844 $main::lxdebug->leave_sub();
849 $main::lxdebug->leave_sub();
851 return map { $_->{bin_id} => $_ } @{ $result };
854 # Eingabe: Teilenummer, Lagernummer (warehouse)
855 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
857 sub get_max_qty_parts {
858 $main::lxdebug->enter_sub();
863 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
865 my $myconfig = \%main::myconfig;
866 my $form = $main::form;
868 my $dbh = $params{dbh} || $form->get_standard_dbh();
870 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
872 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
874 my $max_qty_parts = 0; #Initialisierung mit 0
875 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
876 $max_qty_parts += $ref->{sum};
879 $main::lxdebug->leave_sub();
881 return $max_qty_parts;
885 # Eingabe: Teilenummer, Lagernummer (warehouse)
886 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
888 sub get_part_description {
889 $main::lxdebug->enter_sub();
894 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
896 my $myconfig = \%main::myconfig;
897 my $form = $main::form;
899 my $dbh = $params{dbh} || $form->get_standard_dbh();
901 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
903 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
905 my $ref = $sth->fetchrow_hashref();
906 my $part_description = $ref->{partnumber} . " " . $ref->{description};
908 $main::lxdebug->leave_sub();
910 return $part_description;
920 SL::WH - Warehouse backend
925 WH->transfer(\%params);
929 Backend for lx-office warehousing functions.
933 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
935 This is the main function to manipulate warehouse contents. A typical transfer
941 transfer_type => 'transfer',
942 src_warehouse_id => 12,
944 dst_warehouse_id => 25,
948 It will generate an entry in inventory representing the transfer. Note that
949 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
950 a destination or a src is mandatory.
952 transfer accepts more than one transaction parameter, each being a hash ref. If
953 more than one is supplied, it is guaranteed, that all are processed in the same
956 Here is a full list of parameters. All "_id" parameters except oe and
957 orderitems can be called without id with RDB objects as well.
963 The id of the article transferred. Does not check if the article is a service.
968 Quantity of the transaction. Mandatory.
972 Unit of the transaction. Optional.
976 =item transfer_type_id
978 The type of transaction. The first version is a string describing the
979 transaction (the types 'transfer' 'in' 'out' and a few others are present on
980 every system), the id is the hard id of a transfer_type from the database.
982 Depending of the direction of the transfer_type, source and/or destination must
985 One of transfer_type or transfer_type_id is mandatory.
987 =item src_warehouse_id
991 Warehouse and bin from which to transfer. Mandatory in transfer and out
992 directions. Ignored in in directions.
994 =item dst_warehouse_id
998 Warehouse and bin to which to transfer. Mandatory in transfer and in
999 directions. Ignored in out directions.
1003 If given, the transfer will transfer only articles with this chargenumber.
1008 Reference to an orderitem for which this transfer happened. Optional
1012 Reference to an order for which this transfer happened. Optional
1016 An optional comment.
1020 An expiration date. Note that this is not by default used by C<warehouse_report>.