Revision 0ffc7ab0
Von Sven Schöling vor etwa 13 Jahren hinzugefügt
| SL/WH.pm | ||
|---|---|---|
| 42 | 42 |
use strict; |
| 43 | 43 |
|
| 44 | 44 |
sub transfer {
|
| 45 |
$main::lxdebug->enter_sub();
|
|
| 45 |
$::lxdebug->enter_sub;
|
|
| 46 | 46 |
|
| 47 |
my $self = shift;
|
|
| 47 |
my ($self, @args) = @_;
|
|
| 48 | 48 |
|
| 49 |
if (!@_) {
|
|
| 50 |
$main::lxdebug->leave_sub();
|
|
| 49 |
if (!@args) {
|
|
| 50 |
$::lxdebug->leave_sub;
|
|
| 51 | 51 |
return; |
| 52 | 52 |
} |
| 53 | 53 |
|
| 54 |
my $myconfig = \%main::myconfig; |
|
| 55 |
my $form = $main::form; |
|
| 56 |
|
|
| 57 |
my $dbh = $form->get_standard_dbh($myconfig); |
|
| 58 |
|
|
| 59 |
my $units = AM->retrieve_units($myconfig, $form); |
|
| 60 |
|
|
| 61 |
my $query = qq|SELECT * FROM transfer_type|; |
|
| 62 |
my $sth = prepare_execute_query($form, $dbh, $query); |
|
| 63 |
|
|
| 64 |
my %transfer_types; |
|
| 65 |
|
|
| 66 |
while (my $ref = $sth->fetchrow_hashref()) {
|
|
| 67 |
$transfer_types{$ref->{direction}} ||= { };
|
|
| 68 |
$transfer_types{$ref->{direction}}->{$ref->{description}} = $ref->{id};
|
|
| 69 |
} |
|
| 70 |
|
|
| 71 |
my @part_ids = map { $_->{parts_id} } @_;
|
|
| 72 |
my %partunits = selectall_as_map($form, $dbh, qq|SELECT id, unit FROM parts WHERE id IN (| . join(', ', map { '?' } @part_ids ) . qq|)|, 'id', 'unit', @part_ids);
|
|
| 73 |
|
|
| 74 |
my ($now) = selectrow_query($form, $dbh, qq|SELECT current_date|); |
|
| 75 |
|
|
| 76 |
$query = qq|INSERT INTO inventory (warehouse_id, bin_id, parts_id, chargenumber, bestbefore, |
|
| 77 |
oe_id, orderitems_id, shippingdate, |
|
| 78 |
employee_id, project_id, trans_id, trans_type_id, comment, qty) |
|
| 79 |
VALUES (?, ?, ?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?, ?, ?)|; |
|
| 54 |
require SL::DB::TransferType; |
|
| 55 |
require SL::DB::Part; |
|
| 56 |
require SL::DB::Employee; |
|
| 57 |
require SL::DB::Inventory; |
|
| 58 |
my $employee = SL::DB::Manager::Employee->find_by(login => $::form->{login});
|
|
| 59 |
my ($now) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|); |
|
| 60 |
my @directions = (undef, qw(out in transfer)); |
|
| 61 |
my $db = SL::DB->create(undef, 'LXOFFICE'); |
|
| 80 | 62 |
|
| 81 |
$sth = prepare_query($form, $dbh, $query); |
|
| 82 |
|
|
| 83 |
my @directions = (undef, 'out', 'in', 'transfer'); |
|
| 84 |
|
|
| 85 |
while (@_) {
|
|
| 86 |
my $transfer = shift; |
|
| 87 |
my ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
|
|
| 88 |
|
|
| 89 |
my ($direction, @values) = (0); |
|
| 63 |
for my $transfer (@args) {
|
|
| 64 |
my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
|
|
| 90 | 65 |
|
| 66 |
my $direction = 0; |
|
| 91 | 67 |
$direction |= 1 if ($transfer->{src_warehouse_id} && $transfer->{src_bin_id});
|
| 92 | 68 |
$direction |= 2 if ($transfer->{dst_warehouse_id} && $transfer->{dst_bin_id});
|
| 93 | 69 |
|
| 94 |
push @values, conv_i($transfer->{parts_id}), "$transfer->{chargenumber}", conv_date($transfer->{bestbefore}), conv_i($transfer->{oe_id}), conv_i($transfer->{orderitems_id});
|
|
| 95 |
push @values, $transfer->{shippingdate} eq 'current_date' ? $now : conv_date($transfer->{shippingdate}), $form->{login}, conv_i($transfer->{project_id}), $trans_id;
|
|
| 96 |
|
|
| 97 |
if ($transfer->{transfer_type_id}) {
|
|
| 98 |
push @values, $transfer->{transfer_type_id};
|
|
| 99 |
} else {
|
|
| 100 |
push @values, $transfer_types{$directions[$direction]}->{$transfer->{transfer_type}};
|
|
| 101 |
} |
|
| 102 |
|
|
| 103 |
$transfer->{comment} = defined($transfer->{comment}) ? $transfer->{comment} : '';
|
|
| 104 |
push @values, "$transfer->{comment}";
|
|
| 70 |
$transfer->{trans_type_id} = $transfer->{transfer_type_id} || SL::DB::Manager::TransferType->find_by(
|
|
| 71 |
direction => $directions[$direction], |
|
| 72 |
description => $transfer->{transfer_type},
|
|
| 73 |
)->id; |
|
| 74 |
|
|
| 75 |
my %params = ( |
|
| 76 |
shippingdate => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date' ? $now : $transfer->{shippingdate},
|
|
| 77 |
employee => $employee, |
|
| 78 |
trans_id => $trans_id, |
|
| 79 |
map { $_ => $transfer->{$_} } qw(
|
|
| 80 |
parts_id chargenumber bestbefore oe_id orderitems_id project_id comment trans_type_id), |
|
| 81 |
); |
|
| 105 | 82 |
|
| 106 | 83 |
my $qty = $transfer->{qty};
|
| 107 | 84 |
|
| 108 | 85 |
if ($transfer->{unit}) {
|
| 109 |
my $partunit = $partunits{$transfer->{parts_id}};
|
|
| 86 |
my $part = SL::DB::Manager::Part->find_by(id => $transfer->{parts_id});
|
|
| 87 |
my $transfer_unit = SL::DB::Manager::Unit->find_by(name => $transfer->{unit});
|
|
| 110 | 88 |
|
| 111 |
$qty *= $units->{$transfer->{unit}}->{factor};
|
|
| 112 |
$qty /= $units->{$partunit}->{factor} || 1 if ($partunit);
|
|
| 89 |
$qty *= $transfer_unit->factor;
|
|
| 90 |
$qty /= $part->unit_obj->factor || 1 if $part->unit;
|
|
| 113 | 91 |
} |
| 114 | 92 |
|
| 115 | 93 |
if ($direction & 1) {
|
| 116 |
do_statement($form, $sth, $query, conv_i($transfer->{src_warehouse_id}), conv_i($transfer->{src_bin_id}), @values, $qty * -1);
|
|
| 94 |
SL::DB::Inventory->new( |
|
| 95 |
%params, |
|
| 96 |
warehouse_id => $transfer->{src_warehouse_id},
|
|
| 97 |
bin_id => $transfer->{src_bin_id},
|
|
| 98 |
qty => $qty * -1 |
|
| 99 |
)->save; |
|
| 117 | 100 |
} |
| 118 | 101 |
|
| 119 | 102 |
if ($direction & 2) {
|
| 120 |
do_statement($form, $sth, $query, conv_i($transfer->{dst_warehouse_id}), conv_i($transfer->{dst_bin_id}), @values, $qty);
|
|
| 103 |
SL::DB::Inventory->new( |
|
| 104 |
%params, |
|
| 105 |
warehouse_id => $transfer->{dst_warehouse_id},
|
|
| 106 |
bin_id => $transfer->{dst_bin_id},
|
|
| 107 |
qty => $qty |
|
| 108 |
)->save; |
|
| 121 | 109 |
} |
| 122 | 110 |
} |
| 123 | 111 |
|
| 124 |
$sth->finish(); |
|
| 125 |
|
|
| 126 |
$dbh->commit(); |
|
| 112 |
$db->commit; |
|
| 127 | 113 |
|
| 128 |
$main::lxdebug->leave_sub();
|
|
| 114 |
$::lxdebug->leave_sub;
|
|
| 129 | 115 |
} |
| 130 | 116 |
|
| 131 | 117 |
sub transfer_assembly {
|
| ... | ... | |
| 146 | 132 |
# |
| 147 | 133 |
# ... Standard-Check oben Ende. Hier die eigentliche SQL-Abfrage |
| 148 | 134 |
# select parts_id,qty from assembly where id=1064; |
| 149 |
# Erweiterung für bug 935 am 23.4.09 -
|
|
| 135 |
# Erweiterung für bug 935 am 23.4.09 - |
|
| 150 | 136 |
# Erzeugnisse können Dienstleistungen enthalten, die ja nicht 'lagerbar' sind. |
| 151 |
# select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
|
|
| 137 |
# select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id |
|
| 152 | 138 |
# where assembly.id=1066 and inventory_accno_id IS NOT NULL; |
| 153 | 139 |
# |
| 154 |
# Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden,
|
|
| 140 |
# Erweiterung für bug 23.4.09 -2 Erzeugnisse in Erzeugnissen können nicht ausgelagert werden, |
|
| 155 | 141 |
# wenn assembly nicht überprüft wird ... |
| 156 | 142 |
# patch von joachim eingespielt 24.4.2009: |
| 157 | 143 |
# my $query = qq|select parts_id,qty from assembly inner join parts |
| ... | ... | |
| 159 | 145 |
# (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|; |
| 160 | 146 |
|
| 161 | 147 |
|
| 162 |
my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id
|
|
| 148 |
my $query = qq|select parts_id,qty from assembly inner join parts on assembly.parts_id = parts.id |
|
| 163 | 149 |
where assembly.id = ? and (inventory_accno_id IS NOT NULL or parts.assembly = TRUE)|; |
| 164 | 150 |
|
| 165 | 151 |
my $sth_part_qty_assembly = prepare_execute_query($form, $dbh, $query, $params{assembly_id});
|
| ... | ... | |
| 184 | 170 |
warehouse_id => $params{dst_warehouse_id});
|
| 185 | 171 |
|
| 186 | 172 |
if ($partsQTY > $max_parts){
|
| 187 |
# Gibt es hier ein Problem mit nicht "escapten" Zeichen?
|
|
| 173 |
# Gibt es hier ein Problem mit nicht "escapten" Zeichen? |
|
| 188 | 174 |
# 25.4.09 Antwort: Ja. Aber erst wenn im Frontend die locales-Funktion aufgerufen wird |
| 189 |
|
|
| 190 |
$kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) .
|
|
| 175 |
|
|
| 176 |
$kannNichtFertigen .= "Zum Fertigen fehlen:" . abs($partsQTY - $max_parts) . |
|
| 191 | 177 |
" Einheiten der Ware:" . $self->get_part_description(parts_id => $currentPart_ID) . |
| 192 | 178 |
", um das Erzeugnis herzustellen. <br>"; # Konnte die Menge nicht mit der aktuellen Anzahl der Waren fertigen |
| 193 | 179 |
next; # die weiteren Überprüfungen sind unnötig, daher das nächste elemente prüfen (genaue Ausgabe, was noch fehlt) |
| ... | ... | |
| 200 | 186 |
# und lösen den Rest dann so wie bei xplace im Barcode-Programm |
| 201 | 187 |
# S.a. Kommentar im bin/mozilla-Code mb übernimmt und macht das in ordentlich |
| 202 | 188 |
|
| 203 |
my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory
|
|
| 189 |
my $tempquery = qq|SELECT SUM(qty), bin_id, chargenumber, bestbefore FROM inventory |
|
| 204 | 190 |
WHERE warehouse_id = ? AND parts_id = ? GROUP BY bin_id, chargenumber, bestbefore having SUM(qty)>0|; |
| 205 | 191 |
my $tempsth = prepare_execute_query($form, $dbh, $tempquery, $params{dst_warehouse_id}, $currentPart_ID);
|
| 206 | 192 |
|
| ... | ... | |
| 213 | 199 |
my $temppart_bestbefore = conv_date($temphash_ref->{bestbefore});
|
| 214 | 200 |
my $temppart_qty = $temphash_ref->{sum};
|
| 215 | 201 |
|
| 216 |
if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
|
|
| 202 |
if ($tmpPartsQTY > $temppart_qty) { # wir haben noch mehr waren zum wegbuchen.
|
|
| 217 | 203 |
# Wir buchen den kompletten Lagerplatzbestand und zählen die Hilfsvariable runter |
| 218 | 204 |
$tmpPartsQTY = $tmpPartsQTY - $temppart_qty; |
| 219 |
$temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv,
|
|
| 220 |
# wenn * -1 als berechnung in der parameter-übergabe angegeben wird.
|
|
| 221 |
# Dieser Wert IST und BLEIBT positiv!! Hilfe.
|
|
| 205 |
$temppart_qty = $temppart_qty * -1; # TODO beim analyiseren des sql-trace, war dieser wert positiv, |
|
| 206 |
# wenn * -1 als berechnung in der parameter-übergabe angegeben wird. |
|
| 207 |
# Dieser Wert IST und BLEIBT positiv!! Hilfe. |
|
| 222 | 208 |
# Liegt das daran, dass dieser Wert aus einem SQL-Statement stammt? |
| 223 |
do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
|
|
| 209 |
do_statement($form, $sthTransferPartSQL, $transferPartSQL, $currentPart_ID, $params{dst_warehouse_id},
|
|
| 224 | 210 |
$temppart_bin_id, $temppart_chargenumber, $temppart_bestbefore, 'Verbraucht für ' . |
| 225 | 211 |
$self->get_part_description(parts_id => $params{assembly_id}), $params{login}, $temppart_qty);
|
| 226 | 212 |
|
| ... | ... | |
| 255 | 241 |
VALUES (?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, nextval('id'),
|
| 256 | 242 |
(SELECT id FROM transfer_type WHERE direction = 'in' AND description = 'stock'))|; |
| 257 | 243 |
my $sthTransferAssemblySQL = prepare_query($form, $dbh, $transferAssemblySQL); |
| 258 |
do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
|
|
| 244 |
do_statement($form, $sthTransferAssemblySQL, $transferAssemblySQL, $params{assembly_id}, $params{dst_warehouse_id},
|
|
| 259 | 245 |
$params{dst_bin_id}, $params{chargenumber}, conv_date($params{bestbefore}), $params{comment}, $params{login}, $params{qty});
|
| 260 | 246 |
$dbh->commit(); |
| 261 | 247 |
|
Auch abrufbar als: Unified diff
WH->transfer auf RDBO umgeschrieben