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