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