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