1 #====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #=====================================================================
 
   8 # SQL-Ledger Accounting
 
   9 # Copyright (C) 1999-2003
 
  11 #  Author: Dieter Simader
 
  12 #   Email: dsimader@sql-ledger.org
 
  13 #     Web: http://www.sql-ledger.org
 
  17 # This program is free software; you can redistribute it and/or modify
 
  18 # it under the terms of the GNU General Public License as published by
 
  19 # the Free Software Foundation; either version 2 of the License, or
 
  20 # (at your option) any later version.
 
  22 # This program is distributed in the hope that it will be useful,
 
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
  25 # GNU General Public License for more details.
 
  26 # You should have received a copy of the GNU General Public License
 
  27 # along with this program; if not, write to the Free Software
 
  28 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
 
  30 #======================================================================
 
  34 #======================================================================
 
  42 use SL::DB::Inventory;
 
  44 use SL::Locale::String qw(t8);
 
  45 use SL::Util qw(trim);
 
  51   $::lxdebug->enter_sub;
 
  53   my ($self, @args) = @_;
 
  56     $::lxdebug->leave_sub;
 
  60   require SL::DB::TransferType;
 
  62   require SL::DB::Employee;
 
  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));
 
  69     my ($transfer, $field, $class, @find_by) = @_;
 
  71     @find_by = (description => $transfer->{$field}) unless @find_by;
 
  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"});
 
  83   my $db = SL::DB::Inventory->new->db;
 
  84   $db->with_transaction(sub{
 
  85     while (my $transfer = shift @args) {
 
  87       ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|) if $transfer->{qty};
 
  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');
 
  98       $src_wh ||= $src_bin->warehouse if $src_bin;
 
  99       $dst_wh ||= $dst_bin->warehouse if $dst_bin;
 
 101       my $direction = 0; # bit mask
 
 102       $direction |= 1 if $src_bin;
 
 103       $direction |= 2 if $dst_bin;
 
 105       my $transfer_type_id;
 
 106       if ($transfer->{transfer_type_id}) {
 
 107         $transfer_type_id = $transfer->{transfer_type_id};
 
 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;
 
 114       my $stocktaking_qty = $transfer->{stocktaking_qty};
 
 118           employee         => $employee,
 
 119           trans_type_id    => $transfer_type_id,
 
 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),
 
 128         $qty             = $unit->convert_to($qty,             $part->unit_obj);
 
 129         $stocktaking_qty = $unit->convert_to($stocktaking_qty, $part->unit_obj);
 
 132       $params{chargenumber} ||= '';
 
 135       if ($qty && $direction & 1) {
 
 136         push @inventories, SL::DB::Inventory->new(
 
 138           warehouse => $src_wh,
 
 144       if ($qty && $direction & 2) {
 
 145         push @inventories, SL::DB::Inventory->new(
 
 147           warehouse => $dst_wh->id,
 
 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);
 
 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;
 
 164         $inventory_id = $inventories[0]->id if $inventories[0];
 
 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},
 
 181       push @trans_ids, $trans_id;
 
 186     $::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
 
 189   $::lxdebug->leave_sub;
 
 194 sub get_warehouse_journal {
 
 195   $main::lxdebug->enter_sub();
 
 200   my $myconfig  = \%main::myconfig;
 
 201   my $form      = $main::form;
 
 203   my $all_units = AM->retrieve_units($myconfig, $form);
 
 205   # connect to database
 
 206   my $dbh = $form->get_standard_dbh($myconfig);
 
 209   my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
 
 211   if ($filter{warehouse_id}) {
 
 212     push @filter_ary, "w1.id = ? OR w2.id = ?";
 
 213     push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
 
 216   if ($filter{bin_id}) {
 
 217     push @filter_ary, "b1.id = ? OR b2.id = ?";
 
 218     push @filter_vars, $filter{bin_id}, $filter{bin_id};
 
 221   if ($filter{partnumber}) {
 
 222     push @filter_ary, "p.partnumber ILIKE ?";
 
 223     push @filter_vars, like($filter{partnumber});
 
 226   if ($filter{description}) {
 
 227     push @filter_ary, "(p.description ILIKE ?)";
 
 228     push @filter_vars, like($filter{description});
 
 231   if ($filter{classification_id}) {
 
 232     push @filter_ary, "p.classification_id = ?";
 
 233     push @filter_vars, $filter{classification_id};
 
 236   if ($filter{chargenumber}) {
 
 237     push @filter_ary, "i1.chargenumber ILIKE ?";
 
 238     push @filter_vars, like($filter{chargenumber});
 
 241   if (trim($form->{bestbefore})) {
 
 242     push @filter_ary, "?::DATE = i1.bestbefore::DATE";
 
 243     push @filter_vars, trim($form->{bestbefore});
 
 246   if (trim($form->{fromdate})) {
 
 247     push @filter_ary, "? <= i1.shippingdate";
 
 248     push @filter_vars, trim($form->{fromdate});
 
 251   if (trim($form->{todate})) {
 
 252     push @filter_ary, "? >= i1.shippingdate";
 
 253     push @filter_vars, trim($form->{todate});
 
 256   if ($form->{l_employee}) {
 
 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};
 
 268   map { $_ = "(${_})"; } @filter_ary;
 
 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);
 
 274   # customize shown entry for not available fields.
 
 275   $filter{na} = '-' unless $filter{na};
 
 277   # make order, search in $filter and $form
 
 278   my $sort_col   = $form->{sort};
 
 279   my $sort_order = $form->{order};
 
 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;
 
 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'],
 
 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";
 
 307   my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
 
 309   my ($cvar_where, @cvar_values) = CVar->build_filter_query(
 
 311     trans_id_field => 'p.id',
 
 317     $where_clause .= qq| ($cvar_where) AND |;
 
 318     push @filter_vars, @cvar_values;
 
 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",
 
 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}')",
 
 350   $select_tokens{'out'} = {
 
 351      "bin_to"               => "'$filter{na}'",
 
 352      "warehouse_to"         => "'$filter{na}'",
 
 355   $select_tokens{'in'} = {
 
 356      "bin_from"             => "'$filter{na}'",
 
 357      "warehouse_from"       => "'$filter{na}'",
 
 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};
 
 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) );
 
 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) );
 
 376   $where_clause = defined($where_clause) ? $where_clause : '';
 
 380     SELECT DISTINCT $select{out}
 
 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
 
 397     SELECT DISTINCT $select{in}
 
 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|;
 
 413   my @all_vars = (@filter_vars,@filter_vars);
 
 415   if ($filter{limit}) {
 
 416     $query .= " LIMIT ?";
 
 417     push @all_vars,$filter{limit};
 
 419   if ($filter{offset}) {
 
 420     $query .= " OFFSET ?";
 
 421     push @all_vars, $filter{offset};
 
 424   my $sth = prepare_execute_query($form, $dbh, $query, @all_vars);
 
 426   my ($h_oe_id, $q_oe_id);
 
 427   if ($form->{l_oe_id}) {
 
 429       SELECT dord.id AS id, dord.donumber AS number,
 
 431           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 
 432           ELSE                               'sales_delivery_order'
 
 434       FROM delivery_orders dord
 
 439       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 
 441       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 445       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 
 447       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 
 449     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 
 453   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 454     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 
 455     my $qty = $ref->{"qty"} * 1;
 
 457     next unless ($qty > 0);
 
 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));
 
 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() || {};
 
 473     push @contents, $ref;
 
 477   $h_oe_id->finish() if $h_oe_id;
 
 479   $main::lxdebug->leave_sub();
 
 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
 
 505 sub get_warehouse_report {
 
 506   $main::lxdebug->enter_sub();
 
 511   my $myconfig  = \%main::myconfig;
 
 512   my $form      = $main::form;
 
 514   my $all_units = AM->retrieve_units($myconfig, $form);
 
 516   # connect to database
 
 517   my $dbh = $form->get_standard_dbh($myconfig);
 
 520   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 
 522   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 
 524   if ($filter{warehouse_id}) {
 
 525     push @wh_bin_filter_ary,  "w.id = ?";
 
 526     push @wh_bin_filter_vars, $filter{warehouse_id};
 
 529   if ($filter{bin_id}) {
 
 530     push @wh_bin_filter_ary,  "b.id = ?";
 
 531     push @wh_bin_filter_vars, $filter{bin_id};
 
 534   push @filter_ary,  @wh_bin_filter_ary;
 
 535   push @filter_vars, @wh_bin_filter_vars;
 
 537   if ($filter{partnumber}) {
 
 538     push @filter_ary,  "p.partnumber ILIKE ?";
 
 539     push @filter_vars, like($filter{partnumber});
 
 542   if ($filter{classification_id}) {
 
 543     push @filter_ary, "p.classification_id = ?";
 
 544     push @filter_vars, $filter{classification_id};
 
 547   if ($filter{description}) {
 
 548     push @filter_ary,  "p.description ILIKE ?";
 
 549     push @filter_vars, like($filter{description});
 
 552   if ($filter{partsid}) {
 
 553     push @filter_ary,  "p.id = ?";
 
 554     push @filter_vars, $filter{partsid};
 
 557   if ($filter{partsgroup_id}) {
 
 558     push @filter_ary,  "p.partsgroup_id = ?";
 
 559     push @filter_vars, $filter{partsgroup_id};
 
 562   if ($filter{chargenumber}) {
 
 563     push @filter_ary,  "i.chargenumber ILIKE ?";
 
 564     push @filter_vars, like($filter{chargenumber});
 
 567   if (trim($form->{bestbefore})) {
 
 568     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 
 569     push @filter_vars, trim($form->{bestbefore});
 
 572   if ($filter{classification_id}) {
 
 573     push @filter_ary, "p.classification_id = ?";
 
 574     push @filter_vars, $filter{classification_id};
 
 578     push @filter_ary,  "p.ean ILIKE ?";
 
 579     push @filter_vars, like($filter{ean});
 
 582   if (trim($filter{date})) {
 
 583     push @filter_ary, "i.shippingdate <= ?";
 
 584     push @filter_vars, trim($filter{date});
 
 586   if (!$filter{include_invalid_warehouses}){
 
 587     push @filter_ary,  "NOT (w.invalid)";
 
 590   # prepare qty comparison for later filtering
 
 591   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 
 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};
 
 599   map { $_ = "(${_})"; } @filter_ary;
 
 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);
 
 605   # make order, search in $filter and $form
 
 606   my $sort_col    =  $form->{sort};
 
 607   my $sort_order  = $form->{order};
 
 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");
 
 621   my $where_clause = join " AND ", ("1=1", @filter_ary);
 
 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",
 
 633      "chargenumber"         => "i.chargenumber",
 
 634      "bestbefore"           => "i.bestbefore",
 
 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",
 
 643   $form->{l_classification_id}  = 'Y';
 
 644   $form->{l_part_type}          = 'Y';
 
 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) );
 
 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) );
 
 655     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 
 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) );
 
 662   my ($cvar_where, @cvar_values) = CVar->build_filter_query(
 
 664     trans_id_field => 'p.id',
 
 670     $where_clause .= qq| AND ($cvar_where)|;
 
 671     push @filter_vars, @cvar_values;
 
 675     qq|SELECT * FROM ( SELECT $select_clause
 
 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
 
 682       GROUP BY $group_clause
 
 683       ORDER BY $sort_spec ) AS lines WHERE qty<>0|;
 
 685   if ($filter{limit}) {
 
 686     $query .= " LIMIT ?";
 
 687     push @filter_vars,$filter{limit};
 
 689   if ($filter{offset}) {
 
 690     $query .= " OFFSET ?";
 
 691     push @filter_vars, $filter{offset};
 
 693   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars );
 
 695   my (%non_empty_bins, @all_fields, @contents);
 
 697   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
 699     my $qty      = $ref->{qty};
 
 701     next unless ($qty != 0);
 
 704       my $part_unit = $all_units->{$ref->{partunit}};
 
 705       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 
 706       $qty *= $part_unit->{factor};
 
 707       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 
 708       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 
 709       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 
 712     if ($form->{include_empty_bins}) {
 
 713       $non_empty_bins{$ref->{binid}} = 1;
 
 714       @all_fields                    = keys %{ $ref } unless (@all_fields);
 
 717     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 
 719     push @contents, $ref;
 
 724   if ($form->{include_empty_bins}) {
 
 727            w.id AS warehouseid, w.description AS warehousedescription,
 
 728            b.id AS binid, b.description AS bindescription
 
 730          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 
 732     @filter_ary  = @wh_bin_filter_ary;
 
 733     @filter_vars = @wh_bin_filter_vars;
 
 735     my @non_empty_bin_ids = keys %non_empty_bins;
 
 736     if (@non_empty_bin_ids) {
 
 737       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 
 738       push @filter_vars, @non_empty_bin_ids;
 
 741     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 
 743     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 
 745     while (my $ref = $sth->fetchrow_hashref()) {
 
 746       map { $ref->{$_} ||= "" } @all_fields;
 
 747       push @contents, $ref;
 
 751     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 
 752       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 
 756   $main::lxdebug->leave_sub();
 
 762   $main::lxdebug->enter_sub();
 
 764   my ($self, $qty_op) = @_;
 
 766   if (!$qty_op || ($qty_op eq "dontcare")) {
 
 767     $main::lxdebug->leave_sub();
 
 771   if ($qty_op eq "atleast") {
 
 773   } elsif ($qty_op eq "atmost") {
 
 779   $main::lxdebug->leave_sub();
 
 784 sub retrieve_transfer_types {
 
 785   $main::lxdebug->enter_sub();
 
 788   my $direction = shift;
 
 790   my $myconfig  = \%main::myconfig;
 
 791   my $form      = $main::form;
 
 793   my $dbh       = $form->get_standard_dbh($myconfig);
 
 795   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 
 797   $main::lxdebug->leave_sub();
 
 802 sub get_basic_bin_info {
 
 803   $main::lxdebug->enter_sub();
 
 808   Common::check_params(\%params, qw(id));
 
 810   my $myconfig = \%main::myconfig;
 
 811   my $form     = $main::form;
 
 813   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 815   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 818     qq|SELECT b.id AS bin_id, b.description AS bin_description,
 
 819          w.id AS warehouse_id, w.description AS warehouse_description
 
 821        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
 
 822        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 824   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 826   if ('' eq ref $params{id}) {
 
 827     $result = $result->[0] || { };
 
 828     $main::lxdebug->leave_sub();
 
 833   $main::lxdebug->leave_sub();
 
 835   return map { $_->{bin_id} => $_ } @{ $result };
 
 838 sub get_basic_warehouse_info {
 
 839   $main::lxdebug->enter_sub();
 
 844   Common::check_params(\%params, qw(id));
 
 846   my $myconfig = \%main::myconfig;
 
 847   my $form     = $main::form;
 
 849   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 851   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 
 854     qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
 
 856        WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 
 858   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
 
 860   if ('' eq ref $params{id}) {
 
 861     $result = $result->[0] || { };
 
 862     $main::lxdebug->leave_sub();
 
 867   $main::lxdebug->leave_sub();
 
 869   return map { $_->{warehouse_id} => $_ } @{ $result };
 
 872 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 873 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
 
 875 sub get_max_qty_parts {
 
 876 $main::lxdebug->enter_sub();
 
 881   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
 
 883   my $myconfig = \%main::myconfig;
 
 884   my $form     = $main::form;
 
 886   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 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
 
 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};
 
 897   $main::lxdebug->leave_sub();
 
 899   return $max_qty_parts;
 
 903 # Eingabe:  Teilenummer, Lagernummer (warehouse)
 
 904 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
 
 906 sub get_part_description {
 
 907 $main::lxdebug->enter_sub();
 
 912   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
 
 914   my $myconfig = \%main::myconfig;
 
 915   my $form     = $main::form;
 
 917   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 919   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
 
 921   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
 
 923   my $ref = $sth->fetchrow_hashref();
 
 924   my $part_description = $ref->{partnumber} . " " . $ref->{description};
 
 926   $main::lxdebug->leave_sub();
 
 928   return $part_description;
 
 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.
 
 936 sub get_max_qty_parts_bin {
 
 937 $main::lxdebug->enter_sub();
 
 942   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
 
 944   my $myconfig = \%main::myconfig;
 
 945   my $form     = $main::form;
 
 947   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 
 949   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
 
 950                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
 
 952   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
 
 954   my $max_qty_parts = 0; #Initialisierung mit 0
 
 955   # falls derselbe artikel mehrmals eingelagert ist
 
 956   # chargennummer, muss entsprechend händisch agiert werden
 
 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};
 
 962     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
 
 966   $main::lxdebug->leave_sub();
 
 968   return ($max_qty_parts, $error);
 
 971 sub get_wh_and_bin_for_charge {
 
 972   $main::lxdebug->enter_sub();
 
 978   croak t8('Need charge number!') unless $params{chargenumber};
 
 980   my $inv_items = SL::DB::Manager::Inventory->get_all(where => [chargenumber => $params{chargenumber} ]);
 
 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 };
 
 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});
 
 993   $main::lxdebug->leave_sub();
 
1002 SL::WH - Warehouse backend
 
1007   WH->transfer(\%params);
 
1011 Backend for kivitendo warehousing functions.
 
1015 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
 
1017 This is the main function to manipulate warehouse contents. A typical transfer
 
1018 is called like this:
 
1023     transfer_type    => 'transfer',
 
1024     src_warehouse_id => 12,
 
1026     dst_warehouse_id => 25,
 
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.
 
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
 
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.
 
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.
 
1052 The id of the article transferred. Does not check if the article is a service.
 
1057 Quantity of the transaction.  Mandatory.
 
1061 Unit of the transaction. Optional.
 
1065 =item transfer_type_id
 
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.
 
1071 Depending of the direction of the transfer_type, source and/or destination must
 
1074 One of transfer_type or transfer_type_id is mandatory.
 
1076 =item src_warehouse_id
 
1080 Warehouse and bin from which to transfer. Mandatory in transfer and out
 
1081 directions. Ignored in in directions.
 
1083 =item dst_warehouse_id
 
1087 Warehouse and bin to which to transfer. Mandatory in transfer and in
 
1088 directions. Ignored in out directions.
 
1092 If given, the transfer will transfer only articles with this chargenumber.
 
1097 Reference to an orderitem for which this transfer happened. Optional
 
1101 Reference to an order for which this transfer happened. Optional
 
1105 An optional comment.
 
1109 An expiration date. Note that this is not by default used by C<warehouse_report>.
 
1111 =item record_stocktaking
 
1113 A boolean flag to indicate that a stocktaking entry should be saved.
 
1115 =item stocktaking_qty
 
1117 The quantity for the stocktaking entry.
 
1119 =item stocktaking_cutoff_date
 
1121 The cutoff date for the stocktaking entry.
 
1125 =head2 create_assembly \%PARAMS, [ \%PARAMS, ... ]
 
1127 Creates an assembly if all defined items are available.
 
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.
 
1133 The calling params originate from C<transfer> but only parts_id with the
 
1134 attribute assembly are processed.
 
1136 The typical params would be:
 
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}
 
1150 =head2 get_wh_and_bin_for_charge C<$params{chargenumber}>
 
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.
 
1159 =head3 Prerequisites
 
1161 All of these prerequisites have to be trueish, otherwise the function will exit
 
1162 unsuccessfully with a return value of undef.
 
1166 =item Mandantory params
 
1168   assembly_id, qty, login, dst_warehouse_id and dst_bin_id are mandatory.
 
1170 =item Subset named 'Assembly' of data set 'Part'
 
1172   assembly_id has to be an id in the table parts with the valid subset assembly.
 
1174 =item Assembly is composed of assembly item(s)
 
1176   There has to be at least one data set in the table assembly referenced to this assembly_id.
 
1178 =item Assembly can be disassembled
 
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).
 
1186 =item The assembly item(s) have to be in the same warehouse
 
1188   inventory.warehouse_id equals dst_warehouse_id (client configurable).
 
1190 =item The assembly item(s) have to be in stock with the qty needed
 
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).
 
1197 =item assembly item(s) with the parts set 'service' are ignored
 
1199   The subset 'Services' of part will not transferred for assembly item(s).
 
1203 Client configurable prerequisites can be changed with different
 
1204 prerequisites as described in client_config (s.a. next chapter).
 
1207 =head2 default creation of assembly
 
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.
 
1214 The method is transaction safe, in case of errors not a single entry will be made