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