SL/WH.pm

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