SL/WH.pm

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