projekt kivitendo

sub transfer_assembly {

  $main::lxdebug->enter_sub();

  my $self     = shift;

  my %params   = @_;

  Common::check_params(\%params, qw(assembly_id dst_warehouse_id login qty unit dst_bin_id chargenumber bestbefore comment));

  my $myconfig = \%main::myconfig;

  my $form     = $main::form;

  my $kannNichtFertigen ="";  # Falls leer dann erfolgreich

  SL::DB->client->with_transaction(sub {

    my $dbh      = $params{dbh} || SL::DB->client->dbh;

    # Ablauferklärung

    #

    # ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage

    # select parts_id,qty from assembly where id=1064;

    # Erweiterung für bug 935 am 23.4.09 -

    # Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind.

    # select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id

    # where assembly.id=1066 and inventory_accno_id IS NOT NULL;

    #

    # Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,

    # wenn assembly nicht überprüft wird ...

    # patch von joachim eingespielt 24.4.2009:

    # my $query    = qq|select parts_id,qty from assembly inner join parts

    # on assembly.parts_id = parts.id  where assembly.id = ? and

    # (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|;

    # Lager in dem die Bestandteile gesucht werden kann entweder das Ziellager sein oder ist per Mandantenkonfig

    # auf das Standardlager des Bestandteiles schaltbar

    my $use_default_warehouse = $::instance_conf->get_transfer_default_warehouse_for_assembly;

    my $query = qq|SELECT assembly.parts_id, assembly.qty, parts.warehouse_id

                   FROM assembly INNER JOIN parts ON assembly.parts_id = parts.id

                   WHERE assembly.id = ? AND parts.part_type != 'service'|;

    my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});

    my @trans_ids;

    # Hier wird das prepared Statement für die Schleife über alle Lagerplätze vorbereitet

    my $transferPartSQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore, comment, employee_id, qty,

                             trans_id, trans_type_id, shippingdate)

                             VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, ?,

                             (SELECT id FROM transfer_type WHERE direction = 'out' AND description = 'used'),

                             (SELECT current_date))|;

    my $sthTransferPartSQL   = prepare_query($form, $dbh, $transferPartSQL);

    my $trans_id;

    # der return-string für die fehlermeldung inkl. welche waren zum fertigen noch fehlen

    my $schleife_durchlaufen=0; # Falls die Schleife nicht ausgeführt wird -> Keine Einzelteile definiert. Bessere Idee? jan

    while (my $hash_ref = $sth_part_qty_assembly->fetchrow_hashref()) { #Schleife für select parts_id,(...) from assembly

      $schleife_durchlaufen=1;  # Erzeugnis definiert

      my $partsQTY          = $hash_ref->{qty} * $params{qty}; # benötigte teile * anzahl erzeugnisse

      my $currentPart_ID    = $hash_ref->{parts_id};

      my $currentPart_WH_ID = $use_default_warehouse && $hash_ref->{warehouse_id} ? $hash_ref->{warehouse_id} : $params{dst_warehouse_id};

      my $no_check = 0;

      # Prüfen ob Erzeugnis-Teile Standardlager haben.

      if ($use_default_warehouse && ! $hash_ref->{warehouse_id}) {

        # Prüfen ob in Mandantenkonfiguration ein Standardlager aktiviert isti.

        if ($::instance_conf->get_transfer_default_ignore_onhand) {

          $currentPart_WH_ID = $::instance_conf->get_warehouse_id_ignore_onhand;

          $no_check = 1;

        } else {

          $kannNichtFertigen .= "Kein Standardlager: " .

                              " Die Ware " . $self->get_part_description(parts_id => $currentPart_ID) .

                              " hat kein Standardlager definiert " .

                              ", um das Erzeugnis herzustellen. <br>";

          next;

        }

      }

      my $warehouse_info    = $self->get_basic_warehouse_info('id'=> $currentPart_WH_ID);

      my $warehouse_desc    = $warehouse_info->{"warehouse_description"};

      # Fertigen ohne Prüfung nach Bestand

      if ($no_check) {

        my $temppart_bin_id       = $::instance_conf->get_bin_id_ignore_onhand;

        my $temppart_chargenumber = "";

        my $temppart_bestbefore   = localtime();

        my $temppart_qty          = $partsQTY * -1;

        ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')| ) unless $trans_id;

        do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,

                       $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .

                       $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty, $trans_id);

        next;

      }

      # Überprüfen, ob diese Anzahl gefertigt werden kann

      my $max_parts = $self->get_max_qty_parts(parts_id     => $currentPart_ID, # $self->method() == this.method()

                                               warehouse_id => $currentPart_WH_ID);

      if ($partsQTY  > $max_parts){

        # Gibt es hier ein Problem mit nicht "escapten" Zeichen?

        # 25.4.09 Antwort: Ja.  Aber erst wenn im Frontend die locales-Funktion aufgerufen wird

        $kannNichtFertigen .= "Zum Fertigen fehlen: " . abs($partsQTY - $max_parts) .

                              " Einheiten der Ware: " . $self->get_part_description(parts_id => $currentPart_ID) .

                              " im Lager: " . $warehouse_desc .

                              ", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen

        next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt)

      }

      # Eine kurze Vorabfrage, um den Lagerplatz, Chargennummer und die Mindesthaltbarkeit zu bestimmen

      # Offen: Die Summe über alle Lagerplätze wird noch nicht gebildet

      # Gelöst: Wir haben vorher schon die Abfrage durchgeführt, ob wir fertigen können.

      # Noch besser gelöst: Wir laufen durch alle benötigten Waren zum Fertigen und geben eine Rückmeldung an den Benutzer was noch fehlt

      # und lösen den Rest dann so wie bei xplace im Barcode-Programm

      # S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich

      my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory

                         WHERE warehouse_id = ? AND parts_id = ?  GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|;

      my $tempsth   = prepare_execute_query($form, $dbh, $tempquery, $currentPart_WH_ID, $currentPart_ID);

      # Alle Werte zu dem einzelnen Artikel, die wir später auslagern

      my $tmpPartsQTY = $partsQTY;

      while (my $temphash_ref = $tempsth->fetchrow_hashref()) {

        my $temppart_bin_id       = $temphash_ref->{bin_id}; # kann man hier den quelllagerplatz beim verbauen angeben?

        my $temppart_chargenumber = $temphash_ref->{chargenumber};

        my $temppart_bestbefore   = conv_date($temphash_ref->{bestbefore});

        my $temppart_qty          = $temphash_ref->{sum};

        ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')| ) unless $trans_id;

        if ($tmpPartsQTY > $temppart_qty) {  # wir haben noch mehr waren zum wegbuchen.

                                             # Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter

          $tmpPartsQTY = $tmpPartsQTY - $temppart_qty;

          $temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,

                                              # wenn * -1 als berechnung in der parameter-übergabe angegeben wird.

                                              # Dieser Wert IST und BLEIBT positiv!! Hilfe.

                                              # Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt?

          push @trans_ids, $trans_id;

          do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,

                       $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .

                       $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty, $trans_id);

          # hier ist noch ein fehler am besten mit definierten erzeugnissen debuggen 02/2009 jb

          # idee: ausbuch algorithmus mit rekursion lösen und an- und abschaltbar machen

          # das problem könnte sein, dass strict nicht an war und sth global eine andere zuweisung bekam

          # auf jeden fall war der internal-server-error nach aktivierung von strict und warnings plus ein paar my-definitionen weg

        } else { # okay, wir haben weniger oder gleich Waren die wir wegbuchen müssen, wir können also aufhören

          $tmpPartsQTY *=-1;

          do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $currentPart_WH_ID,

                       $temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' .

                       $self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $tmpPartsQTY, $trans_id);

          last; # beendet die schleife (springt zum letzten element)

        }

      }  # ende while SELECT SUM(qty), bin_id, chargenumber, bestbefore   FROM inventory  WHERE warehouse_id

    } #ende while select parts_id,qty from assembly where id = ?

    if ($schleife_durchlaufen==0){  # falls die schleife nicht durchlaufen wurde, wurden auch

                                    # keine einzelteile definiert

        $kannNichtFertigen ="Für dieses Erzeugnis sind keine Einzelteile definiert.

                             Dementsprechend kann auch nichts hergestellt werden";

    }

    # gibt die Fehlermeldung zurück. A.) Keine Teile definiert

    #                                B.) Artikel und Anzahl der fehlenden Teile/Dienstleistungen

    die "<br><br>" . $kannNichtFertigen if ($kannNichtFertigen);

    # soweit alles gut. Jetzt noch die wirkliche Lagerbewegung für das Erzeugnis ausführen ...

    ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')| ) unless $trans_id;

    my $transferAssemblySQL = qq|INSERT INTO inventory (parts_id, warehouse_id, bin_id, chargenumber, bestbefore,

                                                        comment, employee_id, qty, trans_id, trans_type_id, shippingdate)

                                 VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, ?,

                                 (SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'assembled'),

                                 (select current_date))|;

    my $sthTransferAssemblySQL   = prepare_query($form, $dbh, $transferAssemblySQL);

    do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},

                 $params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty}, $trans_id);

    1;

  }) or do { return $kannNichtFertigen };

  $main::lxdebug->leave_sub();

  return 1; # Alles erfolgreich

}

