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