SL/WH.pm

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