# use SL::Helper::Inventory qw(produce_assembly);

# vorüberlegung jb 22.2.2009

# wir benötigen für diese funktion, die anzahl die vom erzeugnis hergestellt werden soll. vielleicht direkt per js fehleingaben verhindern?

# ferner dann nochmal mit check_asssembly_max_create gegenprüfen und dann transaktionssicher wegbuchen.

# wir brauchen eine hilfsfunktion, die nee. brauchen wir nicht. der algorithmus läuft genau wie bei check max_create, nur dass hier auch eine lagerbewegung (verbraucht) stattfindet

# Manko ist derzeit noch, dass unterschiedliche Lagerplätze, bzw. das Quelllager an sich nicht ausgewählt werden können.

# Laut Absprache in KW11 09 übernimmt mb hier den rest im April ... jb 18.3.09

  # TODO Es wäre schön, hier schon die maximale Anzahl der zu fertigenden Erzeugnisse zu haben

  #else { if ($form->{qty} > $maxcreate) { #s.o.

  #     $form->show_generic_error($locale->text('Can not create that quantity with current stock'));

  #     $form->show_generic_error('Maximale Stückzahl' . $maxcreate);

  #   }

  #  }

      $form->{bestbefore} = '';

  # WIESO war das nicht vorher schon ein %HASH?? ein hash ist ein hash! das hat mich mehr als eine Stunde gekostet herauszufinden. grr. jb 3.3.2009

  # Anm. jb 18.3. vielleicht auch nur meine unwissenheit in perl-datenstrukturen

  my %TRANSFER = (

    'transfer_type'    => 'assembly',

    'login'            => $::myconfig{login},

    'dst_warehouse_id' => $form->{warehouse_id},

    'dst_bin_id'       => $form->{bin_id},

    'chargenumber'     => $form->{chargenumber},

    'bestbefore'       => $form->{bestbefore},

    'assembly_id'      => $form->{parts_id},

    'qty'              => $form->{qty},

    'unit'             => $form->{unit},

    'comment'          => $form->{comment}

  my $ret = WH->transfer_assembly (%TRANSFER);

  # Frage: Ich pack in den return-wert auch gleich die Fehlermeldung. Irgendwelche Nummern als Fehlerkonstanten definieren find ich auch nicht besonders schick...

  # Ideen? jb 18.3.09

  if ($ret ne "1"){

    # Die locale-Funktion kann keine Double-Quotes escapen, deswegen hier erstmal so (ein wahrscheinlich immerwährender Hotfix) s.a. Frage davor jb 25.4.09

    $form->show_generic_error($ret);

  }

  'Can not create that quantity with current stock' => 'Diese Anzahl kann mit dem gegenwärtigen Lagerbestand nicht hergestellt werden.',

  'Can not create that quantity with current stock' => '',