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