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