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