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