SL/WH.pm

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