Paginierung schneller machen für Lager(Paginierung repariert)
[kivitendo-erp.git] / SL / WH.pm
1 #====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 1999-2003
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #  Contributors:
16 #
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.
21 #
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., 51 Franklin Street, Fifth Floor, Boston,
29 # MA 02110-1335, USA.
30 #======================================================================
31 #
32 #  Warehouse module
33 #
34 #======================================================================
35
36 package WH;
37
38 use SL::AM;
39 use SL::DBUtils;
40 use SL::Form;
41 use SL::Util qw(trim);
42
43 use warnings;
44 use strict;
45
46 sub transfer {
47   $::lxdebug->enter_sub;
48
49   my ($self, @args) = @_;
50
51   if (!@args) {
52     $::lxdebug->leave_sub;
53     return;
54   }
55
56   require SL::DB::TransferType;
57   require SL::DB::Part;
58   require SL::DB::Employee;
59   require SL::DB::Inventory;
60
61   my $employee   = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
62   my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
63   my @directions = (undef, qw(out in transfer));
64
65   my $objectify = sub {
66     my ($transfer, $field, $class, @find_by) = @_;
67
68     @find_by = (description => $transfer->{$field}) unless @find_by;
69
70     if ($transfer->{$field} || $transfer->{"${field}_id"}) {
71       return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
72            : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
73            : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
74     }
75     return;
76   };
77
78   my @trans_ids;
79
80   my $db = SL::DB::Inventory->new->db;
81   $db->with_transaction(sub{
82     while (my $transfer = shift @args) {
83       my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
84
85       my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
86       my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
87       my $qty           = $transfer->{qty};
88       my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
89       my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
90       my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
91       my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
92       my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
93
94       $src_wh ||= $src_bin->warehouse if $src_bin;
95       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
96
97       my $direction = 0; # bit mask
98       $direction |= 1 if $src_bin;
99       $direction |= 2 if $dst_bin;
100
101       my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
102                                                                                            description => $transfer->{transfer_type});
103
104       my %params = (
105           part             => $part,
106           employee         => $employee,
107           trans_type       => $transfer_type,
108           project          => $project,
109           trans_id         => $trans_id,
110           shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
111                               ? $now : $transfer->{shippingdate},
112           map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
113       );
114
115       if ($unit) {
116         $qty = $unit->convert_to($qty, $part->unit_obj);
117       }
118
119       $params{chargenumber} ||= '';
120
121       if ($direction & 1) {
122         SL::DB::Inventory->new(
123           %params,
124           warehouse => $src_wh,
125           bin       => $src_bin,
126           qty       => $qty * -1,
127         )->save;
128       }
129
130       if ($direction & 2) {
131         SL::DB::Inventory->new(
132           %params,
133           warehouse => $dst_wh->id,
134           bin       => $dst_bin->id,
135           qty       => $qty,
136         )->save;
137         # Standardlagerplatz in Stammdaten gleich mitverschieben
138         if (defined($transfer->{change_default_bin})){
139           $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
140         }
141       }
142
143       push @trans_ids, $trans_id;
144     }
145
146     1;
147   }) or do {
148     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
149   };
150
151   $::lxdebug->leave_sub;
152
153   return @trans_ids;
154 }
155
156 sub transfer_assembly {
157   $main::lxdebug->enter_sub();
158
159   my $self     = shift;
160   my %params   = @_;
161   Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));
162
163 #  my $maxcreate=WH->check_assembly_max_create(assembly_id =>$params{'assembly_id'}, dbh => $my_dbh);
164
165   my $myconfig = \%main::myconfig;
166   my $form     = $main::form;
167   my $kannNichtFertigen ="";  # Falls leer dann erfolgreich
168
169   SL::DB->client->with_transaction(sub {
170     my $dbh      = $params{dbh} || SL::DB->client->dbh;
171
172     # Ablauferklärung
173     #
174     # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage
175     # select parts_id,qty from assembly where id=1064;
176     # Erweiterung für bug 935 am 23.4.09 -
177     # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.
178     # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
179     # where assembly.id=1066 and inventory_accno_id IS NOT NULL;
180     #
181     # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
182     # wenn assembly nicht überprüft wird ...
183     # patch von joachim eingespielt 24.4.2009:
184     # my $query    = qq|select parts_id,qty from assembly inner join parts
185     # on assembly.parts_id = parts.id  where assembly.id = ? and
186     # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;
187
188     # Lager in dem die Bestandteile gesucht werden kann entweder das Ziellager sein oder ist per Mandantenkonfig
189     # auf das Standardlager des Bestandteiles schaltbar
190
191     my $use_default_warehouse = $::instance_conf->get_transfer_default_warehouse_for_assembly;
192
193     my $query = qq|SELECT assembly.parts_id, assembly.qty, parts.warehouse_id
194                    FROM assembly INNER JOIN parts ON assembly.parts_id = parts.id
195                    WHERE assembly.id = ? AND parts.part_type != 'service'|;
196
197     my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
198
199     # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet
200     my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,
201                              trans_id, trans_type_id, shippingdate)
202                              VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
203                              (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),
204                              (SELECT current_date))|;
205     my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);
206
207     # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen
208
209     my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan
210     while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly
211       $schleife_durchlaufen=1;  # Erzeugnis definiert
212
213       my $partsQTY          = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse
214       my $currentPart_ID    = $hash_ref->{parts_id};
215
216       my $currentPart_WH_ID = $use_default_warehouse && $hash_ref->{warehouse_id} ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};
217       my $no_check = 0;
218
219       # Prüfen ob Erzeugnis-Teile Standardlager haben.
220       if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {
221         # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.
222         if ($::instance_conf->get_transfer_default_ignore_onhand) {
223           $currentPart_WH_ID = $::instance_conf->get_warehouse_id_ignore_onhand;
224           $no_check = 1;
225         } else {
226           $kannNichtFertigen .= "Kein Standardlager: " .
227                               " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .
228                               " hat kein Standardlager definiert " .
229                               ", um das Erzeugnis herzustellen. <br>";
230           next;
231         }
232       }
233       my $warehouse_info    = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);
234       my $warehouse_desc    = $warehouse_info->{"warehouse_description"};
235
236       # Fertigen ohne Prüfung nach Bestand
237       if ($no_check) {
238         my $temppart_bin_id       = $::instance_conf->get_bin_id_ignore_onhand;
239         my $temppart_chargenumber = "";
240         my $temppart_bestbefore   = localtime();
241         my $temppart_qty          = $partsQTY * -1;
242
243         do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
244                        $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
245                        $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
246         next;
247       }
248       # Überprüfen, ob diese Anzahl gefertigt werden kann
249       my $max_parts = $self->get_max_qty_parts(parts_id     => $currentPart_ID, # $self->method() == this.method()
250                                                warehouse_id => $currentPart_WH_ID);
251
252       if ($partsQTY  > $max_parts){
253         # Gibt es hier ein Problem mit nicht "escapten" Zeichen?
254         # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird
255
256         $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .
257                               " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .
258                               " im Lager: " . $warehouse_desc .
259                               ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen
260         next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)
261       }
262
263       # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen
264       # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet
265       # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.
266       # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt
267       # und lösen den Rest dann so wie bei xplace im Barcode-Programm
268       # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich
269
270       my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory
271                          WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;
272       my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);
273
274       # Alle Werte zu dem einzelnen Artikel, die wir später auslagern
275       my $tmpPartsQTY = $partsQTY;
276
277       while (my $temphash_ref = $tempsth->fetchrow_hashref()) {
278         my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?
279         my $temppart_chargenumber = $temphash_ref->{chargenumber};
280         my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});
281         my $temppart_qty          = $temphash_ref->{sum};
282
283         if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.
284                                              # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter
285           $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;
286           $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
287                                               # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
288                                               # Dieser Wert IST und BLEIBT positiv!! Hilfe.
289                                               # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?
290           do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
291                        $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
292                        $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
293
294           # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb
295           # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen
296           # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam
297           # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg
298         } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören
299           $tmpPartsQTY *=-1;
300           do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,
301                        $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .
302                        $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY);
303           last; # beendet die schleife (springt zum letzten element)
304         }
305       }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id
306     } #ende while select parts_id,qty from assembly where id = ?
307
308     if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch
309                                     # keine einzelteile definiert
310         $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.
311                              Dementsprechend kann auch nichts hergestellt werden";
312    }
313     # gibt die Fehlermeldung zurück. A.) Keine Teile definiert
314     #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen
315     if ($kannNichtFertigen) {
316       return 0;
317     }
318
319     # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...
320     my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,
321                                                         comment, employee_id, qty, trans_id, trans_type_id, shippingdate)
322                                  VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
323                                  (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),
324                                  (select current_date))|;
325     my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);
326     do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
327                  $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
328     1;
329   }) or do { return $kannNichtFertigen };
330
331   $main::lxdebug->leave_sub();
332   return 1; # Alles erfolgreich
333 }
334
335 sub get_warehouse_journal {
336   $main::lxdebug->enter_sub();
337
338   my $self      = shift;
339   my %filter    = @_;
340
341   my $myconfig  = \%main::myconfig;
342   my $form      = $main::form;
343
344   my $all_units = AM->retrieve_units($myconfig, $form);
345
346   # connect to database
347   my $dbh = $form->get_standard_dbh($myconfig);
348
349   # filters
350   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
351
352   if ($filter{warehouse_id}) {
353     push @filter_ary, "w1.id = ? OR w2.id = ?";
354     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
355   }
356
357   if ($filter{bin_id}) {
358     push @filter_ary, "b1.id = ? OR b2.id = ?";
359     push @filter_vars, $filter{bin_id}, $filter{bin_id};
360   }
361
362   if ($filter{partnumber}) {
363     push @filter_ary, "p.partnumber ILIKE ?";
364     push @filter_vars, like($filter{partnumber});
365   }
366
367   if ($filter{description}) {
368     push @filter_ary, "(p.description ILIKE ?)";
369     push @filter_vars, like($filter{description});
370   }
371
372   if ($filter{classification_id}) {
373     push @filter_ary, "p.classification_id = ?";
374     push @filter_vars, $filter{classification_id};
375   }
376
377   if ($filter{chargenumber}) {
378     push @filter_ary, "i1.chargenumber ILIKE ?";
379     push @filter_vars, like($filter{chargenumber});
380   }
381
382   if (trim($form->{bestbefore})) {
383     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
384     push @filter_vars, trim($form->{bestbefore});
385   }
386
387   if (trim($form->{fromdate})) {
388     push @filter_ary, "? <= i1.shippingdate";
389     push @filter_vars, trim($form->{fromdate});
390   }
391
392   if (trim($form->{todate})) {
393     push @filter_ary, "? >= i1.shippingdate";
394     push @filter_vars, trim($form->{todate});
395   }
396
397   if ($form->{l_employee}) {
398     $joins .= "";
399   }
400
401   # prepare qty comparison for later filtering
402   my ($f_qty_op, $f_qty, $f_qty_base_unit);
403   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
404     $f_qty_op        = $filter{qty_op};
405     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
406     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
407   }
408
409   map { $_ = "(${_})"; } @filter_ary;
410
411   # if of a property number or description is requested,
412   # automatically check the matching id too.
413   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
414
415   # customize shown entry for not available fields.
416   $filter{na} = '-' unless $filter{na};
417
418   # make order, search in $filter and $form
419   my $sort_col   = $form->{sort};
420   my $sort_order = $form->{order};
421
422   $sort_col      = $filter{sort}         unless $sort_col;
423   $sort_col      = 'shippingdate'        if     $sort_col eq 'date';
424   $sort_order    = ($sort_col = 'shippingdate') unless $sort_col;
425
426   my %orderspecs = (
427     'shippingdate'   => ['shippingdate', 'r_itime', 'r_parts_id'],
428     'bin_to'         => ['bin_to', 'r_itime', 'r_parts_id'],
429     'bin_from'       => ['bin_from', 'r_itime', 'r_parts_id'],
430     'warehouse_to'   => ['warehouse_to, r_itime, r_parts_id'],
431     'warehouse_from' => ['warehouse_from, r_itime, r_parts_id'],
432     'partnumber'     => ['partnumber'],
433     'partdescription'=> ['partdescription'],
434     'partunit'       => ['partunit, r_itime, r_parts_id'],
435     'qty'            => ['qty, r_itime, r_parts_id'],
436     'oe_id'          => ['oe_id'],
437     'comment'        => ['comment'],
438     'trans_type'     => ['trans_type'],
439     'employee'       => ['employee'],
440     'projectnumber'  => ['projectnumber'],
441   );
442
443   $sort_order    = $filter{order}  unless $sort_order;
444   my $ASC = ($sort_order ? " DESC" : " ASC");
445   my $sort_spec  = join("$ASC , ", @{$orderspecs{$sort_col}}). " $ASC";
446
447   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
448
449   $select_tokens{'trans'} = {
450      "parts_id"             => "i1.parts_id",
451      "qty"                  => "ABS(SUM(i1.qty))",
452      "partnumber"           => "p.partnumber",
453      "partdescription"      => "p.description",
454      "classification_id"    => "p.classification_id",
455      "part_type"            => "p.part_type",
456      "bindescription"       => "b.description",
457      "chargenumber"         => "i1.chargenumber",
458      "bestbefore"           => "i1.bestbefore",
459      "warehousedescription" => "w.description",
460      "partunit"             => "p.unit",
461      "bin_from"             => "b1.description",
462      "bin_to"               => "b2.description",
463      "warehouse_from"       => "w1.description",
464      "warehouse_to"         => "w2.description",
465      "comment"              => "i1.comment",
466      "trans_type"           => "tt.description",
467      "trans_id"             => "i1.trans_id",
468      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
469      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
470      "date"                 => "i1.shippingdate",
471      "itime"                => "i1.itime",
472      "shippingdate"         => "i1.shippingdate",
473      "employee"             => "e.name",
474      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
475      };
476
477   $select_tokens{'out'} = {
478      "bin_to"               => "'$filter{na}'",
479      "warehouse_to"         => "'$filter{na}'",
480      };
481
482   $select_tokens{'in'} = {
483      "bin_from"             => "'$filter{na}'",
484      "warehouse_from"       => "'$filter{na}'",
485      };
486
487   $form->{l_classification_id}  = 'Y';
488   $form->{l_part_type}          = 'Y';
489   $form->{l_itime}              = 'Y';
490   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
491
492   # build the select clauses.
493   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
494   for my $i ('trans', 'out', 'in') {
495     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
496           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
497   }
498
499   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
500         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate l_itime) );
501
502   $where_clause = defined($where_clause) ? $where_clause : '';
503
504   my $query =
505   qq|SELECT * FROM (SELECT DISTINCT $select{trans}
506     FROM inventory i1
507     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
508     LEFT JOIN parts p ON i1.parts_id = p.id
509     LEFT JOIN bin b1 ON i1.bin_id = b1.id
510     LEFT JOIN bin b2 ON i2.bin_id = b2.id
511     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
512     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
513     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
514     LEFT JOIN project pr ON i1.project_id = pr.id
515     LEFT JOIN employee e ON i1.employee_id = e.id
516     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
517           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
518     GROUP BY $group_clause
519
520     UNION
521
522     SELECT DISTINCT $select{out}
523     FROM inventory i1
524     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
525     LEFT JOIN parts p ON i1.parts_id = p.id
526     LEFT JOIN bin b1 ON i1.bin_id = b1.id
527     LEFT JOIN bin b2 ON i2.bin_id = b2.id
528     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
529     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
530     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
531     LEFT JOIN project pr ON i1.project_id = pr.id
532     LEFT JOIN employee e ON i1.employee_id = e.id
533     WHERE $where_clause i1.qty < 0 AND
534           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
535     GROUP BY $group_clause
536
537     UNION
538
539     SELECT DISTINCT $select{in}
540     FROM inventory i1
541     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
542     LEFT JOIN parts p ON i1.parts_id = p.id
543     LEFT JOIN bin b1 ON i1.bin_id = b1.id
544     LEFT JOIN bin b2 ON i2.bin_id = b2.id
545     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
546     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
547     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
548     LEFT JOIN project pr ON i1.project_id = pr.id
549     LEFT JOIN employee e ON i1.employee_id = e.id
550     WHERE $where_clause i1.qty > 0 AND
551           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
552     GROUP BY $group_clause
553     ORDER BY r_${sort_spec}) AS lines WHERE r_qty>0|;
554
555   $query .= " LIMIT $filter{limit}"    if $filter{limit} ;
556   $query .= " OFFSET $filter{offset}"  if $filter{offset} ;
557
558   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
559
560   my ($h_oe_id, $q_oe_id);
561   if ($form->{l_oe_id}) {
562     $q_oe_id = <<SQL;
563       SELECT oe.id AS id,
564         CASE WHEN oe.quotation THEN oe.quonumber ELSE oe.ordnumber END AS number,
565         CASE
566           WHEN oe.customer_id IS NOT NULL AND     COALESCE(oe.quotation, FALSE) THEN 'sales_quotation'
567           WHEN oe.customer_id IS NOT NULL AND NOT COALESCE(oe.quotation, FALSE) THEN 'sales_order'
568           WHEN oe.customer_id IS     NULL AND     COALESCE(oe.quotation, FALSE) THEN 'request_quotation'
569           ELSE                                                                       'purchase_order'
570         END AS type
571       FROM oe
572       WHERE oe.id = ?
573
574       UNION
575
576       SELECT dord.id AS id, dord.donumber AS number,
577         CASE
578           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
579           ELSE                               'sales_delivery_order'
580         END AS type
581       FROM delivery_orders dord
582       WHERE dord.id = ?
583
584       UNION
585
586       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
587       FROM ar
588       WHERE ar.id = ?
589
590       UNION
591
592       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
593       FROM ap
594       WHERE ap.id = ?
595
596       UNION
597
598       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
599       FROM ar
600       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
601
602       UNION
603
604       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
605       FROM ap
606       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
607 SQL
608     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
609   }
610
611   my @contents = ();
612   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
613     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
614     my $qty = $ref->{"qty"} * 1;
615
616     next unless ($qty > 0);
617
618     if ($f_qty_op) {
619       my $part_unit = $all_units->{$ref->{"partunit"}};
620       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
621       $qty *= $part_unit->{"factor"};
622       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
623       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
624       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
625     }
626
627     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
628       my $id = $ref->{oe_id} ? $ref->{oe_id} : $ref->{invoice_id};
629       do_statement($form, $h_oe_id, $q_oe_id, ($id) x 6);
630       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
631     }
632
633     push @contents, $ref;
634   }
635
636   $sth->finish();
637   $h_oe_id->finish() if $h_oe_id;
638
639   $main::lxdebug->leave_sub();
640
641   return @contents;
642 }
643
644 #
645 # This sub is the primary function to retrieve information about items in warehouses.
646 # $filter is a hashref and supports the following keys:
647 #  - warehouse_id - will return matches with this warehouse_id only
648 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
649 #  - partsid      - will return matches with this parts_id only
650 #  - classification_id - will return matches with this parts with this classification only
651 #  - description  - will return only matches where the given string is a substring of the description
652 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
653 #  - bestbefore   - will return only matches with this bestbefore date
654 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
655 #  - charge_ids   - must be an arrayref. will return contents with these ids only
656 #  - expires_in   - will only return matches that expire within the given number of days
657 #                   will also add a column named 'has_expired' containing if the match has already expired or not
658 #  - hazardous    - will return matches with the flag hazardous only
659 #  - oil          - will return matches with the flag oil only
660 #  - qty, qty_op  - quantity filter (more info to come)
661 #  - sort, order_by - sorting (more to come)
662 #  - reservation  - will provide an extra column containing the amount reserved of this match
663 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
664 #
665 sub get_warehouse_report {
666   $main::lxdebug->enter_sub();
667
668   my $self      = shift;
669   my %filter    = @_;
670
671   my $myconfig  = \%main::myconfig;
672   my $form      = $main::form;
673
674   my $all_units = AM->retrieve_units($myconfig, $form);
675
676   # connect to database
677   my $dbh = $form->get_standard_dbh($myconfig);
678
679   # filters
680   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
681
682   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
683
684   if ($filter{warehouse_id}) {
685     push @wh_bin_filter_ary,  "w.id = ?";
686     push @wh_bin_filter_vars, $filter{warehouse_id};
687   }
688
689   if ($filter{bin_id}) {
690     push @wh_bin_filter_ary,  "b.id = ?";
691     push @wh_bin_filter_vars, $filter{bin_id};
692   }
693
694   push @filter_ary,  @wh_bin_filter_ary;
695   push @filter_vars, @wh_bin_filter_vars;
696
697   if ($filter{partnumber}) {
698     push @filter_ary,  "p.partnumber ILIKE ?";
699     push @filter_vars, like($filter{partnumber});
700   }
701
702   if ($filter{classification_id}) {
703     push @filter_ary, "p.classification_id = ?";
704     push @filter_vars, $filter{classification_id};
705   }
706
707   if ($filter{description}) {
708     push @filter_ary,  "p.description ILIKE ?";
709     push @filter_vars, like($filter{description});
710   }
711
712   if ($filter{partsid}) {
713     push @filter_ary,  "p.id = ?";
714     push @filter_vars, $filter{partsid};
715   }
716
717   if ($filter{chargenumber}) {
718     push @filter_ary,  "i.chargenumber ILIKE ?";
719     push @filter_vars, like($filter{chargenumber});
720   }
721
722   if (trim($form->{bestbefore})) {
723     push @filter_ary, "?::DATE = i.bestbefore::DATE";
724     push @filter_vars, trim($form->{bestbefore});
725   }
726
727   if ($filter{classification_id}) {
728     push @filter_ary, "p.classification_id = ?";
729     push @filter_vars, $filter{classification_id};
730   }
731
732   if ($filter{ean}) {
733     push @filter_ary,  "p.ean ILIKE ?";
734     push @filter_vars, like($filter{ean});
735   }
736
737   if (trim($filter{date})) {
738     push @filter_ary, "i.shippingdate <= ?";
739     push @filter_vars, trim($filter{date});
740   }
741   if (!$filter{include_invalid_warehouses}){
742     push @filter_ary,  "NOT (w.invalid)";
743   }
744
745   # prepare qty comparison for later filtering
746   my ($f_qty_op, $f_qty, $f_qty_base_unit);
747
748   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
749     $f_qty_op        = $filter{qty_op};
750     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
751     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
752   }
753
754   map { $_ = "(${_})"; } @filter_ary;
755
756   # if of a property number or description is requested,
757   # automatically check the matching id too.
758   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
759
760   # make order, search in $filter and $form
761   my $sort_col    =  $form->{sort};
762   my $sort_order  = $form->{order};
763
764   $sort_col       =  $filter{sort}  unless $sort_col;
765   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
766   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
767   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
768   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
769   # S.a. Bug 1597 jb 12.5.2011
770   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
771   $sort_order     =  $filter{order} unless $sort_order;
772   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
773   my $orderby     =  $sort_col;
774   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
775
776   my $where_clause = join " AND ", ("1=1", @filter_ary);
777
778   my %select_tokens = (
779      "parts_id"              => "i.parts_id",
780      "qty"                  => "SUM(i.qty)",
781      "warehouseid"          => "i.warehouse_id",
782      "partnumber"           => "p.partnumber",
783      "partdescription"      => "p.description",
784      "classification_id"    => "p.classification_id",
785      "part_type"            => "p.part_type",
786      "bindescription"       => "b.description",
787      "binid"                => "b.id",
788      "chargenumber"         => "i.chargenumber",
789      "bestbefore"           => "i.bestbefore",
790      "ean"                  => "p.ean",
791      "chargeid"             => "c.id",
792      "warehousedescription" => "w.description",
793      "partunit"             => "p.unit",
794      "stock_value"          => "p.lastcost / COALESCE(pfac.factor, 1)",
795      "purchase_price"       => "p.lastcost",
796   );
797   $form->{l_classification_id}  = 'Y';
798   $form->{l_part_type}          = 'Y';
799
800   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
801         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
802           qw(l_parts_id l_qty l_partunit) );
803
804   my $group_clause = join ", ", map { +/^l_/; "$'" }
805         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
806           qw(l_parts_id l_partunit) );
807
808   my %join_tokens = (
809     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
810     );
811
812   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
813         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
814           qw(l_parts_id l_qty l_partunit) );
815
816   my $query =
817     qq|SELECT * FROM ( SELECT $select_clause
818       FROM inventory i
819       LEFT JOIN parts     p ON i.parts_id     = p.id
820       LEFT JOIN bin       b ON i.bin_id       = b.id
821       LEFT JOIN warehouse w ON i.warehouse_id = w.id
822       $joins
823       WHERE $where_clause
824       GROUP BY $group_clause
825       ORDER BY $sort_spec ) AS lines WHERE qty<>0|;
826
827   $query .= " LIMIT $filter{limit}"    if $filter{limit} ;
828   $query .= " OFFSET $filter{offset}"  if $filter{offset} ;
829
830   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
831
832   my (%non_empty_bins, @all_fields, @contents);
833
834   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
835     $ref->{qty} *= 1;
836     my $qty      = $ref->{qty};
837
838     next unless ($qty != 0);
839
840     if ($f_qty_op) {
841       my $part_unit = $all_units->{$ref->{partunit}};
842       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
843       $qty *= $part_unit->{factor};
844       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
845       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
846       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
847     }
848
849     if ($form->{include_empty_bins}) {
850       $non_empty_bins{$ref->{binid}} = 1;
851       @all_fields                    = keys %{ $ref } unless (@all_fields);
852     }
853
854     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
855
856     push @contents, $ref;
857   }
858
859   $sth->finish();
860
861   if ($form->{include_empty_bins}) {
862     $query =
863       qq|SELECT
864            w.id AS warehouseid, w.description AS warehousedescription,
865            b.id AS binid, b.description AS bindescription
866          FROM bin b
867          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
868
869     @filter_ary  = @wh_bin_filter_ary;
870     @filter_vars = @wh_bin_filter_vars;
871
872     my @non_empty_bin_ids = keys %non_empty_bins;
873     if (@non_empty_bin_ids) {
874       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
875       push @filter_vars, @non_empty_bin_ids;
876     }
877
878     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
879
880     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
881
882     while (my $ref = $sth->fetchrow_hashref()) {
883       map { $ref->{$_} ||= "" } @all_fields;
884       push @contents, $ref;
885     }
886     $sth->finish();
887
888     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
889       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
890     }
891   }
892
893   $main::lxdebug->leave_sub();
894
895   return @contents;
896 }
897
898 sub convert_qty_op {
899   $main::lxdebug->enter_sub();
900
901   my ($self, $qty_op) = @_;
902
903   if (!$qty_op || ($qty_op eq "dontcare")) {
904     $main::lxdebug->leave_sub();
905     return undef;
906   }
907
908   if ($qty_op eq "atleast") {
909     $qty_op = '>=';
910   } elsif ($qty_op eq "atmost") {
911     $qty_op = '<=';
912   } else {
913     $qty_op = '=';
914   }
915
916   $main::lxdebug->leave_sub();
917
918   return $qty_op;
919 }
920
921 sub retrieve_transfer_types {
922   $main::lxdebug->enter_sub();
923
924   my $self      = shift;
925   my $direction = shift;
926
927   my $myconfig  = \%main::myconfig;
928   my $form      = $main::form;
929
930   my $dbh       = $form->get_standard_dbh($myconfig);
931
932   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
933
934   $main::lxdebug->leave_sub();
935
936   return $types;
937 }
938
939 sub get_basic_bin_info {
940   $main::lxdebug->enter_sub();
941
942   my $self     = shift;
943   my %params   = @_;
944
945   Common::check_params(\%params, qw(id));
946
947   my $myconfig = \%main::myconfig;
948   my $form     = $main::form;
949
950   my $dbh      = $params{dbh} || $form->get_standard_dbh();
951
952   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
953
954   my $query    =
955     qq|SELECT b.id AS bin_id, b.description AS bin_description,
956          w.id AS warehouse_id, w.description AS warehouse_description
957        FROM bin b
958        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
959        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
960
961   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
962
963   if ('' eq ref $params{id}) {
964     $result = $result->[0] || { };
965     $main::lxdebug->leave_sub();
966
967     return $result;
968   }
969
970   $main::lxdebug->leave_sub();
971
972   return map { $_->{bin_id} => $_ } @{ $result };
973 }
974
975 sub get_basic_warehouse_info {
976   $main::lxdebug->enter_sub();
977
978   my $self     = shift;
979   my %params   = @_;
980
981   Common::check_params(\%params, qw(id));
982
983   my $myconfig = \%main::myconfig;
984   my $form     = $main::form;
985
986   my $dbh      = $params{dbh} || $form->get_standard_dbh();
987
988   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
989
990   my $query    =
991     qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
992        FROM warehouse w
993        WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
994
995   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
996
997   if ('' eq ref $params{id}) {
998     $result = $result->[0] || { };
999     $main::lxdebug->leave_sub();
1000
1001     return $result;
1002   }
1003
1004   $main::lxdebug->leave_sub();
1005
1006   return map { $_->{warehouse_id} => $_ } @{ $result };
1007 }
1008 #
1009 # Eingabe:  Teilenummer, Lagernummer (warehouse)
1010 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
1011 #
1012 sub get_max_qty_parts {
1013 $main::lxdebug->enter_sub();
1014
1015   my $self     = shift;
1016   my %params   = @_;
1017
1018   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
1019
1020   my $myconfig = \%main::myconfig;
1021   my $form     = $main::form;
1022
1023   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1024
1025   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
1026   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
1027
1028
1029   my $max_qty_parts = 0; #Initialisierung mit 0
1030   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
1031     $max_qty_parts += $ref->{sum};
1032   }
1033
1034   $main::lxdebug->leave_sub();
1035
1036   return $max_qty_parts;
1037 }
1038
1039 #
1040 # Eingabe:  Teilenummer, Lagernummer (warehouse)
1041 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
1042 #
1043 sub get_part_description {
1044 $main::lxdebug->enter_sub();
1045
1046   my $self     = shift;
1047   my %params   = @_;
1048
1049   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
1050
1051   my $myconfig = \%main::myconfig;
1052   my $form     = $main::form;
1053
1054   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1055
1056   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
1057
1058   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
1059
1060   my $ref = $sth->fetchrow_hashref();
1061   my $part_description = $ref->{partnumber} . " " . $ref->{description};
1062
1063   $main::lxdebug->leave_sub();
1064
1065   return $part_description;
1066 }
1067 #
1068 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
1069 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
1070 #           Bzw. Fehler, falls Chargen oder bestbefore
1071 #           bei eingelagerten Teilen definiert sind.
1072 #
1073 sub get_max_qty_parts_bin {
1074 $main::lxdebug->enter_sub();
1075
1076   my $self     = shift;
1077   my %params   = @_;
1078
1079   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
1080
1081   my $myconfig = \%main::myconfig;
1082   my $form     = $main::form;
1083
1084   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1085
1086   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
1087                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1088
1089   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1090
1091   my $max_qty_parts = 0; #Initialisierung mit 0
1092   # falls derselbe artikel mehrmals eingelagert ist
1093   # chargennummer, muss entsprechend händisch agiert werden
1094   my $i = 0;
1095   my $error;
1096   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1097     $max_qty_parts += $ref->{sum};
1098     $i++;
1099     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1100       $error = 1;
1101     }
1102   }
1103   $main::lxdebug->leave_sub();
1104
1105   return ($max_qty_parts, $error);
1106 }
1107
1108 1;
1109
1110 __END__
1111
1112 =head1 NAME
1113
1114 SL::WH - Warehouse backend
1115
1116 =head1 SYNOPSIS
1117
1118   use SL::WH;
1119   WH->transfer(\%params);
1120
1121 =head1 DESCRIPTION
1122
1123 Backend for kivitendo warehousing functions.
1124
1125 =head1 FUNCTIONS
1126
1127 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1128
1129 This is the main function to manipulate warehouse contents. A typical transfer
1130 is called like this:
1131
1132   WH->transfer->({
1133     parts_id         => 6342,
1134     qty              => 12.45,
1135     transfer_type    => 'transfer',
1136     src_warehouse_id => 12,
1137     src_bin_id       => 23,
1138     dst_warehouse_id => 25,
1139     dst_bin_id       => 167,
1140   });
1141
1142 It will generate an entry in inventory representing the transfer. Note that
1143 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1144 a destination or a src is mandatory.
1145
1146 transfer accepts more than one transaction parameter, each being a hash ref. If
1147 more than one is supplied, it is guaranteed, that all are processed in the same
1148 transaction.
1149
1150 Here is a full list of parameters. All "_id" parameters except oe and
1151 orderitems can be called without id with RDB objects as well.
1152
1153 =over 4
1154
1155 =item parts_id
1156
1157 The id of the article transferred. Does not check if the article is a service.
1158 Mandatory.
1159
1160 =item qty
1161
1162 Quantity of the transaction.  Mandatory.
1163
1164 =item unit
1165
1166 Unit of the transaction. Optional.
1167
1168 =item transfer_type
1169
1170 =item transfer_type_id
1171
1172 The type of transaction. The first version is a string describing the
1173 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1174 every system), the id is the hard id of a transfer_type from the database.
1175
1176 Depending of the direction of the transfer_type, source and/or destination must
1177 be specified.
1178
1179 One of transfer_type or transfer_type_id is mandatory.
1180
1181 =item src_warehouse_id
1182
1183 =item src_bin_id
1184
1185 Warehouse and bin from which to transfer. Mandatory in transfer and out
1186 directions. Ignored in in directions.
1187
1188 =item dst_warehouse_id
1189
1190 =item dst_bin_id
1191
1192 Warehouse and bin to which to transfer. Mandatory in transfer and in
1193 directions. Ignored in out directions.
1194
1195 =item chargenumber
1196
1197 If given, the transfer will transfer only articles with this chargenumber.
1198 Optional.
1199
1200 =item orderitem_id
1201
1202 Reference to an orderitem for which this transfer happened. Optional
1203
1204 =item oe_id
1205
1206 Reference to an order for which this transfer happened. Optional
1207
1208 =item comment
1209
1210 An optional comment.
1211
1212 =item best_before
1213
1214 An expiration date. Note that this is not by default used by C<warehouse_report>.
1215
1216 =back
1217
1218 =head2 create_assembly \%PARAMS, [ \%PARAMS, ... ]
1219
1220 Creates an assembly if all defined items are available.
1221
1222 Assembly item(s) will be stocked out and the assembly will be stocked in,
1223 taking into account the qty and units which can be defined for each
1224 assembly item separately.
1225
1226 The calling params originate from C<transfer> but only parts_id with the
1227 attribute assembly are processed.
1228
1229 The typical params would be:
1230
1231   my %TRANSFER = (
1232     'login'            => $::myconfig{login},
1233     'dst_warehouse_id' => $form->{warehouse_id},
1234     'dst_bin_id'       => $form->{bin_id},
1235     'chargenumber'     => $form->{chargenumber},
1236     'bestbefore'       => $form->{bestbefore},
1237     'assembly_id'      => $form->{parts_id},
1238     'qty'              => $form->{qty},
1239     'comment'          => $form->{comment}
1240   );
1241
1242 =head3 Prerequisites
1243
1244 All of these prerequisites have to be trueish, otherwise the function will exit
1245 unsuccessfully with a return value of undef.
1246
1247 =over 4
1248
1249 =item Mandantory params
1250
1251   assembly_id, qty, login, dst_warehouse_id and dst_bin_id are mandatory.
1252
1253 =item Subset named 'Assembly' of data set 'Part'
1254
1255   assembly_id has to be an id in the table parts with the valid subset assembly.
1256
1257 =item Assembly is composed of assembly item(s)
1258
1259   There has to be at least one data set in the table assembly referenced to this assembly_id.
1260
1261 =item Assembly cannot be destroyed or disassembled
1262
1263   Assemblies are like cakes. You cannot disassemble it. NEVER.
1264   No negative nor zero qty's are valid inputs.
1265
1266 =item The assembly item(s) have to be in the same warehouse
1267
1268   inventory.warehouse_id equals dst_warehouse_id (client configurable).
1269
1270 =item The assembly item(s) have to be in stock with the qty needed
1271
1272   I can only make a cake by receipt if I have ALL ingredients and
1273   in the needed stock amount.
1274   The qty of stocked in assembly item(s) has to fit into the
1275   number of the qty of the assemblies, which are going to be created (client configurable).
1276
1277 =item assembly item(s) with the parts set 'service' are ignored
1278
1279   The subset 'Services' of part will not transferred for assembly item(s).
1280
1281 =back
1282
1283 Client configurable prerequisites can be changed with different
1284 prerequisites as described in client_config (s.a. next chapter).
1285
1286
1287 =head2 default creation of assembly
1288
1289 The valid state of the assembly item(s) used for the assembly process are
1290 'out' for the general direction and 'used' as the specific reason.
1291 The valid state of the assembly is 'in' for the direction and 'assembled'
1292 as the specific reason.
1293
1294 The method is transaction safe, in case of errors not a single entry will be made
1295 in inventory.
1296
1297 Two prerequisites can be changed with this global parameters
1298
1299 =over 2
1300
1301 =item  $::instance_conf->get_transfer_default_warehouse_for_assembly
1302
1303   If trueish we try to get all the items form the default bins defined in parts
1304   and do not try to find them in the destination warehouse. Returns an
1305   error if not all items have set a default bin in parts.
1306
1307 =item  $::instance_conf->get_bin_id_ignore_onhand
1308
1309   If trueish we can create assemblies even if we do not have enough items in stock.
1310   The needed qty will be booked in a special bin, which has to be configured in
1311   the client config.
1312
1313 =back
1314
1315
1316
1317
1318 =head1 BUGS
1319
1320 None yet.
1321
1322 =head1 AUTHOR
1323
1324 =cut
1325
1326 1;