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 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,
136 push @trans_ids, $trans_id;
139 $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
142 $::lxdebug->leave_sub;
147 sub transfer_assembly {
148 $main::lxdebug->enter_sub();
152 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
154 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
156 my $myconfig = \%main::myconfig;
157 my $form = $main::form;
158 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
163 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
164 # select parts_id,qty from assembly where id=1064;
165 # Erweiterung für bug 935 am 23.4.09 -
166 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
167 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
168 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
170 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
171 # wenn assembly nicht überprüft wird ...
172 # patch von joachim eingespielt 24.4.2009:
173 # my $query = qq|select parts_id,qty from assembly inner join parts
174 # on assembly.parts_id = parts.id where assembly.id = ? and
175 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
178 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
179 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
181 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
183 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
184 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
185 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
186 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
187 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
189 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
191 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
192 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
193 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
194 $schleife_durchlaufen=1; # Erzeugnis definiert
195 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
196 my $currentPart_ID = $hash_ref->{parts_id};
198 # Überprüfen, ob diese Anzahl gefertigt werden kann
199 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
200 warehouse_id => $params{dst_warehouse_id});
202 if ($partsQTY > $max_parts){
203 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
204 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
206 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
207 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
208 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
209 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
212 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
213 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
214 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
215 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
216 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
217 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
219 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
220 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
221 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
223 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
224 my $tmpPartsQTY = $partsQTY;
226 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
227 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
228 my $temppart_chargenumber = $temphash_ref->{chargenumber};
229 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
230 my $temppart_qty = $temphash_ref->{sum};
232 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
233 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
234 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
235 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
236 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
237 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
238 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
239 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
240 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
241 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
243 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
244 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
245 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
246 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
247 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
249 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
250 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
251 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
252 last; # beendet die schleife (springt zum letzten element)
254 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
255 } #ende while select parts_id,qty from assembly where id = ?
257 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
258 # keine einzelteile definiert
259 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
260 Dementsprechend kann auch nichts hergestellt werden";
262 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
263 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
264 if ($kannNichtFertigen) {
265 return $kannNichtFertigen;
268 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
269 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
270 comment, employee_id, qty, trans_id, trans_type_id)
271 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
272 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
273 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
274 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
275 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
278 $main::lxdebug->leave_sub();
279 return 1; # Alles erfolgreich
282 sub get_warehouse_journal {
283 $main::lxdebug->enter_sub();
288 my $myconfig = \%main::myconfig;
289 my $form = $main::form;
291 my $all_units = AM->retrieve_units($myconfig, $form);
293 # connect to database
294 my $dbh = $form->get_standard_dbh($myconfig);
297 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
299 if ($filter{warehouse_id}) {
300 push @filter_ary, "w1.id = ? OR w2.id = ?";
301 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
304 if ($filter{bin_id}) {
305 push @filter_ary, "b1.id = ? OR b2.id = ?";
306 push @filter_vars, $filter{bin_id}, $filter{bin_id};
309 if ($filter{partnumber}) {
310 push @filter_ary, "p.partnumber ILIKE ?";
311 push @filter_vars, '%' . $filter{partnumber} . '%';
314 if ($filter{description}) {
315 push @filter_ary, "(p.description ILIKE ?)";
316 push @filter_vars, '%' . $filter{description} . '%';
319 if ($filter{chargenumber}) {
320 push @filter_ary, "i1.chargenumber ILIKE ?";
321 push @filter_vars, '%' . $filter{chargenumber} . '%';
324 if ($form->{bestbefore}) {
325 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
326 push @filter_vars, $form->{bestbefore};
329 if ($form->{fromdate}) {
330 push @filter_ary, "?::DATE <= i1.itime::DATE";
331 push @filter_vars, $form->{fromdate};
334 if ($form->{todate}) {
335 push @filter_ary, "?::DATE >= i1.itime::DATE";
336 push @filter_vars, $form->{todate};
339 if ($form->{l_employee}) {
343 # prepare qty comparison for later filtering
344 my ($f_qty_op, $f_qty, $f_qty_base_unit);
345 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
346 $f_qty_op = $filter{qty_op};
347 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
348 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
351 map { $_ = "(${_})"; } @filter_ary;
353 # if of a property number or description is requested,
354 # automatically check the matching id too.
355 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
357 # customize shown entry for not available fields.
358 $filter{na} = '-' unless $filter{na};
360 # make order, search in $filter and $form
361 my $sort_col = $form->{sort};
362 my $sort_order = $form->{order};
364 $sort_col = $filter{sort} unless $sort_col;
365 $sort_order = ($sort_col = 'itime') unless $sort_col;
366 $sort_col = 'itime' if $sort_col eq 'date';
367 $sort_order = $filter{order} unless $sort_order;
368 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
370 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
372 $select_tokens{'trans'} = {
373 "parts_id" => "i1.parts_id",
374 "qty" => "ABS(SUM(i1.qty))",
375 "partnumber" => "p.partnumber",
376 "partdescription" => "p.description",
377 "bindescription" => "b.description",
378 "chargenumber" => "i1.chargenumber",
379 "bestbefore" => "i1.bestbefore",
380 "warehousedescription" => "w.description",
381 "partunit" => "p.unit",
382 "bin_from" => "b1.description",
383 "bin_to" => "b2.description",
384 "warehouse_from" => "w1.description",
385 "warehouse_to" => "w2.description",
386 "comment" => "i1.comment",
387 "trans_type" => "tt.description",
388 "trans_id" => "i1.trans_id",
389 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
390 "date" => "i1.itime::DATE",
391 "itime" => "i1.itime",
392 "employee" => "e.name",
393 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
396 $select_tokens{'out'} = {
397 "bin_to" => "'$filter{na}'",
398 "warehouse_to" => "'$filter{na}'",
401 $select_tokens{'in'} = {
402 "bin_from" => "'$filter{na}'",
403 "warehouse_from" => "'$filter{na}'",
406 # build the select clauses.
407 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
408 for my $i ('trans', 'out', 'in') {
409 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
410 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
413 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
414 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
416 $where_clause = defined($where_clause) ? $where_clause : '';
418 qq|SELECT DISTINCT $select{trans}
420 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
421 LEFT JOIN parts p ON i1.parts_id = p.id
422 LEFT JOIN bin b1 ON i1.bin_id = b1.id
423 LEFT JOIN bin b2 ON i2.bin_id = b2.id
424 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
425 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
426 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
427 LEFT JOIN project pr ON i1.project_id = pr.id
428 LEFT JOIN employee e ON i1.employee_id = e.id
429 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
430 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
431 GROUP BY $group_clause
435 SELECT DISTINCT $select{out}
437 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
438 LEFT JOIN parts p ON i1.parts_id = p.id
439 LEFT JOIN bin b1 ON i1.bin_id = b1.id
440 LEFT JOIN bin b2 ON i2.bin_id = b2.id
441 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
442 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
443 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
444 LEFT JOIN project pr ON i1.project_id = pr.id
445 LEFT JOIN employee e ON i1.employee_id = e.id
446 WHERE $where_clause i1.qty < 0 AND
447 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
448 GROUP BY $group_clause
452 SELECT DISTINCT $select{in}
454 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
455 LEFT JOIN parts p ON i1.parts_id = p.id
456 LEFT JOIN bin b1 ON i1.bin_id = b1.id
457 LEFT JOIN bin b2 ON i2.bin_id = b2.id
458 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
459 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
460 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
461 LEFT JOIN project pr ON i1.project_id = pr.id
462 LEFT JOIN employee e ON i1.employee_id = e.id
463 WHERE $where_clause i1.qty > 0 AND
464 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
465 GROUP BY $group_clause
466 ORDER BY r_${sort_spec}|;
468 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
470 my ($h_oe_id, $q_oe_id);
471 if ($form->{l_oe_id}) {
474 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
476 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
477 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
478 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
479 ELSE 'purchase_order'
486 SELECT dord.id AS id, dord.donumber AS number,
488 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
489 ELSE 'sales_delivery_order'
491 FROM delivery_orders dord
496 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
502 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
506 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
510 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
511 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
512 my $qty = $ref->{"qty"} * 1;
514 next unless ($qty > 0);
517 my $part_unit = $all_units->{$ref->{"partunit"}};
518 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
519 $qty *= $part_unit->{"factor"};
520 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
521 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
522 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
525 if ($h_oe_id && $ref->{oe_id}) {
526 do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
527 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
530 push @contents, $ref;
534 $h_oe_id->finish() if $h_oe_id;
536 $main::lxdebug->leave_sub();
542 # This sub is the primary function to retrieve information about items in warehouses.
543 # $filter is a hashref and supports the following keys:
544 # - warehouse_id - will return matches with this warehouse_id only
545 # - partnumber - will return only matches where the given string is a substring of the partnumber
546 # - partsid - will return matches with this parts_id only
547 # - description - will return only matches where the given string is a substring of the description
548 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
549 # - bestbefore - will return only matches with this bestbefore date
550 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
551 # - charge_ids - must be an arrayref. will return contents with these ids only
552 # - expires_in - will only return matches that expire within the given number of days
553 # will also add a column named 'has_expired' containing if the match has already expired or not
554 # - hazardous - will return matches with the flag hazardous only
555 # - oil - will return matches with the flag oil only
556 # - qty, qty_op - quantity filter (more info to come)
557 # - sort, order_by - sorting (more to come)
558 # - reservation - will provide an extra column containing the amount reserved of this match
559 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
561 sub get_warehouse_report {
562 $main::lxdebug->enter_sub();
567 my $myconfig = \%main::myconfig;
568 my $form = $main::form;
570 my $all_units = AM->retrieve_units($myconfig, $form);
572 # connect to database
573 my $dbh = $form->get_standard_dbh($myconfig);
576 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
578 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
580 if ($filter{warehouse_id}) {
581 push @wh_bin_filter_ary, "w.id = ?";
582 push @wh_bin_filter_vars, $filter{warehouse_id};
585 if ($filter{bin_id}) {
586 push @wh_bin_filter_ary, "b.id = ?";
587 push @wh_bin_filter_vars, $filter{bin_id};
590 push @filter_ary, @wh_bin_filter_ary;
591 push @filter_vars, @wh_bin_filter_vars;
593 if ($filter{partnumber}) {
594 push @filter_ary, "p.partnumber ILIKE ?";
595 push @filter_vars, '%' . $filter{partnumber} . '%';
598 if ($filter{description}) {
599 push @filter_ary, "p.description ILIKE ?";
600 push @filter_vars, '%' . $filter{description} . '%';
603 if ($filter{partsid}) {
604 push @filter_ary, "p.id = ?";
605 push @filter_vars, $filter{partsid};
608 if ($filter{chargenumber}) {
609 push @filter_ary, "i.chargenumber ILIKE ?";
610 push @filter_vars, '%' . $filter{chargenumber} . '%';
613 if ($form->{bestbefore}) {
614 push @filter_ary, "?::DATE = i.bestbefore::DATE";
615 push @filter_vars, $form->{bestbefore};
619 push @filter_ary, "p.ean ILIKE ?";
620 push @filter_vars, '%' . $filter{ean} . '%';
624 push @filter_ary, "i.itime <= ?";
625 push @filter_vars, $filter{date};
628 # prepare qty comparison for later filtering
629 my ($f_qty_op, $f_qty, $f_qty_base_unit);
631 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
632 $f_qty_op = $filter{qty_op};
633 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
634 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
637 map { $_ = "(${_})"; } @filter_ary;
639 # if of a property number or description is requested,
640 # automatically check the matching id too.
641 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
643 # make order, search in $filter and $form
644 my $sort_col = $form->{sort};
645 my $sort_order = $form->{order};
647 $sort_col = $filter{sort} unless $sort_col;
648 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
649 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
650 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
651 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
652 # S.a. Bug 1597 jb 12.5.2011
653 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
654 $sort_order = $filter{order} unless $sort_order;
655 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
656 my $orderby = $sort_col;
657 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
659 my $where_clause = join " AND ", ("1=1", @filter_ary);
661 my %select_tokens = (
662 "parts_id" => "i.parts_id",
663 "qty" => "SUM(i.qty)",
664 "warehouseid" => "i.warehouse_id",
665 "partnumber" => "p.partnumber",
666 "partdescription" => "p.description",
667 "bindescription" => "b.description",
669 "chargenumber" => "i.chargenumber",
670 "bestbefore" => "i.bestbefore",
672 "chargeid" => "c.id",
673 "warehousedescription" => "w.description",
674 "partunit" => "p.unit",
675 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
677 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
678 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
679 qw(l_parts_id l_qty l_partunit) );
681 my $group_clause = join ", ", map { +/^l_/; "$'" }
682 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
683 qw(l_parts_id l_partunit) );
686 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
689 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
690 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
691 qw(l_parts_id l_qty l_partunit) );
694 qq|SELECT $select_clause
696 LEFT JOIN parts p ON i.parts_id = p.id
697 LEFT JOIN bin b ON i.bin_id = b.id
698 LEFT JOIN warehouse w ON i.warehouse_id = w.id
701 GROUP BY $group_clause
702 ORDER BY $sort_spec|;
704 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
706 my (%non_empty_bins, @all_fields, @contents);
708 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
710 my $qty = $ref->{qty};
712 next unless ($qty != 0);
715 my $part_unit = $all_units->{$ref->{partunit}};
716 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
717 $qty *= $part_unit->{factor};
718 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
719 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
720 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
723 if ($form->{include_empty_bins}) {
724 $non_empty_bins{$ref->{binid}} = 1;
725 @all_fields = keys %{ $ref } unless (@all_fields);
728 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
730 push @contents, $ref;
735 if ($form->{include_empty_bins}) {
738 w.id AS warehouseid, w.description AS warehousedescription,
739 b.id AS binid, b.description AS bindescription
741 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
743 @filter_ary = @wh_bin_filter_ary;
744 @filter_vars = @wh_bin_filter_vars;
746 my @non_empty_bin_ids = keys %non_empty_bins;
747 if (@non_empty_bin_ids) {
748 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
749 push @filter_vars, @non_empty_bin_ids;
752 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
754 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
756 while (my $ref = $sth->fetchrow_hashref()) {
757 map { $ref->{$_} ||= "" } @all_fields;
758 push @contents, $ref;
762 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
763 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
767 $main::lxdebug->leave_sub();
773 $main::lxdebug->enter_sub();
775 my ($self, $qty_op) = @_;
777 if (!$qty_op || ($qty_op eq "dontcare")) {
778 $main::lxdebug->leave_sub();
782 if ($qty_op eq "atleast") {
784 } elsif ($qty_op eq "atmost") {
790 $main::lxdebug->leave_sub();
795 sub retrieve_transfer_types {
796 $main::lxdebug->enter_sub();
799 my $direction = shift;
801 my $myconfig = \%main::myconfig;
802 my $form = $main::form;
804 my $dbh = $form->get_standard_dbh($myconfig);
806 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
808 $main::lxdebug->leave_sub();
813 sub get_basic_bin_info {
814 $main::lxdebug->enter_sub();
819 Common::check_params(\%params, qw(id));
821 my $myconfig = \%main::myconfig;
822 my $form = $main::form;
824 my $dbh = $params{dbh} || $form->get_standard_dbh();
826 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
829 qq|SELECT b.id AS bin_id, b.description AS bin_description,
830 w.id AS warehouse_id, w.description AS warehouse_description
832 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
833 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
835 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
837 if ('' eq ref $params{id}) {
838 $result = $result->[0] || { };
839 $main::lxdebug->leave_sub();
844 $main::lxdebug->leave_sub();
846 return map { $_->{bin_id} => $_ } @{ $result };
849 # Eingabe: Teilenummer, Lagernummer (warehouse)
850 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
852 sub get_max_qty_parts {
853 $main::lxdebug->enter_sub();
858 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
860 my $myconfig = \%main::myconfig;
861 my $form = $main::form;
863 my $dbh = $params{dbh} || $form->get_standard_dbh();
865 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
867 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
869 my $max_qty_parts = 0; #Initialisierung mit 0
870 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
871 $max_qty_parts += $ref->{sum};
874 $main::lxdebug->leave_sub();
876 return $max_qty_parts;
880 # Eingabe: Teilenummer, Lagernummer (warehouse)
881 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
883 sub get_part_description {
884 $main::lxdebug->enter_sub();
889 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
891 my $myconfig = \%main::myconfig;
892 my $form = $main::form;
894 my $dbh = $params{dbh} || $form->get_standard_dbh();
896 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
898 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
900 my $ref = $sth->fetchrow_hashref();
901 my $part_description = $ref->{partnumber} . " " . $ref->{description};
903 $main::lxdebug->leave_sub();
905 return $part_description;
915 SL::WH - Warehouse backend
920 WH->transfer(\%params);
924 Backend for lx-office warehousing functions.
928 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
930 This is the main function to manipulate warehouse contents. A typical transfer
936 transfer_type => 'transfer',
937 src_warehouse_id => 12,
939 dst_warehouse_id => 25,
943 It will generate an entry in inventory representing the transfer. Note that
944 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
945 a destination or a src is mandatory.
947 transfer accepts more than one transaction parameter, each being a hash ref. If
948 more than one is supplied, it is guaranteed, that all are processed in the same
951 Here is a full list of parameters. All "_id" parameters except oe and
952 orderitems can be called without id with RDB objects as well.
958 The id of the article transferred. Does not check if the article is a service.
963 Quantity of the transaction. Mandatory.
967 Unit of the transaction. Optional.
971 =item transfer_type_id
973 The type of transaction. The first version is a string describing the
974 transaction (the types 'transfer' 'in' 'out' and a few others are present on
975 every system), the id is the hard id of a transfer_type from the database.
977 Depending of the direction of the transfer_type, source and/or destination must
980 One of transfer_type or transfer_type_id is mandatory.
982 =item src_warehouse_id
986 Warehouse and bin from which to transfer. Mandatory in transfer and out
987 directions. Ignored in in directions.
989 =item dst_warehouse_id
993 Warehouse and bin to which to transfer. Mandatory in transfer and in
994 directions. Ignored in out directions.
998 If given, the transfer will transfer only articles with this chargenumber.
1003 Reference to an orderitem for which this transfer happened. Optional
1007 Reference to an order for which this transfer happened. Optional
1011 An optional comment.
1015 An expiration date. Note that this is not by default used by C<warehouse_report>.