epic-s6ts
[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 Carp qw(croak);
39
40 use SL::AM;
41 use SL::DBUtils;
42 use SL::DB::Inventory;
43 use SL::Form;
44 use SL::Locale::String qw(t8);
45 use SL::Util qw(trim);
46
47 use warnings;
48 use strict;
49
50 sub transfer {
51   $::lxdebug->enter_sub;
52
53   my ($self, @args) = @_;
54
55   if (!@args) {
56     $::lxdebug->leave_sub;
57     return;
58   }
59
60   require SL::DB::TransferType;
61   require SL::DB::Part;
62   require SL::DB::Employee;
63
64   my $employee   = SL::DB::Manager::Employee->current;
65   my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
66   my @directions = (undef, qw(out in transfer));
67
68   my $objectify = sub {
69     my ($transfer, $field, $class, @find_by) = @_;
70
71     @find_by = (description => $transfer->{$field}) unless @find_by;
72
73     if ($transfer->{$field} || $transfer->{"${field}_id"}) {
74       return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
75            : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
76            : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
77     }
78     return;
79   };
80
81   my @trans_ids;
82
83   my $db = SL::DB::Inventory->new->db;
84   $db->with_transaction(sub{
85     while (my $transfer = shift @args) {
86       my $trans_id;
87       ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|) if $transfer->{qty};
88
89       my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
90       my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         name => $transfer->{unit});
91       my $qty           = $transfer->{qty};
92       my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
93       my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
94       my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
95       my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
96       my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
97
98       $src_wh ||= $src_bin->warehouse if $src_bin;
99       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
100
101       my $direction = 0; # bit mask
102       $direction |= 1 if $src_bin;
103       $direction |= 2 if $dst_bin;
104
105       my $transfer_type_id;
106       if ($transfer->{transfer_type_id}) {
107         $transfer_type_id = $transfer->{transfer_type_id};
108       } else {
109         my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
110                                                                                              description => $transfer->{transfer_type});
111         $transfer_type_id = $transfer_type->id;
112       }
113
114       my $stocktaking_qty = $transfer->{stocktaking_qty};
115
116       my %params = (
117           part             => $part,
118           employee         => $employee,
119           trans_type_id    => $transfer_type_id,
120           project          => $project,
121           trans_id         => $trans_id,
122           shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
123                               ? $now : $transfer->{shippingdate},
124           map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
125       );
126
127       if ($unit) {
128         $qty             = $unit->convert_to($qty,             $part->unit_obj);
129         $stocktaking_qty = $unit->convert_to($stocktaking_qty, $part->unit_obj);
130       }
131
132       $params{chargenumber} ||= '';
133
134       my @inventories;
135       if ($qty && $direction & 1) {
136         push @inventories, SL::DB::Inventory->new(
137           %params,
138           warehouse => $src_wh,
139           bin       => $src_bin,
140           qty       => $qty * -1,
141         )->save;
142       }
143
144       if ($qty && $direction & 2) {
145         push @inventories, SL::DB::Inventory->new(
146           %params,
147           warehouse => $dst_wh->id,
148           bin       => $dst_bin->id,
149           qty       => $qty,
150         )->save;
151         # Standardlagerplatz in Stammdaten gleich mitverschieben
152         if (defined($transfer->{change_default_bin})){
153           $part->update_attributes(warehouse_id  => $dst_wh->id, bin_id => $dst_bin->id);
154         }
155       }
156
157       # Record stocktaking if requested.
158       # This is only possible if transfer was a stock in or stock out,
159       # but not both (transfer).
160       if ($transfer->{record_stocktaking}) {
161         die 'Stocktaking can only be recorded for stock in or stock out, but not on a transfer.' if scalar @inventories > 1;
162
163         my $inventory_id;
164         $inventory_id = $inventories[0]->id if $inventories[0];
165
166         SL::DB::Stocktaking->new(
167           inventory_id => $inventory_id,
168           warehouse    => $src_wh  || $dst_wh,
169           bin          => $src_bin || $dst_bin,
170           parts_id     => $part->id,
171           employee_id  => $employee->id,
172           qty          => $stocktaking_qty,
173           comment      => $transfer->{comment},
174           cutoff_date  => $transfer->{stocktaking_cutoff_date},
175           chargenumber => $transfer->{chargenumber},
176           bestbefore   => $transfer->{bestbefore},
177         )->save;
178
179       }
180
181       push @trans_ids, $trans_id;
182     }
183
184     1;
185   }) or do {
186     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
187   };
188
189   $::lxdebug->leave_sub;
190
191   return @trans_ids;
192 }
193
194 sub get_warehouse_journal {
195   $main::lxdebug->enter_sub();
196
197   my $self      = shift;
198   my %filter    = @_;
199
200   my $myconfig  = \%main::myconfig;
201   my $form      = $main::form;
202
203   my $all_units = AM->retrieve_units($myconfig, $form);
204
205   # connect to database
206   my $dbh = $form->get_standard_dbh($myconfig);
207
208   # filters
209   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
210
211   if ($filter{warehouse_id}) {
212     push @filter_ary, "w1.id = ? OR w2.id = ?";
213     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
214   }
215
216   if ($filter{bin_id}) {
217     push @filter_ary, "b1.id = ? OR b2.id = ?";
218     push @filter_vars, $filter{bin_id}, $filter{bin_id};
219   }
220
221   if ($filter{partnumber}) {
222     push @filter_ary, "p.partnumber ILIKE ?";
223     push @filter_vars, like($filter{partnumber});
224   }
225
226   if ($filter{description}) {
227     push @filter_ary, "(p.description ILIKE ?)";
228     push @filter_vars, like($filter{description});
229   }
230
231   if ($filter{classification_id}) {
232     push @filter_ary, "p.classification_id = ?";
233     push @filter_vars, $filter{classification_id};
234   }
235
236   if ($filter{chargenumber}) {
237     push @filter_ary, "i1.chargenumber ILIKE ?";
238     push @filter_vars, like($filter{chargenumber});
239   }
240
241   if (trim($form->{bestbefore})) {
242     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
243     push @filter_vars, trim($form->{bestbefore});
244   }
245
246   if (trim($form->{fromdate})) {
247     push @filter_ary, "? <= i1.shippingdate";
248     push @filter_vars, trim($form->{fromdate});
249   }
250
251   if (trim($form->{todate})) {
252     push @filter_ary, "? >= i1.shippingdate";
253     push @filter_vars, trim($form->{todate});
254   }
255
256   if ($form->{l_employee}) {
257     $joins .= "";
258   }
259
260   # prepare qty comparison for later filtering
261   my ($f_qty_op, $f_qty, $f_qty_base_unit);
262   if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
263     $f_qty_op        = $filter{qty_op};
264     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
265     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
266   }
267
268   map { $_ = "(${_})"; } @filter_ary;
269
270   # if of a property number or description is requested,
271   # automatically check the matching id too.
272   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
273
274   # customize shown entry for not available fields.
275   $filter{na} = '-' unless $filter{na};
276
277   # make order, search in $filter and $form
278   my $sort_col   = $form->{sort};
279   my $sort_order = $form->{order};
280
281   $sort_col      = $filter{sort}         unless $sort_col;
282   $sort_col      = 'shippingdate'        if     $sort_col eq 'date';
283   $sort_order    = ($sort_col = 'shippingdate') unless $sort_col;
284
285   my %orderspecs = (
286     'shippingdate'   => ['shippingdate', 'r_itime', 'r_parts_id'],
287     'bin_to'         => ['bin_to', 'r_itime', 'r_parts_id'],
288     'bin_from'       => ['bin_from', 'r_itime', 'r_parts_id'],
289     'warehouse_to'   => ['warehouse_to, r_itime, r_parts_id'],
290     'warehouse_from' => ['warehouse_from, r_itime, r_parts_id'],
291     'partnumber'     => ['partnumber'],
292     'partdescription'=> ['partdescription'],
293     'partunit'       => ['partunit, r_itime, r_parts_id'],
294     'qty'            => ['qty, r_itime, r_parts_id'],
295     'oe_id'          => ['oe_id'],
296     'comment'        => ['comment'],
297     'trans_type'     => ['trans_type'],
298     'employee'       => ['employee'],
299     'projectnumber'  => ['projectnumber'],
300     'chargenumber'   => ['chargenumber'],
301   );
302
303   $sort_order    = $filter{order}  unless $sort_order;
304   my $ASC = ($sort_order ? " DESC" : " ASC");
305   my $sort_spec  = join("$ASC , ", @{$orderspecs{$sort_col}}). " $ASC";
306
307   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
308
309   my ($cvar_where, @cvar_values) = CVar->build_filter_query(
310     module         => 'IC',
311     trans_id_field => 'p.id',
312     filter         => $form,
313     sub_module     => undef,
314   );
315
316   if ($cvar_where) {
317     $where_clause .= qq| ($cvar_where) AND |;
318     push @filter_vars, @cvar_values;
319   }
320
321   $select_tokens{'trans'} = {
322      "parts_id"             => "i1.parts_id",
323      "qty"                  => "ABS(SUM(i1.qty))",
324      "partnumber"           => "p.partnumber",
325      "partdescription"      => "p.description",
326      "classification_id"    => "p.classification_id",
327      "part_type"            => "p.part_type",
328      "bindescription"       => "b.description",
329      "chargenumber"         => "i1.chargenumber",
330      "bestbefore"           => "i1.bestbefore",
331      "warehousedescription" => "w.description",
332      "partunit"             => "p.unit",
333      "bin_from"             => "b1.description",
334      "bin_to"               => "b2.description",
335      "warehouse_from"       => "w1.description",
336      "warehouse_to"         => "w2.description",
337      "comment"              => "i1.comment",
338      "trans_type"           => "tt.description",
339      "trans_id"             => "i1.trans_id",
340      "id"                   => "i1.id",
341      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
342      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
343      "date"                 => "i1.shippingdate",
344      "itime"                => "i1.itime",
345      "shippingdate"         => "i1.shippingdate",
346      "employee"             => "e.name",
347      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
348      };
349
350   $select_tokens{'out'} = {
351      "bin_to"               => "'$filter{na}'",
352      "warehouse_to"         => "'$filter{na}'",
353      };
354
355   $select_tokens{'in'} = {
356      "bin_from"             => "'$filter{na}'",
357      "warehouse_from"       => "'$filter{na}'",
358      };
359
360   $form->{l_classification_id}  = 'Y';
361   $form->{l_trans_id}           = 'Y';
362   $form->{l_part_type}          = 'Y';
363   $form->{l_itime}              = 'Y';
364   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
365
366   # build the select clauses.
367   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
368   for my $i ('trans', 'out', 'in') {
369     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
370           ( grep( { !/qty$/ and !/^l_cvar/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
371   }
372
373   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
374         ( grep( { !/qty$/ and !/^l_cvar/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate l_itime) );
375
376   $where_clause = defined($where_clause) ? $where_clause : '';
377
378   my $query =
379   qq|SELECT * FROM (
380     SELECT DISTINCT $select{out}
381     FROM inventory i1
382     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id AND i1.id = i2.id
383     LEFT JOIN parts p ON i1.parts_id = p.id
384     LEFT JOIN bin b1 ON i1.bin_id = b1.id
385     LEFT JOIN bin b2 ON i2.bin_id = b2.id
386     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
387     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
388     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
389     LEFT JOIN project pr ON i1.project_id = pr.id
390     LEFT JOIN employee e ON i1.employee_id = e.id
391     WHERE $where_clause i1.qty != 0 AND tt.direction = 'out' AND
392           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) >= 1 )
393     GROUP BY $group_clause
394
395     UNION
396
397     SELECT DISTINCT $select{in}
398     FROM inventory i1
399     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id AND i1.id = i2.id
400     LEFT JOIN parts p ON i1.parts_id = p.id
401     LEFT JOIN bin b1 ON i1.bin_id = b1.id
402     LEFT JOIN bin b2 ON i2.bin_id = b2.id
403     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
404     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
405     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
406     LEFT JOIN project pr ON i1.project_id = pr.id
407     LEFT JOIN employee e ON i1.employee_id = e.id
408     WHERE $where_clause i1.qty != 0 AND tt.direction = 'in' AND
409           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) >= 1 )
410     GROUP BY $group_clause
411     ORDER BY r_${sort_spec}) AS lines WHERE r_qty != 0|;
412
413   my @all_vars = (@filter_vars,@filter_vars);
414
415   if ($filter{limit}) {
416     $query .= " LIMIT ?";
417     push @all_vars,$filter{limit};
418   }
419   if ($filter{offset}) {
420     $query .= " OFFSET ?";
421     push @all_vars, $filter{offset};
422   }
423
424   my $sth = prepare_execute_query($form, $dbh, $query, @all_vars);
425
426   my ($h_oe_id, $q_oe_id);
427   if ($form->{l_oe_id}) {
428     $q_oe_id = <<SQL;
429       SELECT dord.id AS id, dord.donumber AS number,
430         CASE
431           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
432           ELSE                               'sales_delivery_order'
433         END AS type
434       FROM delivery_orders dord
435       WHERE dord.id = ?
436
437       UNION
438
439       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
440       FROM ar
441       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
442
443       UNION
444
445       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
446       FROM ap
447       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
448 SQL
449     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
450   }
451
452   my @contents = ();
453   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
454     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
455     my $qty = $ref->{"qty"} * 1;
456
457     next unless ($qty > 0);
458
459     if ($f_qty_op) {
460       my $part_unit = $all_units->{$ref->{"partunit"}};
461       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
462       $qty *= $part_unit->{"factor"};
463       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
464       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
465       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
466     }
467
468     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
469       do_statement($form, $h_oe_id, $q_oe_id, $ref->{oe_id}, ($ref->{invoice_id}) x 2);
470       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
471     }
472
473     push @contents, $ref;
474   }
475
476   $sth->finish();
477   $h_oe_id->finish() if $h_oe_id;
478
479   $main::lxdebug->leave_sub();
480
481   return @contents;
482 }
483
484 #
485 # This sub is the primary function to retrieve information about items in warehouses.
486 # $filter is a hashref and supports the following keys:
487 #  - warehouse_id - will return matches with this warehouse_id only
488 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
489 #  - partsid      - will return matches with this parts_id only
490 #  - classification_id - will return matches with this parts with this classification only
491 #  - description  - will return only matches where the given string is a substring of the description
492 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
493 #  - bestbefore   - will return only matches with this bestbefore date
494 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
495 #  - charge_ids   - must be an arrayref. will return contents with these ids only
496 #  - expires_in   - will only return matches that expire within the given number of days
497 #                   will also add a column named 'has_expired' containing if the match has already expired or not
498 #  - hazardous    - will return matches with the flag hazardous only
499 #  - oil          - will return matches with the flag oil only
500 #  - qty, qty_op  - quantity filter (more info to come)
501 #  - sort, order_by - sorting (more to come)
502 #  - reservation  - will provide an extra column containing the amount reserved of this match
503 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
504 #
505 sub get_warehouse_report {
506   $main::lxdebug->enter_sub();
507
508   my $self      = shift;
509   my %filter    = @_;
510
511   my $myconfig  = \%main::myconfig;
512   my $form      = $main::form;
513
514   my $all_units = AM->retrieve_units($myconfig, $form);
515
516   # connect to database
517   my $dbh = $form->get_standard_dbh($myconfig);
518
519   # filters
520   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
521
522   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
523
524   if ($filter{warehouse_id}) {
525     push @wh_bin_filter_ary,  "w.id = ?";
526     push @wh_bin_filter_vars, $filter{warehouse_id};
527   }
528
529   if ($filter{bin_id}) {
530     push @wh_bin_filter_ary,  "b.id = ?";
531     push @wh_bin_filter_vars, $filter{bin_id};
532   }
533
534   push @filter_ary,  @wh_bin_filter_ary;
535   push @filter_vars, @wh_bin_filter_vars;
536
537   if ($filter{partnumber}) {
538     push @filter_ary,  "p.partnumber ILIKE ?";
539     push @filter_vars, like($filter{partnumber});
540   }
541
542   if ($filter{classification_id}) {
543     push @filter_ary, "p.classification_id = ?";
544     push @filter_vars, $filter{classification_id};
545   }
546
547   if ($filter{description}) {
548     push @filter_ary,  "p.description ILIKE ?";
549     push @filter_vars, like($filter{description});
550   }
551
552   if ($filter{partsid}) {
553     push @filter_ary,  "p.id = ?";
554     push @filter_vars, $filter{partsid};
555   }
556
557   if ($filter{partsgroup_id}) {
558     push @filter_ary,  "p.partsgroup_id = ?";
559     push @filter_vars, $filter{partsgroup_id};
560   }
561
562   if ($filter{chargenumber}) {
563     push @filter_ary,  "i.chargenumber ILIKE ?";
564     push @filter_vars, like($filter{chargenumber});
565   }
566
567   if (trim($form->{bestbefore})) {
568     push @filter_ary, "?::DATE = i.bestbefore::DATE";
569     push @filter_vars, trim($form->{bestbefore});
570   }
571
572   if ($filter{classification_id}) {
573     push @filter_ary, "p.classification_id = ?";
574     push @filter_vars, $filter{classification_id};
575   }
576
577   if ($filter{ean}) {
578     push @filter_ary,  "p.ean ILIKE ?";
579     push @filter_vars, like($filter{ean});
580   }
581
582   if (trim($filter{date})) {
583     push @filter_ary, "i.shippingdate <= ?";
584     push @filter_vars, trim($filter{date});
585   }
586   if (!$filter{include_invalid_warehouses}){
587     push @filter_ary,  "NOT (w.invalid)";
588   }
589
590   # prepare qty comparison for later filtering
591   my ($f_qty_op, $f_qty, $f_qty_base_unit);
592
593   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
594     $f_qty_op        = $filter{qty_op};
595     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
596     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
597   }
598
599   map { $_ = "(${_})"; } @filter_ary;
600
601   # if of a property number or description is requested,
602   # automatically check the matching id too.
603   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
604
605   # make order, search in $filter and $form
606   my $sort_col    =  $form->{sort};
607   my $sort_order  = $form->{order};
608
609   $sort_col       =  $filter{sort}  unless $sort_col;
610   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
611   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
612   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
613   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
614   # S.a. Bug 1597 jb 12.5.2011
615   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
616   $sort_order     =  $filter{order} unless $sort_order;
617   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
618   my $orderby     =  $sort_col;
619   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
620
621   my $where_clause = join " AND ", ("1=1", @filter_ary);
622
623   my %select_tokens = (
624      "parts_id"              => "i.parts_id",
625      "qty"                  => "SUM(i.qty)",
626      "warehouseid"          => "i.warehouse_id",
627      "partnumber"           => "p.partnumber",
628      "partdescription"      => "p.description",
629      "classification_id"    => "p.classification_id",
630      "part_type"            => "p.part_type",
631      "bindescription"       => "b.description",
632      "binid"                => "b.id",
633      "chargenumber"         => "i.chargenumber",
634      "bestbefore"           => "i.bestbefore",
635      "ean"                  => "p.ean",
636      "chargeid"             => "c.id",
637      "warehousedescription" => "w.description",
638      "partunit"             => "p.unit",
639      "stock_value"          => ($form->{stock_value_basis} // '') eq 'list_price' ? "p.listprice / COALESCE(pfac.factor, 1)" : "p.lastcost / COALESCE(pfac.factor, 1)",
640      "purchase_price"       => "p.lastcost",
641      "list_price"           => "p.listprice",
642   );
643   $form->{l_classification_id}  = 'Y';
644   $form->{l_part_type}          = 'Y';
645
646   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
647         ( grep( { !/qty/ and !/^l_cvar/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
648           qw(l_parts_id l_qty l_partunit) );
649
650   my $group_clause = join ", ", map { +/^l_/; "$'" }
651         ( grep( { !/qty/ and !/^l_cvar/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
652           qw(l_parts_id l_partunit) );
653
654   my %join_tokens = (
655     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
656     );
657
658   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
659         ( grep( { !/qty/ and !/^l_cvar/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
660           qw(l_parts_id l_qty l_partunit) );
661
662   my ($cvar_where, @cvar_values) = CVar->build_filter_query(
663     module         => 'IC',
664     trans_id_field => 'p.id',
665     filter         => $form,
666     sub_module     => undef,
667   );
668
669   if ($cvar_where) {
670     $where_clause .= qq| AND ($cvar_where)|;
671     push @filter_vars, @cvar_values;
672   }
673
674   my $query =
675     qq|SELECT * FROM ( SELECT $select_clause
676       FROM inventory i
677       LEFT JOIN parts     p ON i.parts_id     = p.id
678       LEFT JOIN bin       b ON i.bin_id       = b.id
679       LEFT JOIN warehouse w ON i.warehouse_id = w.id
680       $joins
681       WHERE $where_clause
682       GROUP BY $group_clause
683       ORDER BY $sort_spec ) AS lines WHERE qty<>0|;
684
685   if ($filter{limit}) {
686     $query .= " LIMIT ?";
687     push @filter_vars,$filter{limit};
688   }
689   if ($filter{offset}) {
690     $query .= " OFFSET ?";
691     push @filter_vars, $filter{offset};
692   }
693   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars );
694
695   my (%non_empty_bins, @all_fields, @contents);
696
697   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
698     $ref->{qty} *= 1;
699     my $qty      = $ref->{qty};
700
701     next unless ($qty != 0);
702
703     if ($f_qty_op) {
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));
710     }
711
712     if ($form->{include_empty_bins}) {
713       $non_empty_bins{$ref->{binid}} = 1;
714       @all_fields                    = keys %{ $ref } unless (@all_fields);
715     }
716
717     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
718
719     push @contents, $ref;
720   }
721
722   $sth->finish();
723
724   if ($form->{include_empty_bins}) {
725     $query =
726       qq|SELECT
727            w.id AS warehouseid, w.description AS warehousedescription,
728            b.id AS binid, b.description AS bindescription
729          FROM bin b
730          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
731
732     @filter_ary  = @wh_bin_filter_ary;
733     @filter_vars = @wh_bin_filter_vars;
734
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;
739     }
740
741     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
742
743     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
744
745     while (my $ref = $sth->fetchrow_hashref()) {
746       map { $ref->{$_} ||= "" } @all_fields;
747       push @contents, $ref;
748     }
749     $sth->finish();
750
751     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
752       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
753     }
754   }
755
756   $main::lxdebug->leave_sub();
757
758   return @contents;
759 }
760
761 sub convert_qty_op {
762   $main::lxdebug->enter_sub();
763
764   my ($self, $qty_op) = @_;
765
766   if (!$qty_op || ($qty_op eq "dontcare")) {
767     $main::lxdebug->leave_sub();
768     return undef;
769   }
770
771   if ($qty_op eq "atleast") {
772     $qty_op = '>=';
773   } elsif ($qty_op eq "atmost") {
774     $qty_op = '<=';
775   } else {
776     $qty_op = '=';
777   }
778
779   $main::lxdebug->leave_sub();
780
781   return $qty_op;
782 }
783
784 sub retrieve_transfer_types {
785   $main::lxdebug->enter_sub();
786
787   my $self      = shift;
788   my $direction = shift;
789
790   my $myconfig  = \%main::myconfig;
791   my $form      = $main::form;
792
793   my $dbh       = $form->get_standard_dbh($myconfig);
794
795   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
796
797   $main::lxdebug->leave_sub();
798
799   return $types;
800 }
801
802 sub get_basic_bin_info {
803   $main::lxdebug->enter_sub();
804
805   my $self     = shift;
806   my %params   = @_;
807
808   Common::check_params(\%params, qw(id));
809
810   my $myconfig = \%main::myconfig;
811   my $form     = $main::form;
812
813   my $dbh      = $params{dbh} || $form->get_standard_dbh();
814
815   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
816
817   my $query    =
818     qq|SELECT b.id AS bin_id, b.description AS bin_description,
819          w.id AS warehouse_id, w.description AS warehouse_description
820        FROM bin b
821        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
822        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
823
824   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
825
826   if ('' eq ref $params{id}) {
827     $result = $result->[0] || { };
828     $main::lxdebug->leave_sub();
829
830     return $result;
831   }
832
833   $main::lxdebug->leave_sub();
834
835   return map { $_->{bin_id} => $_ } @{ $result };
836 }
837
838 sub get_basic_warehouse_info {
839   $main::lxdebug->enter_sub();
840
841   my $self     = shift;
842   my %params   = @_;
843
844   Common::check_params(\%params, qw(id));
845
846   my $myconfig = \%main::myconfig;
847   my $form     = $main::form;
848
849   my $dbh      = $params{dbh} || $form->get_standard_dbh();
850
851   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
852
853   my $query    =
854     qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
855        FROM warehouse w
856        WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
857
858   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
859
860   if ('' eq ref $params{id}) {
861     $result = $result->[0] || { };
862     $main::lxdebug->leave_sub();
863
864     return $result;
865   }
866
867   $main::lxdebug->leave_sub();
868
869   return map { $_->{warehouse_id} => $_ } @{ $result };
870 }
871 #
872 # Eingabe:  Teilenummer, Lagernummer (warehouse)
873 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
874 #
875 sub get_max_qty_parts {
876 $main::lxdebug->enter_sub();
877
878   my $self     = shift;
879   my %params   = @_;
880
881   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
882
883   my $myconfig = \%main::myconfig;
884   my $form     = $main::form;
885
886   my $dbh      = $params{dbh} || $form->get_standard_dbh();
887
888   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
889   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
890
891
892   my $max_qty_parts = 0; #Initialisierung mit 0
893   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
894     $max_qty_parts += $ref->{sum};
895   }
896
897   $main::lxdebug->leave_sub();
898
899   return $max_qty_parts;
900 }
901
902 #
903 # Eingabe:  Teilenummer, Lagernummer (warehouse)
904 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
905 #
906 sub get_part_description {
907 $main::lxdebug->enter_sub();
908
909   my $self     = shift;
910   my %params   = @_;
911
912   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
913
914   my $myconfig = \%main::myconfig;
915   my $form     = $main::form;
916
917   my $dbh      = $params{dbh} || $form->get_standard_dbh();
918
919   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
920
921   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
922
923   my $ref = $sth->fetchrow_hashref();
924   my $part_description = $ref->{partnumber} . " " . $ref->{description};
925
926   $main::lxdebug->leave_sub();
927
928   return $part_description;
929 }
930 #
931 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
932 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
933 #           Bzw. Fehler, falls Chargen oder bestbefore
934 #           bei eingelagerten Teilen definiert sind.
935 #
936 sub get_max_qty_parts_bin {
937 $main::lxdebug->enter_sub();
938
939   my $self     = shift;
940   my %params   = @_;
941
942   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
943
944   my $myconfig = \%main::myconfig;
945   my $form     = $main::form;
946
947   my $dbh      = $params{dbh} || $form->get_standard_dbh();
948
949   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
950                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
951
952   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
953
954   my $max_qty_parts = 0; #Initialisierung mit 0
955   # falls derselbe artikel mehrmals eingelagert ist
956   # chargennummer, muss entsprechend händisch agiert werden
957   my $i = 0;
958   my $error;
959   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
960     $max_qty_parts += $ref->{sum};
961     $i++;
962     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
963       $error = 1;
964     }
965   }
966   $main::lxdebug->leave_sub();
967
968   return ($max_qty_parts, $error);
969 }
970
971 sub get_wh_and_bin_for_charge {
972   $main::lxdebug->enter_sub();
973
974   my $self     = shift;
975   my %params   = @_;
976   my %bin_qty;
977
978   croak t8('Need charge number!') unless $params{chargenumber};
979
980   my $inv_items = SL::DB::Manager::Inventory->get_all(where => [chargenumber => $params{chargenumber} ]);
981
982   croak t8("Invalid charge number: #1", $params{chargenumber}) unless (ref @{$inv_items}[0] eq 'SL::DB::Inventory');
983   # add all qty for one bin and add wh_id
984   ($bin_qty{$_->bin_id}{qty}, $bin_qty{$_->bin_id}{wh}) = ($bin_qty{$_->bin_id}{qty} + $_->qty, $_->warehouse_id) for @{ $inv_items };
985
986   while (my ($bin, $value) = each (%bin_qty)) {
987     if ($value->{qty} > 0) {
988       $main::lxdebug->leave_sub();
989       return ($value->{qty}, $value->{wh}, $bin, $params{chargenumber});
990     }
991   }
992
993   $main::lxdebug->leave_sub();
994   return undef;
995 }
996 1;
997
998 __END__
999
1000 =head1 NAME
1001
1002 SL::WH - Warehouse backend
1003
1004 =head1 SYNOPSIS
1005
1006   use SL::WH;
1007   WH->transfer(\%params);
1008
1009 =head1 DESCRIPTION
1010
1011 Backend for kivitendo warehousing functions.
1012
1013 =head1 FUNCTIONS
1014
1015 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1016
1017 This is the main function to manipulate warehouse contents. A typical transfer
1018 is called like this:
1019
1020   WH->transfer->({
1021     parts_id         => 6342,
1022     qty              => 12.45,
1023     transfer_type    => 'transfer',
1024     src_warehouse_id => 12,
1025     src_bin_id       => 23,
1026     dst_warehouse_id => 25,
1027     dst_bin_id       => 167,
1028   });
1029
1030 It will generate an entry in inventory representing the transfer. Note that
1031 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1032 a destination or a src is mandatory.
1033
1034 transfer accepts more than one transaction parameter, each being a hash ref. If
1035 more than one is supplied, it is guaranteed, that all are processed in the same
1036 transaction.
1037
1038 It is possible to record stocktakings within this transaction as well.
1039 This is useful if the transfer is the result of stocktaking (see also
1040 C<SL::Controller::Inventory>). To do so the parameters C<record_stocktaking>,
1041 C<stocktaking_qty> and C<stocktaking_cutoff_date> hava to be given.
1042 If stocktaking should be saved, then the transfer quantity can be zero. In this
1043 case no entry in inventory will be made, but only the stocktaking entry.
1044
1045 Here is a full list of parameters. All "_id" parameters except oe and
1046 orderitems can be called without id with RDB objects as well.
1047
1048 =over 4
1049
1050 =item parts_id
1051
1052 The id of the article transferred. Does not check if the article is a service.
1053 Mandatory.
1054
1055 =item qty
1056
1057 Quantity of the transaction.  Mandatory.
1058
1059 =item unit
1060
1061 Unit of the transaction. Optional.
1062
1063 =item transfer_type
1064
1065 =item transfer_type_id
1066
1067 The type of transaction. The first version is a string describing the
1068 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1069 every system), the id is the hard id of a transfer_type from the database.
1070
1071 Depending of the direction of the transfer_type, source and/or destination must
1072 be specified.
1073
1074 One of transfer_type or transfer_type_id is mandatory.
1075
1076 =item src_warehouse_id
1077
1078 =item src_bin_id
1079
1080 Warehouse and bin from which to transfer. Mandatory in transfer and out
1081 directions. Ignored in in directions.
1082
1083 =item dst_warehouse_id
1084
1085 =item dst_bin_id
1086
1087 Warehouse and bin to which to transfer. Mandatory in transfer and in
1088 directions. Ignored in out directions.
1089
1090 =item chargenumber
1091
1092 If given, the transfer will transfer only articles with this chargenumber.
1093 Optional.
1094
1095 =item orderitem_id
1096
1097 Reference to an orderitem for which this transfer happened. Optional
1098
1099 =item oe_id
1100
1101 Reference to an order for which this transfer happened. Optional
1102
1103 =item comment
1104
1105 An optional comment.
1106
1107 =item best_before
1108
1109 An expiration date. Note that this is not by default used by C<warehouse_report>.
1110
1111 =item record_stocktaking
1112
1113 A boolean flag to indicate that a stocktaking entry should be saved.
1114
1115 =item stocktaking_qty
1116
1117 The quantity for the stocktaking entry.
1118
1119 =item stocktaking_cutoff_date
1120
1121 The cutoff date for the stocktaking entry.
1122
1123 =back
1124
1125 =head2 create_assembly \%PARAMS, [ \%PARAMS, ... ]
1126
1127 Creates an assembly if all defined items are available.
1128
1129 Assembly item(s) will be stocked out and the assembly will be stocked in,
1130 taking into account the qty and units which can be defined for each
1131 assembly item separately.
1132
1133 The calling params originate from C<transfer> but only parts_id with the
1134 attribute assembly are processed.
1135
1136 The typical params would be:
1137
1138   my %TRANSFER = (
1139     'login'            => $::myconfig{login},
1140     'dst_warehouse_id' => $form->{warehouse_id},
1141     'dst_bin_id'       => $form->{bin_id},
1142     'chargenumber'     => $form->{chargenumber},
1143     'bestbefore'       => $form->{bestbefore},
1144     'assembly_id'      => $form->{parts_id},
1145     'qty'              => $form->{qty},
1146     'comment'          => $form->{comment}
1147   );
1148
1149
1150 =head2 get_wh_and_bin_for_charge C<$params{chargenumber}>
1151
1152 Gets the current qty from the inventory entries with the mandatory chargenumber: C<$params{chargenumber}>.
1153 Croaks if the chargenumber is missing or no entry currently exists.
1154 If there is one bin and warehouse with a positive qty, this fields are returned:
1155 C<qty> C<warehouse_id>, C<bin_id>, C<chargenumber>.
1156 Otherwise returns undef.
1157
1158
1159 =head3 Prerequisites
1160
1161 All of these prerequisites have to be trueish, otherwise the function will exit
1162 unsuccessfully with a return value of undef.
1163
1164 =over 4
1165
1166 =item Mandantory params
1167
1168   assembly_id, qty, login, dst_warehouse_id and dst_bin_id are mandatory.
1169
1170 =item Subset named 'Assembly' of data set 'Part'
1171
1172   assembly_id has to be an id in the table parts with the valid subset assembly.
1173
1174 =item Assembly is composed of assembly item(s)
1175
1176   There has to be at least one data set in the table assembly referenced to this assembly_id.
1177
1178 =item Assembly can be disassembled
1179
1180   Assemblies are like cakes. You cannot disassemble it. NEVER.
1181   But if your assembly is a mechanical cake you may unscrew it.
1182   Assemblies are created in one transaction therefore you can
1183   safely rely on the trans_id in inventory to disassemble the
1184   created assemblies (see action disassemble_assembly in wh.pl).
1185
1186 =item The assembly item(s) have to be in the same warehouse
1187
1188   inventory.warehouse_id equals dst_warehouse_id (client configurable).
1189
1190 =item The assembly item(s) have to be in stock with the qty needed
1191
1192   I can only make a cake by receipt if I have ALL ingredients and
1193   in the needed stock amount.
1194   The qty of stocked in assembly item(s) has to fit into the
1195   number of the qty of the assemblies, which are going to be created (client configurable).
1196
1197 =item assembly item(s) with the parts set 'service' are ignored
1198
1199   The subset 'Services' of part will not transferred for assembly item(s).
1200
1201 =back
1202
1203 Client configurable prerequisites can be changed with different
1204 prerequisites as described in client_config (s.a. next chapter).
1205
1206
1207 =head2 default creation of assembly
1208
1209 The valid state of the assembly item(s) used for the assembly process are
1210 'out' for the general direction and 'used' as the specific reason.
1211 The valid state of the assembly is 'in' for the direction and 'assembled'
1212 as the specific reason.
1213
1214 The method is transaction safe, in case of errors not a single entry will be made
1215 in inventory.
1216
1217
1218 =head1 BUGS
1219
1220 None yet.
1221
1222 =head1 AUTHOR
1223
1224 =cut
1225
1226 1;