SL/WH.pm

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