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