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