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      "id"                   => "i1.id",
 523      "oe_id"                => "COALESCE(i1.oe_id, i2.oe_id)",
 524      "invoice_id"           => "COALESCE(i1.invoice_id, i2.invoice_id)",
 525      "date"                 => "i1.shippingdate",
 526      "itime"                => "i1.itime",
 527      "shippingdate"         => "i1.shippingdate",
 528      "employee"             => "e.name",
 529      "projectnumber"        => "COALESCE(pr.projectnumber, '$filter{na}')",
 530      };
 531
 532   $select_tokens{'out'} = {
 533      "bin_to"               => "'$filter{na}'",
 534      "warehouse_to"         => "'$filter{na}'",
 535      };
 536
 537   $select_tokens{'in'} = {
 538      "bin_from"             => "'$filter{na}'",
 539      "warehouse_from"       => "'$filter{na}'",
 540      };
 541
 542   $form->{l_classification_id}  = 'Y';
 543   $form->{l_id}                 = 'Y';
 544   $form->{l_part_type}          = 'Y';
 545   $form->{l_itime}              = 'Y';
 546   $form->{l_invoice_id} = $form->{l_oe_id} if $form->{l_oe_id};
 547
 548   # build the select clauses.
 549   # take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
 550   for my $i ('trans', 'out', 'in') {
 551     $select{$i} = join ', ', map { +/^l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
 552           ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_shippingdate) );
 553   }
 554
 555   my $group_clause = join ", ", map { +/^l_/; "r_$'" }
 556         ( grep( { !/qty$/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_shippingdate l_itime) );
 557
 558   $where_clause = defined($where_clause) ? $where_clause : '';
 559
 560   my $query =
 561   qq|SELECT * FROM (SELECT DISTINCT $select{trans}
 562     FROM inventory i1
 563     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 564     LEFT JOIN parts p ON i1.parts_id = p.id
 565     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 566     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 567     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 568     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 569     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 570     LEFT JOIN project pr ON i1.project_id = pr.id
 571     LEFT JOIN employee e ON i1.employee_id = e.id
 572     WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
 573           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
 574     GROUP BY $group_clause
 575
 576     UNION
 577
 578     SELECT DISTINCT $select{out}
 579     FROM inventory i1
 580     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 581     LEFT JOIN parts p ON i1.parts_id = p.id
 582     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 583     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 584     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 585     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 586     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 587     LEFT JOIN project pr ON i1.project_id = pr.id
 588     LEFT JOIN employee e ON i1.employee_id = e.id
 589     WHERE $where_clause i1.qty < 0 AND
 590           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 591     GROUP BY $group_clause
 592
 593     UNION
 594
 595     SELECT DISTINCT $select{in}
 596     FROM inventory i1
 597     LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
 598     LEFT JOIN parts p ON i1.parts_id = p.id
 599     LEFT JOIN bin b1 ON i1.bin_id = b1.id
 600     LEFT JOIN bin b2 ON i2.bin_id = b2.id
 601     LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
 602     LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
 603     LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
 604     LEFT JOIN project pr ON i1.project_id = pr.id
 605     LEFT JOIN employee e ON i1.employee_id = e.id
 606     WHERE $where_clause i1.qty > 0 AND
 607           i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
 608     GROUP BY $group_clause
 609     ORDER BY r_${sort_spec}) AS lines WHERE r_qty>0|;
 610
 611   my @all_vars = (@filter_vars,@filter_vars,@filter_vars);
 612
 613   if ($filter{limit}) {
 614     $query .= " LIMIT ?";
 615     push @all_vars,$filter{limit};
 616   }
 617   if ($filter{offset}) {
 618     $query .= " OFFSET ?";
 619     push @all_vars, $filter{offset};
 620   }
 621
 622   my $sth = prepare_execute_query($form, $dbh, $query, @all_vars);
 623
 624   my ($h_oe_id, $q_oe_id);
 625   if ($form->{l_oe_id}) {
 626     $q_oe_id = <<SQL;
 627       SELECT dord.id AS id, dord.donumber AS number,
 628         CASE
 629           WHEN dord.customer_id IS NULL THEN 'purchase_delivery_order'
 630           ELSE                               'sales_delivery_order'
 631         END AS type
 632       FROM delivery_orders dord
 633       WHERE dord.id = ?
 634
 635       UNION
 636
 637       SELECT ar.id AS id, ar.invnumber AS number, 'sales_invoice' AS type
 638       FROM ar
 639       WHERE ar.id = (SELECT trans_id FROM invoice WHERE id = ?)
 640
 641       UNION
 642
 643       SELECT ap.id AS id, ap.invnumber AS number, 'purchase_invoice' AS type
 644       FROM ap
 645       WHERE ap.id = (SELECT trans_id FROM invoice WHERE id = ?)
 646 SQL
 647     $h_oe_id = prepare_query($form, $dbh, $q_oe_id);
 648   }
 649
 650   my @contents = ();
 651   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 652     map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
 653     my $qty = $ref->{"qty"} * 1;
 654
 655     next unless ($qty > 0);
 656
 657     if ($f_qty_op) {
 658       my $part_unit = $all_units->{$ref->{"partunit"}};
 659       next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
 660       $qty *= $part_unit->{"factor"};
 661       next if (('=' eq $f_qty_op) && ($qty != $f_qty));
 662       next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
 663       next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
 664     }
 665
 666     if ($h_oe_id && ($ref->{oe_id} || $ref->{invoice_id})) {
 667       do_statement($form, $h_oe_id, $q_oe_id, $ref->{oe_id}, ($ref->{invoice_id}) x 2);
 668       $ref->{oe_id_info} = $h_oe_id->fetchrow_hashref() || {};
 669     }
 670
 671     push @contents, $ref;
 672   }
 673
 674   $sth->finish();
 675   $h_oe_id->finish() if $h_oe_id;
 676
 677   $main::lxdebug->leave_sub();
 678
 679   return @contents;
 680 }
 681
 682 #
 683 # This sub is the primary function to retrieve information about items in warehouses.
 684 # $filter is a hashref and supports the following keys:
 685 #  - warehouse_id - will return matches with this warehouse_id only
 686 #  - partnumber   - will return only matches where the given string is a substring of the partnumber
 687 #  - partsid      - will return matches with this parts_id only
 688 #  - classification_id - will return matches with this parts with this classification only
 689 #  - description  - will return only matches where the given string is a substring of the description
 690 #  - chargenumber - will return only matches where the given string is a substring of the chargenumber
 691 #  - bestbefore   - will return only matches with this bestbefore date
 692 #  - ean          - will return only matches where the given string is a substring of the ean as stored in the table parts (article)
 693 #  - charge_ids   - must be an arrayref. will return contents with these ids only
 694 #  - expires_in   - will only return matches that expire within the given number of days
 695 #                   will also add a column named 'has_expired' containing if the match has already expired or not
 696 #  - hazardous    - will return matches with the flag hazardous only
 697 #  - oil          - will return matches with the flag oil only
 698 #  - qty, qty_op  - quantity filter (more info to come)
 699 #  - sort, order_by - sorting (more to come)
 700 #  - reservation  - will provide an extra column containing the amount reserved of this match
 701 # note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
 702 #
 703 sub get_warehouse_report {
 704   $main::lxdebug->enter_sub();
 705
 706   my $self      = shift;
 707   my %filter    = @_;
 708
 709   my $myconfig  = \%main::myconfig;
 710   my $form      = $main::form;
 711
 712   my $all_units = AM->retrieve_units($myconfig, $form);
 713
 714   # connect to database
 715   my $dbh = $form->get_standard_dbh($myconfig);
 716
 717   # filters
 718   my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars);
 719
 720   delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
 721
 722   if ($filter{warehouse_id}) {
 723     push @wh_bin_filter_ary,  "w.id = ?";
 724     push @wh_bin_filter_vars, $filter{warehouse_id};
 725   }
 726
 727   if ($filter{bin_id}) {
 728     push @wh_bin_filter_ary,  "b.id = ?";
 729     push @wh_bin_filter_vars, $filter{bin_id};
 730   }
 731
 732   push @filter_ary,  @wh_bin_filter_ary;
 733   push @filter_vars, @wh_bin_filter_vars;
 734
 735   if ($filter{partnumber}) {
 736     push @filter_ary,  "p.partnumber ILIKE ?";
 737     push @filter_vars, like($filter{partnumber});
 738   }
 739
 740   if ($filter{classification_id}) {
 741     push @filter_ary, "p.classification_id = ?";
 742     push @filter_vars, $filter{classification_id};
 743   }
 744
 745   if ($filter{description}) {
 746     push @filter_ary,  "p.description ILIKE ?";
 747     push @filter_vars, like($filter{description});
 748   }
 749
 750   if ($filter{partsid}) {
 751     push @filter_ary,  "p.id = ?";
 752     push @filter_vars, $filter{partsid};
 753   }
 754
 755   if ($filter{chargenumber}) {
 756     push @filter_ary,  "i.chargenumber ILIKE ?";
 757     push @filter_vars, like($filter{chargenumber});
 758   }
 759
 760   if (trim($form->{bestbefore})) {
 761     push @filter_ary, "?::DATE = i.bestbefore::DATE";
 762     push @filter_vars, trim($form->{bestbefore});
 763   }
 764
 765   if ($filter{classification_id}) {
 766     push @filter_ary, "p.classification_id = ?";
 767     push @filter_vars, $filter{classification_id};
 768   }
 769
 770   if ($filter{ean}) {
 771     push @filter_ary,  "p.ean ILIKE ?";
 772     push @filter_vars, like($filter{ean});
 773   }
 774
 775   if (trim($filter{date})) {
 776     push @filter_ary, "i.shippingdate <= ?";
 777     push @filter_vars, trim($filter{date});
 778   }
 779   if (!$filter{include_invalid_warehouses}){
 780     push @filter_ary,  "NOT (w.invalid)";
 781   }
 782
 783   # prepare qty comparison for later filtering
 784   my ($f_qty_op, $f_qty, $f_qty_base_unit);
 785
 786   if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
 787     $f_qty_op        = $filter{qty_op};
 788     $f_qty           = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
 789     $f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
 790   }
 791
 792   map { $_ = "(${_})"; } @filter_ary;
 793
 794   # if of a property number or description is requested,
 795   # automatically check the matching id too.
 796   map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
 797
 798   # make order, search in $filter and $form
 799   my $sort_col    =  $form->{sort};
 800   my $sort_order  = $form->{order};
 801
 802   $sort_col       =  $filter{sort}  unless $sort_col;
 803   # falls $sort_col gar nicht in dem Bericht aufgenommen werden soll,
 804   # führt ein entsprechenes order by $sort_col zu einem SQL-Fehler
 805   # entsprechend parts_id als default lassen, wenn $sort_col UND l_$sort_col
 806   # vorhanden sind (bpsw. l_partnumber = 'Y', für in Bericht aufnehmen).
 807   # S.a. Bug 1597 jb 12.5.2011
 808   $sort_col       =  "parts_id"     unless ($sort_col && $form->{"l_$sort_col"});
 809   $sort_order     =  $filter{order} unless $sort_order;
 810   $sort_col       =~ s/ASC|DESC//; # kill stuff left in from previous queries
 811   my $orderby     =  $sort_col;
 812   my $sort_spec   =  "${sort_col} " . ($sort_order ? " DESC" : " ASC");
 813
 814   my $where_clause = join " AND ", ("1=1", @filter_ary);
 815
 816   my %select_tokens = (
 817      "parts_id"              => "i.parts_id",
 818      "qty"                  => "SUM(i.qty)",
 819      "warehouseid"          => "i.warehouse_id",
 820      "partnumber"           => "p.partnumber",
 821      "partdescription"      => "p.description",
 822      "classification_id"    => "p.classification_id",
 823      "part_type"            => "p.part_type",
 824      "bindescription"       => "b.description",
 825      "binid"                => "b.id",
 826      "chargenumber"         => "i.chargenumber",
 827      "bestbefore"           => "i.bestbefore",
 828      "ean"                  => "p.ean",
 829      "chargeid"             => "c.id",
 830      "warehousedescription" => "w.description",
 831      "partunit"             => "p.unit",
 832      "stock_value"          => ($form->{stock_value_basis} // '') eq 'list_price' ? "p.listprice / COALESCE(pfac.factor, 1)" : "p.lastcost / COALESCE(pfac.factor, 1)",
 833      "purchase_price"       => "p.lastcost",
 834      "list_price"           => "p.listprice",
 835   );
 836   $form->{l_classification_id}  = 'Y';
 837   $form->{l_part_type}          = 'Y';
 838
 839   my $select_clause = join ', ', map { +/^l_/; "$select_tokens{$'} AS $'" }
 840         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 841           qw(l_parts_id l_qty l_partunit) );
 842
 843   my $group_clause = join ", ", map { +/^l_/; "$'" }
 844         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 845           qw(l_parts_id l_partunit) );
 846
 847   my %join_tokens = (
 848     "stock_value" => "LEFT JOIN price_factors pfac ON (p.price_factor_id = pfac.id)",
 849     );
 850
 851   my $joins = join ' ', grep { $_ } map { +/^l_/; $join_tokens{"$'"} }
 852         ( grep( { !/qty/ and /^l_/ and $form->{$_} eq 'Y' } keys %$form),
 853           qw(l_parts_id l_qty l_partunit) );
 854
 855   my $query =
 856     qq|SELECT * FROM ( SELECT $select_clause
 857       FROM inventory i
 858       LEFT JOIN parts     p ON i.parts_id     = p.id
 859       LEFT JOIN bin       b ON i.bin_id       = b.id
 860       LEFT JOIN warehouse w ON i.warehouse_id = w.id
 861       $joins
 862       WHERE $where_clause
 863       GROUP BY $group_clause
 864       ORDER BY $sort_spec ) AS lines WHERE qty<>0|;
 865
 866   if ($filter{limit}) {
 867     $query .= " LIMIT ?";
 868     push @filter_vars,$filter{limit};
 869   }
 870   if ($filter{offset}) {
 871     $query .= " OFFSET ?";
 872     push @filter_vars, $filter{offset};
 873   }
 874   my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars );
 875
 876   my (%non_empty_bins, @all_fields, @contents);
 877
 878   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 879     $ref->{qty} *= 1;
 880     my $qty      = $ref->{qty};
 881
 882     next unless ($qty != 0);
 883
 884     if ($f_qty_op) {
 885       my $part_unit = $all_units->{$ref->{partunit}};
 886       next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
 887       $qty *= $part_unit->{factor};
 888       next if (('='  eq $f_qty_op) && ($qty != $f_qty));
 889       next if (('>=' eq $f_qty_op) && ($qty <  $f_qty));
 890       next if (('<=' eq $f_qty_op) && ($qty >  $f_qty));
 891     }
 892
 893     if ($form->{include_empty_bins}) {
 894       $non_empty_bins{$ref->{binid}} = 1;
 895       @all_fields                    = keys %{ $ref } unless (@all_fields);
 896     }
 897
 898     $ref->{stock_value} = ($ref->{stock_value} || 0) * $ref->{qty};
 899
 900     push @contents, $ref;
 901   }
 902
 903   $sth->finish();
 904
 905   if ($form->{include_empty_bins}) {
 906     $query =
 907       qq|SELECT
 908            w.id AS warehouseid, w.description AS warehousedescription,
 909            b.id AS binid, b.description AS bindescription
 910          FROM bin b
 911          LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
 912
 913     @filter_ary  = @wh_bin_filter_ary;
 914     @filter_vars = @wh_bin_filter_vars;
 915
 916     my @non_empty_bin_ids = keys %non_empty_bins;
 917     if (@non_empty_bin_ids) {
 918       push @filter_ary,  qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
 919       push @filter_vars, @non_empty_bin_ids;
 920     }
 921
 922     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
 923
 924     $sth    = prepare_execute_query($form, $dbh, $query, @filter_vars);
 925
 926     while (my $ref = $sth->fetchrow_hashref()) {
 927       map { $ref->{$_} ||= "" } @all_fields;
 928       push @contents, $ref;
 929     }
 930     $sth->finish();
 931
 932     if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
 933       @contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
 934     }
 935   }
 936
 937   $main::lxdebug->leave_sub();
 938
 939   return @contents;
 940 }
 941
 942 sub convert_qty_op {
 943   $main::lxdebug->enter_sub();
 944
 945   my ($self, $qty_op) = @_;
 946
 947   if (!$qty_op || ($qty_op eq "dontcare")) {
 948     $main::lxdebug->leave_sub();
 949     return undef;
 950   }
 951
 952   if ($qty_op eq "atleast") {
 953     $qty_op = '>=';
 954   } elsif ($qty_op eq "atmost") {
 955     $qty_op = '<=';
 956   } else {
 957     $qty_op = '=';
 958   }
 959
 960   $main::lxdebug->leave_sub();
 961
 962   return $qty_op;
 963 }
 964
 965 sub retrieve_transfer_types {
 966   $main::lxdebug->enter_sub();
 967
 968   my $self      = shift;
 969   my $direction = shift;
 970
 971   my $myconfig  = \%main::myconfig;
 972   my $form      = $main::form;
 973
 974   my $dbh       = $form->get_standard_dbh($myconfig);
 975
 976   my $types     = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
 977
 978   $main::lxdebug->leave_sub();
 979
 980   return $types;
 981 }
 982
 983 sub get_basic_bin_info {
 984   $main::lxdebug->enter_sub();
 985
 986   my $self     = shift;
 987   my %params   = @_;
 988
 989   Common::check_params(\%params, qw(id));
 990
 991   my $myconfig = \%main::myconfig;
 992   my $form     = $main::form;
 993
 994   my $dbh      = $params{dbh} || $form->get_standard_dbh();
 995
 996   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
 997
 998   my $query    =
 999     qq|SELECT b.id AS bin_id, b.description AS bin_description,
1000          w.id AS warehouse_id, w.description AS warehouse_description
1001        FROM bin b
1002        LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
1003        WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
1004
1005   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
1006
1007   if ('' eq ref $params{id}) {
1008     $result = $result->[0] || { };
1009     $main::lxdebug->leave_sub();
1010
1011     return $result;
1012   }
1013
1014   $main::lxdebug->leave_sub();
1015
1016   return map { $_->{bin_id} => $_ } @{ $result };
1017 }
1018
1019 sub get_basic_warehouse_info {
1020   $main::lxdebug->enter_sub();
1021
1022   my $self     = shift;
1023   my %params   = @_;
1024
1025   Common::check_params(\%params, qw(id));
1026
1027   my $myconfig = \%main::myconfig;
1028   my $form     = $main::form;
1029
1030   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1031
1032   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
1033
1034   my $query    =
1035     qq|SELECT w.id AS warehouse_id, w.description AS warehouse_description
1036        FROM warehouse w
1037        WHERE w.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
1038
1039   my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
1040
1041   if ('' eq ref $params{id}) {
1042     $result = $result->[0] || { };
1043     $main::lxdebug->leave_sub();
1044
1045     return $result;
1046   }
1047
1048   $main::lxdebug->leave_sub();
1049
1050   return map { $_->{warehouse_id} => $_ } @{ $result };
1051 }
1052 #
1053 # Eingabe:  Teilenummer, Lagernummer (warehouse)
1054 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lager
1055 #
1056 sub get_max_qty_parts {
1057 $main::lxdebug->enter_sub();
1058
1059   my $self     = shift;
1060   my %params   = @_;
1061
1062   Common::check_params(\%params, qw(parts_id warehouse_id)); #die brauchen wir
1063
1064   my $myconfig = \%main::myconfig;
1065   my $form     = $main::form;
1066
1067   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1068
1069   my $query = qq| SELECT SUM(qty), bin_id, chargenumber, bestbefore  FROM inventory where parts_id = ? AND warehouse_id = ? GROUP BY bin_id, chargenumber, bestbefore|;
1070   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{warehouse_id}); #info: aufruf an DBUtils.pm
1071
1072
1073   my $max_qty_parts = 0; #Initialisierung mit 0
1074   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten, chargen und Lagerorte (s.a. SQL-Query oben)
1075     $max_qty_parts += $ref->{sum};
1076   }
1077
1078   $main::lxdebug->leave_sub();
1079
1080   return $max_qty_parts;
1081 }
1082
1083 #
1084 # Eingabe:  Teilenummer, Lagernummer (warehouse)
1085 # Ausgabe:  Die Beschreibung der Ware bzw. Erzeugnis
1086 #
1087 sub get_part_description {
1088 $main::lxdebug->enter_sub();
1089
1090   my $self     = shift;
1091   my %params   = @_;
1092
1093   Common::check_params(\%params, qw(parts_id)); #die brauchen wir
1094
1095   my $myconfig = \%main::myconfig;
1096   my $form     = $main::form;
1097
1098   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1099
1100   my $query = qq| SELECT partnumber, description FROM parts where id = ? |;
1101
1102   my $sth      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}); #info: aufruf zu DBUtils.pm
1103
1104   my $ref = $sth->fetchrow_hashref();
1105   my $part_description = $ref->{partnumber} . " " . $ref->{description};
1106
1107   $main::lxdebug->leave_sub();
1108
1109   return $part_description;
1110 }
1111 #
1112 # Eingabe:  Teilenummer, Lagerplatz_Id (bin_id)
1113 # Ausgabe:  Die maximale Anzahl der Teile in diesem Lagerplatz
1114 #           Bzw. Fehler, falls Chargen oder bestbefore
1115 #           bei eingelagerten Teilen definiert sind.
1116 #
1117 sub get_max_qty_parts_bin {
1118 $main::lxdebug->enter_sub();
1119
1120   my $self     = shift;
1121   my %params   = @_;
1122
1123   Common::check_params(\%params, qw(parts_id bin_id)); #die brauchen wir
1124
1125   my $myconfig = \%main::myconfig;
1126   my $form     = $main::form;
1127
1128   my $dbh      = $params{dbh} || $form->get_standard_dbh();
1129
1130   my $query = qq| SELECT SUM(qty), chargenumber, bestbefore  FROM inventory where parts_id = ?
1131                             AND bin_id = ? GROUP BY chargenumber, bestbefore|;
1132
1133   my $sth_QTY      = prepare_execute_query($form, $dbh, $query, ,$params{parts_id}, $params{bin_id}); #info: aufruf an DBUtils.pm
1134
1135   my $max_qty_parts = 0; #Initialisierung mit 0
1136   # falls derselbe artikel mehrmals eingelagert ist
1137   # chargennummer, muss entsprechend händisch agiert werden
1138   my $i = 0;
1139   my $error;
1140   while (my $ref = $sth_QTY->fetchrow_hashref()) {  # wir laufen über alle Haltbarkeiten und Chargen(s.a. SQL-Query oben)
1141     $max_qty_parts += $ref->{sum};
1142     $i++;
1143     if (($ref->{chargenumber} || $ref->{bestbefore}) && $ref->{sum} != 0){
1144       $error = 1;
1145     }
1146   }
1147   $main::lxdebug->leave_sub();
1148
1149   return ($max_qty_parts, $error);
1150 }
1151
1152 sub get_wh_and_bin_for_charge {
1153   $main::lxdebug->enter_sub();
1154
1155   my $self     = shift;
1156   my %params   = @_;
1157   my %bin_qty;
1158
1159   croak t8('Need charge number!') unless $params{chargenumber};
1160
1161   my $inv_items = SL::DB::Manager::Inventory->get_all(where => [chargenumber => $params{chargenumber} ]);
1162
1163   croak t8("Invalid charge number: #1", $params{chargenumber}) unless (ref @{$inv_items}[0] eq 'SL::DB::Inventory');
1164   # add all qty for one bin and add wh_id
1165   ($bin_qty{$_->bin_id}{qty}, $bin_qty{$_->bin_id}{wh}) = ($bin_qty{$_->bin_id}{qty} + $_->qty, $_->warehouse_id) for @{ $inv_items };
1166
1167   while (my ($bin, $value) = each (%bin_qty)) {
1168     if ($value->{qty} > 0) {
1169       $main::lxdebug->leave_sub();
1170       return ($value->{qty}, $value->{wh}, $bin, $params{chargenumber});
1171     }
1172   }
1173
1174   $main::lxdebug->leave_sub();
1175   return undef;
1176 }
1177 1;
1178
1179 __END__
1180
1181 =head1 NAME
1182
1183 SL::WH - Warehouse backend
1184
1185 =head1 SYNOPSIS
1186
1187   use SL::WH;
1188   WH->transfer(\%params);
1189
1190 =head1 DESCRIPTION
1191
1192 Backend for kivitendo warehousing functions.
1193
1194 =head1 FUNCTIONS
1195
1196 =head2 transfer \%PARAMS, [ \%PARAMS, ... ]
1197
1198 This is the main function to manipulate warehouse contents. A typical transfer
1199 is called like this:
1200
1201   WH->transfer->({
1202     parts_id         => 6342,
1203     qty              => 12.45,
1204     transfer_type    => 'transfer',
1205     src_warehouse_id => 12,
1206     src_bin_id       => 23,
1207     dst_warehouse_id => 25,
1208     dst_bin_id       => 167,
1209   });
1210
1211 It will generate an entry in inventory representing the transfer. Note that
1212 parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
1213 a destination or a src is mandatory.
1214
1215 transfer accepts more than one transaction parameter, each being a hash ref. If
1216 more than one is supplied, it is guaranteed, that all are processed in the same
1217 transaction.
1218
1219 It is possible to record stocktakings within this transaction as well.
1220 This is useful if the transfer is the result of stocktaking (see also
1221 C<SL::Controller::Inventory>). To do so the parameters C<record_stocktaking>,
1222 C<stocktaking_qty> and C<stocktaking_cutoff_date> hava to be given.
1223 If stocktaking should be saved, then the transfer quantity can be zero. In this
1224 case no entry in inventory will be made, but only the stocktaking entry.
1225
1226 Here is a full list of parameters. All "_id" parameters except oe and
1227 orderitems can be called without id with RDB objects as well.
1228
1229 =over 4
1230
1231 =item parts_id
1232
1233 The id of the article transferred. Does not check if the article is a service.
1234 Mandatory.
1235
1236 =item qty
1237
1238 Quantity of the transaction.  Mandatory.
1239
1240 =item unit
1241
1242 Unit of the transaction. Optional.
1243
1244 =item transfer_type
1245
1246 =item transfer_type_id
1247
1248 The type of transaction. The first version is a string describing the
1249 transaction (the types 'transfer' 'in' 'out' and a few others are present on
1250 every system), the id is the hard id of a transfer_type from the database.
1251
1252 Depending of the direction of the transfer_type, source and/or destination must
1253 be specified.
1254
1255 One of transfer_type or transfer_type_id is mandatory.
1256
1257 =item src_warehouse_id
1258
1259 =item src_bin_id
1260
1261 Warehouse and bin from which to transfer. Mandatory in transfer and out
1262 directions. Ignored in in directions.
1263
1264 =item dst_warehouse_id
1265
1266 =item dst_bin_id
1267
1268 Warehouse and bin to which to transfer. Mandatory in transfer and in
1269 directions. Ignored in out directions.
1270
1271 =item chargenumber
1272
1273 If given, the transfer will transfer only articles with this chargenumber.
1274 Optional.
1275
1276 =item orderitem_id
1277
1278 Reference to an orderitem for which this transfer happened. Optional
1279
1280 =item oe_id
1281
1282 Reference to an order for which this transfer happened. Optional
1283
1284 =item comment
1285
1286 An optional comment.
1287
1288 =item best_before
1289
1290 An expiration date. Note that this is not by default used by C<warehouse_report>.
1291
1292 =item record_stocktaking
1293
1294 A boolean flag to indicate that a stocktaking entry should be saved.
1295
1296 =item stocktaking_qty
1297
1298 The quantity for the stocktaking entry.
1299
1300 =item stocktaking_cutoff_date
1301
1302 The cutoff date for the stocktaking entry.
1303
1304 =back
1305
1306 =head2 create_assembly \%PARAMS, [ \%PARAMS, ... ]
1307
1308 Creates an assembly if all defined items are available.
1309
1310 Assembly item(s) will be stocked out and the assembly will be stocked in,
1311 taking into account the qty and units which can be defined for each
1312 assembly item separately.
1313
1314 The calling params originate from C<transfer> but only parts_id with the
1315 attribute assembly are processed.
1316
1317 The typical params would be:
1318
1319   my %TRANSFER = (
1320     'login'            => $::myconfig{login},
1321     'dst_warehouse_id' => $form->{warehouse_id},
1322     'dst_bin_id'       => $form->{bin_id},
1323     'chargenumber'     => $form->{chargenumber},
1324     'bestbefore'       => $form->{bestbefore},
1325     'assembly_id'      => $form->{parts_id},
1326     'qty'              => $form->{qty},
1327     'comment'          => $form->{comment}
1328   );
1329
1330
1331 =head2 get_wh_and_bin_for_charge C<$params{chargenumber}>
1332
1333 Gets the current qty from the inventory entries with the mandatory chargenumber: C<$params{chargenumber}>.
1334 Croaks if the chargenumber is missing or no entry currently exists.
1335 If there is one bin and warehouse with a positive qty, this fields are returned:
1336 C<qty> C<warehouse_id>, C<bin_id>, C<chargenumber>.
1337 Otherwise returns undef.
1338
1339
1340 =head3 Prerequisites
1341
1342 All of these prerequisites have to be trueish, otherwise the function will exit
1343 unsuccessfully with a return value of undef.
1344
1345 =over 4
1346
1347 =item Mandantory params
1348
1349   assembly_id, qty, login, dst_warehouse_id and dst_bin_id are mandatory.
1350
1351 =item Subset named 'Assembly' of data set 'Part'
1352
1353   assembly_id has to be an id in the table parts with the valid subset assembly.
1354
1355 =item Assembly is composed of assembly item(s)
1356
1357   There has to be at least one data set in the table assembly referenced to this assembly_id.
1358
1359 =item Assembly cannot be destroyed or disassembled
1360
1361   Assemblies are like cakes. You cannot disassemble it. NEVER.
1362   No negative nor zero qty's are valid inputs.
1363
1364 =item The assembly item(s) have to be in the same warehouse
1365
1366   inventory.warehouse_id equals dst_warehouse_id (client configurable).
1367
1368 =item The assembly item(s) have to be in stock with the qty needed
1369
1370   I can only make a cake by receipt if I have ALL ingredients and
1371   in the needed stock amount.
1372   The qty of stocked in assembly item(s) has to fit into the
1373   number of the qty of the assemblies, which are going to be created (client configurable).
1374
1375 =item assembly item(s) with the parts set 'service' are ignored
1376
1377   The subset 'Services' of part will not transferred for assembly item(s).
1378
1379 =back
1380
1381 Client configurable prerequisites can be changed with different
1382 prerequisites as described in client_config (s.a. next chapter).
1383
1384
1385 =head2 default creation of assembly
1386
1387 The valid state of the assembly item(s) used for the assembly process are
1388 'out' for the general direction and 'used' as the specific reason.
1389 The valid state of the assembly is 'in' for the direction and 'assembled'
1390 as the specific reason.
1391
1392 The method is transaction safe, in case of errors not a single entry will be made
1393 in inventory.
1394
1395 Two prerequisites can be changed with these global parameters
1396
1397 =over 2
1398
1399 =item  $::instance_conf->get_transfer_default_warehouse_for_assembly
1400
1401   If trueish we try to get all the items form the default bins defined in parts
1402   and do not try to find them in the destination warehouse. Returns an
1403   error if not all items have set a default bin in parts.
1404
1405 =item  $::instance_conf->get_bin_id_ignore_onhand
1406
1407   If trueish we can create assemblies even if we do not have enough items in stock.
1408   The needed qty will be booked in a special bin, which has to be configured in
1409   the client config.
1410
1411 =back
1412
1413
1414
1415
1416 =head1 BUGS
1417
1418 None yet.
1419
1420 =head1 AUTHOR
1421
1422 =cut
1423
1424 1;