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"});
76 my $db = SL::DB::Inventory->new->db;
77 $db->do_transaction(sub{
78 while (my $transfer = shift @args) {
79 my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
81 my $part = $objectify->($transfer, 'parts', 'SL::DB::Part');
82 my $unit = $objectify->($transfer, 'unit', 'SL::DB::Unit', name => $transfer->{unit});
83 my $qty = $transfer->{qty};
84 my $src_bin = $objectify->($transfer, 'src_bin', 'SL::DB::Bin');
85 my $dst_bin = $objectify->($transfer, 'dst_bin', 'SL::DB::Bin');
86 my $src_wh = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
87 my $dst_wh = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
88 my $project = $objectify->($transfer, 'project', 'SL::DB::Project');
90 $src_wh ||= $src_bin->warehouse if $src_bin;
91 $dst_wh ||= $dst_bin->warehouse if $dst_bin;
93 my $direction = 0; # bit mask
94 $direction |= 1 if $src_bin;
95 $direction |= 2 if $dst_bin;
97 my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction => $directions[$direction],
98 description => $transfer->{transfer_type});
102 employee => $employee,
103 trans_type => $transfer_type,
105 trans_id => $trans_id,
106 shippingdate => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
107 ? $now : $transfer->{shippingdate},
108 map { $_ => $transfer->{$_} } qw( chargenumber bestbefore oe_id orderitems_id comment),
112 $qty *= $unit->factor || 1;
113 $qty /= $part->unit_obj->factor || 1 if $part->unit;
116 if ($direction & 1) {
117 SL::DB::Inventory->new(
119 warehouse => $src_wh,
125 if ($direction & 2) {
126 SL::DB::Inventory->new(
128 warehouse => $dst_wh->id,
135 $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
138 $::lxdebug->leave_sub;
141 sub transfer_assembly {
142 $main::lxdebug->enter_sub();
146 Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
148 # my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
150 my $myconfig = \%main::myconfig;
151 my $form = $main::form;
152 my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
157 # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
158 # select parts_id,qty from assembly where id=1064;
159 # Erweiterung für bug 935 am 23.4.09 -
160 # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
161 # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
162 # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
164 # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
165 # wenn assembly nicht überprüft wird ...
166 # patch von joachim eingespielt 24.4.2009:
167 # my $query = qq|select parts_id,qty from assembly inner join parts
168 # on assembly.parts_id = parts.id where assembly.id = ? and
169 # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
172 my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
173 where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
175 my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
177 # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
178 my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty, trans_id, trans_type_id)
179 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
180 (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'))|;
181 my $sthTransferPartSQL = prepare_query($form, $dbh, $transferPartSQL);
183 # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
185 my $kannNichtFertigen =""; # Falls leer dann erfolgreich
186 my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
187 while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
188 $schleife_durchlaufen=1; # Erzeugnis definiert
189 my $partsQTY = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
190 my $currentPart_ID = $hash_ref->{parts_id};
192 # Überprüfen, ob diese Anzahl gefertigt werden kann
193 my $max_parts = $self->get_max_qty_parts(parts_id => $currentPart_ID, # $self->method() == this.method()
194 warehouse_id => $params{dst_warehouse_id});
196 if ($partsQTY > $max_parts){
197 # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
198 # 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
200 $kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
201 " Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) .
202 ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
203 next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
206 # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
207 # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
208 # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
209 # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
210 # und lösen den Rest dann so wie bei xplace im Barcode-Programm
211 # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
213 my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
214 WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
215 my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
217 # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
218 my $tmpPartsQTY = $partsQTY;
220 while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
221 my $temppart_bin_id = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
222 my $temppart_chargenumber = $temphash_ref->{chargenumber};
223 my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
224 my $temppart_qty = $temphash_ref->{sum};
226 if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
227 # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
228 $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
229 $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
230 # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
231 # Dieser Wert IST und BLEIBT positiv!! Hilfe.
232 # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
233 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
234 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
235 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
237 # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
238 # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
239 # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
240 # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
241 } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
243 do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
244 $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
245 $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
246 last; # beendet die schleife (springt zum letzten element)
248 } # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory WHERE warehouse_id
249 } #ende while select parts_id,qty from assembly where id = ?
251 if ($schleife_durchlaufen==0){ # falls die schleife nicht durchlaufen wurde, wurden auch
252 # keine einzelteile definiert
253 $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
254 Dementsprechend kann auch nichts hergestellt werden";
256 # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
257 # B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
258 if ($kannNichtFertigen) {
259 return $kannNichtFertigen;
262 # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
263 my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
264 comment, employee_id, qty, trans_id, trans_type_id)
265 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
266 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|;
267 my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL);
268 do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
269 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
272 $main::lxdebug->leave_sub();
273 return 1; # Alles erfolgreich
276 sub get_warehouse_journal {
277 $main::lxdebug->enter_sub();
282 my $myconfig = \%main::myconfig;
283 my $form = $main::form;
285 my $all_units = AM->retrieve_units($myconfig, $form);
287 # connect to database
288 my $dbh = $form->get_standard_dbh($myconfig);
291 my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
293 if ($filter{warehouse_id}) {
294 push @filter_ary, "w1.id = ? OR w2.id = ?";
295 push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
298 if ($filter{bin_id}) {
299 push @filter_ary, "b1.id = ? OR b2.id = ?";
300 push @filter_vars, $filter{bin_id}, $filter{bin_id};
303 if ($filter{partnumber}) {
304 push @filter_ary, "p.partnumber ILIKE ?";
305 push @filter_vars, '%' . $filter{partnumber} . '%';
308 if ($filter{description}) {
309 push @filter_ary, "(p.description ILIKE ?)";
310 push @filter_vars, '%' . $filter{description} . '%';
313 if ($filter{chargenumber}) {
314 push @filter_ary, "i1.chargenumber ILIKE ?";
315 push @filter_vars, '%' . $filter{chargenumber} . '%';
318 if ($form->{bestbefore}) {
319 push @filter_ary, "?::DATE = i1.bestbefore::DATE";
320 push @filter_vars, $form->{bestbefore};
323 if ($form->{fromdate}) {
324 push @filter_ary, "?::DATE <= i1.itime::DATE";
325 push @filter_vars, $form->{fromdate};
328 if ($form->{todate}) {
329 push @filter_ary, "?::DATE >= i1.itime::DATE";
330 push @filter_vars, $form->{todate};
333 if ($form->{l_employee}) {
337 # prepare qty comparison for later filtering
338 my ($f_qty_op, $f_qty, $f_qty_base_unit);
339 if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
340 $f_qty_op = $filter{qty_op};
341 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
342 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
345 map { $_ = "(${_})"; } @filter_ary;
347 # if of a property number or description is requested,
348 # automatically check the matching id too.
349 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
351 # customize shown entry for not available fields.
352 $filter{na} = '-' unless $filter{na};
354 # make order, search in $filter and $form
355 my $sort_col = $form->{sort};
356 my $sort_order = $form->{order};
358 $sort_col = $filter{sort} unless $sort_col;
359 $sort_order = ($sort_col = 'itime') unless $sort_col;
360 $sort_col = 'itime' if $sort_col eq 'date';
361 $sort_order = $filter{order} unless $sort_order;
362 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
364 my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
366 $select_tokens{'trans'} = {
367 "parts_id" => "i1.parts_id",
368 "qty" => "ABS(SUM(i1.qty))",
369 "partnumber" => "p.partnumber",
370 "partdescription" => "p.description",
371 "bindescription" => "b.description",
372 "chargenumber" => "i1.chargenumber",
373 "bestbefore" => "i1.bestbefore",
374 "warehousedescription" => "w.description",
375 "partunit" => "p.unit",
376 "bin_from" => "b1.description",
377 "bin_to" => "b2.description",
378 "warehouse_from" => "w1.description",
379 "warehouse_to" => "w2.description",
380 "comment" => "i1.comment",
381 "trans_type" => "tt.description",
382 "trans_id" => "i1.trans_id",
383 "oe_id" => "COALESCE(i1.oe_id, i2.oe_id)",
384 "date" => "i1.itime::DATE",
385 "itime" => "i1.itime",
386 "employee" => "e.name",
387 "projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
390 $select_tokens{'out'} = {
391 "bin_to" => "'$filter{na}'",
392 "warehouse_to" => "'$filter{na}'",
395 $select_tokens{'in'} = {
396 "bin_from" => "'$filter{na}'",
397 "warehouse_from" => "'$filter{na}'",
400 # build the select clauses.
401 # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
402 for my $i ('trans', 'out', 'in') {
403 $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
404 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
407 my $group_clause = join ", ", map { +/^l_/; "r_$'" }
408 ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
410 $where_clause = defined($where_clause) ? $where_clause : '';
412 qq|SELECT DISTINCT $select{trans}
414 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
415 LEFT JOIN parts p ON i1.parts_id = p.id
416 LEFT JOIN bin b1 ON i1.bin_id = b1.id
417 LEFT JOIN bin b2 ON i2.bin_id = b2.id
418 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
419 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
420 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
421 LEFT JOIN project pr ON i1.project_id = pr.id
422 LEFT JOIN employee e ON i1.employee_id = e.id
423 WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
424 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
425 GROUP BY $group_clause
429 SELECT DISTINCT $select{out}
431 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
432 LEFT JOIN parts p ON i1.parts_id = p.id
433 LEFT JOIN bin b1 ON i1.bin_id = b1.id
434 LEFT JOIN bin b2 ON i2.bin_id = b2.id
435 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
436 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
437 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
438 LEFT JOIN project pr ON i1.project_id = pr.id
439 LEFT JOIN employee e ON i1.employee_id = e.id
440 WHERE $where_clause i1.qty < 0 AND
441 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
442 GROUP BY $group_clause
446 SELECT DISTINCT $select{in}
448 LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
449 LEFT JOIN parts p ON i1.parts_id = p.id
450 LEFT JOIN bin b1 ON i1.bin_id = b1.id
451 LEFT JOIN bin b2 ON i2.bin_id = b2.id
452 LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
453 LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
454 LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
455 LEFT JOIN project pr ON i1.project_id = pr.id
456 LEFT JOIN employee e ON i1.employee_id = e.id
457 WHERE $where_clause i1.qty > 0 AND
458 i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
459 GROUP BY $group_clause
460 ORDER BY r_${sort_spec}|;
462 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
464 my ($h_oe_id, $q_oe_id);
465 if ($form->{l_oe_id}) {
468 CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
470 WHEN oe.customer_id IS NOT NULL AND COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
471 WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
472 WHEN oe.customer_id IS NULL AND COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
473 ELSE 'purchase_order'
480 SELECT dord.id AS id, dord.donumber AS number,
482 WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
483 ELSE 'sales_delivery_order'
485 FROM delivery_orders dord
490 SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
496 SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
500 $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
504 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
505 map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
506 my $qty = $ref->{"qty"} * 1;
508 next unless ($qty > 0);
511 my $part_unit = $all_units->{$ref->{"partunit"}};
512 next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
513 $qty *= $part_unit->{"factor"};
514 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
515 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
516 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
519 if ($h_oe_id && $ref->{oe_id}) {
520 do_statement($form, $h_oe_id, $q_oe_id, ($ref->{oe_id}) x 4);
521 $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
524 push @contents, $ref;
528 $h_oe_id->finish() if $h_oe_id;
530 $main::lxdebug->leave_sub();
536 # This sub is the primary function to retrieve information about items in warehouses.
537 # $filter is a hashref and supports the following keys:
538 # - warehouse_id - will return matches with this warehouse_id only
539 # - partnumber - will return only matches where the given string is a substring of the partnumber
540 # - partsid - will return matches with this parts_id only
541 # - description - will return only matches where the given string is a substring of the description
542 # - chargenumber - will return only matches where the given string is a substring of the chargenumber
543 # - bestbefore - will return only matches with this bestbefore date
544 # - ean - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
545 # - charge_ids - must be an arrayref. will return contents with these ids only
546 # - expires_in - will only return matches that expire within the given number of days
547 # will also add a column named 'has_expired' containing if the match has already expired or not
548 # - hazardous - will return matches with the flag hazardous only
549 # - oil - will return matches with the flag oil only
550 # - qty, qty_op - quantity filter (more info to come)
551 # - sort, order_by - sorting (more to come)
552 # - reservation - will provide an extra column containing the amount reserved of this match
553 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
555 sub get_warehouse_report {
556 $main::lxdebug->enter_sub();
561 my $myconfig = \%main::myconfig;
562 my $form = $main::form;
564 my $all_units = AM->retrieve_units($myconfig, $form);
566 # connect to database
567 my $dbh = $form->get_standard_dbh($myconfig);
570 my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
572 delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
574 if ($filter{warehouse_id}) {
575 push @wh_bin_filter_ary, "w.id = ?";
576 push @wh_bin_filter_vars, $filter{warehouse_id};
579 if ($filter{bin_id}) {
580 push @wh_bin_filter_ary, "b.id = ?";
581 push @wh_bin_filter_vars, $filter{bin_id};
584 push @filter_ary, @wh_bin_filter_ary;
585 push @filter_vars, @wh_bin_filter_vars;
587 if ($filter{partnumber}) {
588 push @filter_ary, "p.partnumber ILIKE ?";
589 push @filter_vars, '%' . $filter{partnumber} . '%';
592 if ($filter{description}) {
593 push @filter_ary, "p.description ILIKE ?";
594 push @filter_vars, '%' . $filter{description} . '%';
597 if ($filter{partsid}) {
598 push @filter_ary, "p.id = ?";
599 push @filter_vars, $filter{partsid};
602 if ($filter{chargenumber}) {
603 push @filter_ary, "i.chargenumber ILIKE ?";
604 push @filter_vars, '%' . $filter{chargenumber} . '%';
607 if ($form->{bestbefore}) {
608 push @filter_ary, "?::DATE = i.bestbefore::DATE";
609 push @filter_vars, $form->{bestbefore};
613 push @filter_ary, "p.ean ILIKE ?";
614 push @filter_vars, '%' . $filter{ean} . '%';
617 # prepare qty comparison for later filtering
618 my ($f_qty_op, $f_qty, $f_qty_base_unit);
620 if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
621 $f_qty_op = $filter{qty_op};
622 $f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
623 $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
626 map { $_ = "(${_})"; } @filter_ary;
628 # if of a property number or description is requested,
629 # automatically check the matching id too.
630 map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
632 # make order, search in $filter and $form
633 my $sort_col = $form->{sort};
634 my $sort_order = $form->{order};
636 $sort_col = $filter{sort} unless $sort_col;
637 # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
638 # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
639 # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
640 # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
641 # S.a. Bug 1597 jb 12.5.2011
642 $sort_col = "parts_id" unless ($sort_col && $form->{"l_$sort_col"});
643 $sort_order = $filter{order} unless $sort_order;
644 $sort_col =~ s/ASC|DESC//; # kill stuff left in from previous queries
645 my $orderby = $sort_col;
646 my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
648 my $where_clause = join " AND ", ("1=1", @filter_ary);
650 my %select_tokens = (
651 "parts_id" => "i.parts_id",
652 "qty" => "SUM(i.qty)",
653 "warehouseid" => "i.warehouse_id",
654 "partnumber" => "p.partnumber",
655 "partdescription" => "p.description",
656 "bindescription" => "b.description",
658 "chargenumber" => "i.chargenumber",
659 "bestbefore" => "i.bestbefore",
661 "chargeid" => "c.id",
662 "warehousedescription" => "w.description",
663 "partunit" => "p.unit",
664 "stock_value" => "p.lastcost / COALESCE(pfac.factor, 1)",
666 my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
667 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
668 qw(l_parts_id l_qty l_partunit) );
670 my $group_clause = join ", ", map { +/^l_/; "$'" }
671 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
672 qw(l_parts_id l_partunit) );
675 "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
678 my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
679 ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
680 qw(l_parts_id l_qty l_partunit) );
683 qq|SELECT $select_clause
685 LEFT JOIN parts p ON i.parts_id = p.id
686 LEFT JOIN bin b ON i.bin_id = b.id
687 LEFT JOIN warehouse w ON i.warehouse_id = w.id
690 GROUP BY $group_clause
691 ORDER BY $sort_spec|;
693 my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
695 my (%non_empty_bins, @all_fields, @contents);
697 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
699 my $qty = $ref->{qty};
701 next unless ($qty != 0);
704 my $part_unit = $all_units->{$ref->{partunit}};
705 next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
706 $qty *= $part_unit->{factor};
707 next if (('=' eq $f_qty_op) && ($qty != $f_qty));
708 next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
709 next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
712 if ($form->{include_empty_bins}) {
713 $non_empty_bins{$ref->{binid}} = 1;
714 @all_fields = keys %{ $ref } unless (@all_fields);
717 $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
719 push @contents, $ref;
724 if ($form->{include_empty_bins}) {
727 w.id AS warehouseid, w.description AS warehousedescription,
728 b.id AS binid, b.description AS bindescription
730 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
732 @filter_ary = @wh_bin_filter_ary;
733 @filter_vars = @wh_bin_filter_vars;
735 my @non_empty_bin_ids = keys %non_empty_bins;
736 if (@non_empty_bin_ids) {
737 push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
738 push @filter_vars, @non_empty_bin_ids;
741 $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
743 $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
745 while (my $ref = $sth->fetchrow_hashref()) {
746 map { $ref->{$_} ||= "" } @all_fields;
747 push @contents, $ref;
751 if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
752 @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
756 $main::lxdebug->leave_sub();
762 $main::lxdebug->enter_sub();
764 my ($self, $qty_op) = @_;
766 if (!$qty_op || ($qty_op eq "dontcare")) {
767 $main::lxdebug->leave_sub();
771 if ($qty_op eq "atleast") {
773 } elsif ($qty_op eq "atmost") {
779 $main::lxdebug->leave_sub();
784 sub retrieve_transfer_types {
785 $main::lxdebug->enter_sub();
788 my $direction = shift;
790 my $myconfig = \%main::myconfig;
791 my $form = $main::form;
793 my $dbh = $form->get_standard_dbh($myconfig);
795 my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
797 $main::lxdebug->leave_sub();
802 sub get_basic_bin_info {
803 $main::lxdebug->enter_sub();
808 Common::check_params(\%params, qw(id));
810 my $myconfig = \%main::myconfig;
811 my $form = $main::form;
813 my $dbh = $params{dbh} || $form->get_standard_dbh();
815 my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
818 qq|SELECT b.id AS bin_id, b.description AS bin_description,
819 w.id AS warehouse_id, w.description AS warehouse_description
821 LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
822 WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
824 my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
826 if ('' eq ref $params{id}) {
827 $result = $result->[0] || { };
828 $main::lxdebug->leave_sub();
833 $main::lxdebug->leave_sub();
835 return map { $_->{bin_id} => $_ } @{ $result };
838 # Eingabe: Teilenummer, Lagernummer (warehouse)
839 # Ausgabe: Die maximale Anzahl der Teile in diesem Lager
841 sub get_max_qty_parts {
842 $main::lxdebug->enter_sub();
847 Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
849 my $myconfig = \%main::myconfig;
850 my $form = $main::form;
852 my $dbh = $params{dbh} || $form->get_standard_dbh();
854 my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
856 my $sth_QTY = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
858 my $max_qty_parts = 0; #Initialisierung mit 0
859 while (my $ref = $sth_QTY->fetchrow_hashref()) { # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
860 $max_qty_parts += $ref->{sum};
863 $main::lxdebug->leave_sub();
865 return $max_qty_parts;
869 # Eingabe: Teilenummer, Lagernummer (warehouse)
870 # Ausgabe: Die Beschreibung der Ware bzw. Erzeugnis
872 sub get_part_description {
873 $main::lxdebug->enter_sub();
878 Common::check_params(\%params, qw(parts_id)); #die brauchen wir
880 my $myconfig = \%main::myconfig;
881 my $form = $main::form;
883 my $dbh = $params{dbh} || $form->get_standard_dbh();
885 my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
887 my $sth = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
889 my $ref = $sth->fetchrow_hashref();
890 my $part_description = $ref->{partnumber} . " " . $ref->{description};
892 $main::lxdebug->leave_sub();
894 return $part_description;
904 SL::WH - Warehouse backend
909 WH->transfer(\%params);
913 Backend for lx-office warehousing functions.
917 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
919 This is the main function to manipulate warehouse contents. A typical transfer
925 transfer_type => 'transfer',
926 src_warehouse_id => 12,
928 dst_warehouse_id => 25,
932 It will generate an entry in inventory representing the transfer. Note that
933 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
934 a destination or a src is mandatory.
936 transfer accepts more than one transaction parameter, each being a hash ref. If
937 more than one is supplied, it is guaranteed, that all are processed in the same
940 Here is a full list of parameters. All "_id" parameters except oe and
941 orderitems can be called without id with RDB objects as well.
947 The id of the article transferred. Does not check if the article is a service.
952 Quantity of the transaction. Mandatory.
956 Unit of the transaction. Optional.
960 =item transfer_type_id
962 The type of transaction. The first version is a string describing the
963 transaction (the types 'transfer' 'in' 'out' and a few others are present on
964 every system), the id is the hard id of a transfer_type from the database.
966 Depending of the direction of the transfer_type, source and/or destination must
969 One of transfer_type or transfer_type_id is mandatory.
971 =item src_warehouse_id
975 Warehouse and bin from which to transfer. Mandatory in transfer and out
976 directions. Ignored in in directions.
978 =item dst_warehouse_id
982 Warehouse and bin to which to transfer. Mandatory in transfer and in
983 directions. Ignored in out directions.
987 If given, the transfer will transfer only articles with this chargenumber.
992 Reference to an orderitem for which this transfer happened. Optional
996 Reference to an order for which this transfer happened. Optional
1000 An optional comment.
1004 An expiration date. Note that this is not by default used by C<warehouse_report>.