Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 83914eeb

Von Moritz Bunkus vor etwa 17 Jahren hinzugefügt

  • ID 83914eeb2e95cdf587565952eef54be59dd58693
  • Vorgänger 5c184abc
  • Nachfolger bb439145

Lagerverwaltung implementiert.

Unterschiede anzeigen:

SL/AM.pm
$main::lxdebug->leave_sub();
}
sub save_warehouse {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
my ($query, @values, $sth);
if (!$form->{id}) {
$query = qq|SELECT nextval('id')|;
($form->{id}) = selectrow_query($form, $dbh, $query);
$query = qq|INSERT INTO warehouse (id, sortkey) VALUES (?, (SELECT COALESCE(MAX(sortkey), 0) + 1 FROM warehouse))|;
do_query($form, $dbh, $query, $form->{id});
}
do_query($form, $dbh, qq|UPDATE warehouse SET description = ?, invalid = ? WHERE id = ?|,
$form->{description}, $form->{invalid} ? 't' : 'f', conv_i($form->{id}));
if (0 < $form->{number_of_new_bins}) {
$query = qq|INSERT INTO bin (warehouse_id, description) VALUES (?, ?)|;
$sth = prepare_query($form, $dbh, $query);
foreach my $i (1..$form->{number_of_new_bins}) {
do_statement($form, $sth, $query, conv_i($form->{id}), "$form->{prefix}${i}");
}
$sth->finish();
}
$dbh->commit();
$main::lxdebug->leave_sub();
}
sub save_bins {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
my ($query, @values, $commit_necessary, $sth);
@values = map { $form->{"id_${_}"} } grep { $form->{"delete_${_}"} } (1..$form->{rowcount});
if (@values) {
$query = qq|DELETE FROM bin WHERE id IN (| . join(', ', ('?') x scalar(@values)) . qq|)|;
do_query($form, $dbh, $query, @values);
$commit_necessary = 1;
}
$query = qq|UPDATE bin SET description = ? WHERE id = ?|;
$sth = prepare_query($form, $dbh, $query);
foreach my $row (1..$form->{rowcount}) {
next if ($form->{"delete_${row}"});
do_statement($form, $sth, $query, $form->{"description_${row}"}, conv_i($form->{"id_${row}"}));
$commit_necessary = 1;
}
$sth->finish();
$dbh->commit() if ($commit_necessary);
$main::lxdebug->leave_sub();
}
sub delete_warehouse {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
my $id = conv_i($form->{id});
my $query = qq|SELECT i.bin_id FROM inventory i WHERE i.bin_id IN (SELECT b.id FROM bin b WHERE b.warehouse_id = ?) LIMIT 1|;
my ($count) = selectrow_query($form, $dbh, $query, $id);
if ($count) {
$main::lxdebug->leave_sub();
return 0;
}
do_query($form, $dbh, qq|DELETE FROM warehouse_access WHERE warehouse_id = ?|, conv_i($form->{id}));
do_query($form, $dbh, qq|DELETE FROM bin WHERE warehouse_id = ?|, conv_i($form->{id}));
do_query($form, $dbh, qq|DELETE FROM warehouse WHERE id = ?|, conv_i($form->{id}));
$dbh->commit();
$main::lxdebug->leave_sub();
return 1;
}
sub get_all_warehouses {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
my $query = qq|SELECT w.id, w.description, w.invalid
FROM warehouse w
ORDER BY w.sortkey|;
$form->{WAREHOUSES} = selectall_hashref_query($form, $dbh, $query);
$main::lxdebug->leave_sub();
}
sub get_warehouse {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
my $id = conv_i($form->{id});
my $query = qq|SELECT w.description, w.invalid
FROM warehouse w
WHERE w.id = ?|;
my $ref = selectfirst_hashref_query($form, $dbh, $query, $id, $id);
map { $form->{$_} = $ref->{$_} } keys %{ $ref };
$query = qq|SELECT b.*, EXISTS
(SELECT i.warehouse_id
FROM inventory i
WHERE i.bin_id = b.id
LIMIT 1)
AS in_use
FROM bin b
WHERE b.warehouse_id = ?|;
$form->{BINS} = selectall_hashref_query($form, $dbh, $query, conv_i($form->{id}));
$main::lxdebug->leave_sub();
}
1;
SL/Auth.pm
["purchase_order_edit", $locale->text("Create and edit purchase orders")],
["purchase_delivery_order_edit", $locale->text("Create and edit purchase delivery orders")],
["vendor_invoice_edit", $locale->text("Create and edit vendor invoices")],
["--warehouse_management", $locale->text("Warehouse management")],
["warehouse_contents", $locale->text("View warehouse content")],
["warehouse_management", $locale->text("Warehouse management")],
["--general_ledger_cash", $locale->text("General ledger and cash")],
["general_ledger", $locale->text("Transactions, AR transactions, AP transactions")],
["datev_export", $locale->text("DATEV Export")],
SL/IC.pm
}
if ($form->{item} eq 'assembly') {
if ($form->{onhand} != 0) {
&adjust_inventory($dbh, $form, $form->{id}, $form->{onhand} * -1);
}
# delete assembly records
do_query($form, $dbh, qq|DELETE FROM assembly WHERE id = ?|, conv_i($form->{id}));
$form->{onhand} += $form->{stock};
}
# delete tax records
......
do_query($form, $dbh, qq|INSERT INTO parts (id, partnumber) VALUES (?, '')|, $form->{id});
$form->{orphaned} = 1;
$form->{onhand} = $form->{stock} if $form->{item} eq 'assembly';
if ($form->{partnumber} eq "" && $form->{"item"} eq "service") {
$form->{partnumber} = $form->update_defaults($myconfig, "servicenumber");
}
......
}
}
# adjust onhand for the parts
if ($form->{onhand} != 0) {
&adjust_inventory($dbh, $form, $form->{id}, $form->{onhand});
}
@a = localtime;
$a[5] += 1900;
$a[4]++;
......
$form->get_employee($dbh);
# add inventory record
$query =
qq|INSERT INTO inventory (warehouse_id, parts_id, qty, shippingdate, employee_id)
VALUES (0, ?, ?, '$shippingdate', ?)|;
@values = (conv_i($form->{id}), $form->{stock}, conv_i($form->{employee_id}));
do_query($form, $dbh, $query, @values);
}
#set expense_accno=inventory_accno if they are different => bilanz
......
$main::lxdebug->leave_sub();
}
sub restock_assemblies {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
# connect to database
my $dbh = $form->dbconnect_noauto($myconfig);
for my $i (1 .. $form->{rowcount}) {
$form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
if ($form->{"qty_$i"} != 0) {
&adjust_inventory($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"});
}
}
my $rc = $dbh->commit;
$dbh->disconnect;
$main::lxdebug->leave_sub();
return $rc;
}
sub adjust_inventory {
$main::lxdebug->enter_sub();
my ($dbh, $form, $id, $qty) = @_;
my $query =
qq|SELECT p.id, p.inventory_accno_id, p.assembly, a.qty
FROM parts p, assembly a
WHERE (a.parts_id = p.id) AND (a.id = ?)|;
my $sth = prepare_execute_query($form, $dbh, $query, conv_i($id));
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
my $allocate = $qty * $ref->{qty};
# is it a service item, then loop
$ref->{inventory_accno_id} *= 1;
next if (($ref->{inventory_accno_id} == 0) && !$ref->{assembly});
# adjust parts onhand
$form->update_balance($dbh, "parts", "onhand",
qq|id = $ref->{id}|,
$allocate * -1);
}
$sth->finish;
# update assembly
my $rc = $form->update_balance($dbh, "parts", "onhand", qq|id = ?|, $qty, $id);
$main::lxdebug->leave_sub();
return $rc;
}
sub delete {
$main::lxdebug->enter_sub();
......
$form->{parts} = selectall_hashref_query($form, $dbh, $query, @bind_vars);
map { $_->{onhand} *= 1 } @{ $form->{parts} };
## my $where = qq|1 = 1|;
## my (@values, $var, $flds, $group, $limit);
##
SL/IR.pm
@values = ($form->{"sellprice_$i"}, conv_i($form->{"id_$i"}));
do_query($form, $dbh, $query, @values);
$form->update_balance($dbh, "parts", "onhand", qq|id = ?|, $baseqty, $form->{"id_$i"}) if !$form->{shipped};
# check if we sold the item already and
# make an entry for the expense and inventory
$query =
......
next unless $ref->{inventory_accno_id};
# update onhand
$form->update_balance($dbh, "parts", "onhand", qq|id = $ref->{parts_id}|, $ref->{qty});
# if $ref->{allocated} > 0 than we sold that many items
next if ($ref->{allocated} <= 0);
......
$stw->finish();
chop $ref->{taxaccounts};
$ref->{onhand} *= 1;
push @{ $form->{item_list} }, $ref;
}
SL/IS.pm
if ($form->{"inventory_accno_$i"} || $form->{"assembly_$i"}) {
# adjust parts onhand quantity
if ($form->{"assembly_$i"}) {
# do not update if assembly consists of all services
$query =
qq|SELECT sum(p.inventory_accno_id)
FROM parts p
JOIN assembly a ON (a.parts_id = p.id)
WHERE a.id = ?|;
$sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{"id_$i"}));
if ($sth->fetchrow_array) {
$form->update_balance($dbh, "parts", "onhand", qq|id = ?|,
$baseqty * -1, $form->{"id_$i"})
unless $form->{shipped};
}
$sth->finish;
# record assembly item as allocated
&process_assembly($dbh, $form, $form->{"id_$i"}, $baseqty);
} else {
$form->update_balance($dbh, "parts", "onhand", qq|id = ?|,
$baseqty * -1, $form->{"id_$i"})
unless $form->{shipped};
$allocated = &cogs($dbh, $form, $form->{"id_$i"}, $baseqty, $basefactor, $i);
}
}
......
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
if ($ref->{inventory_accno_id} || $ref->{assembly}) {
# if the invoice item is not an assemblyitem adjust parts onhand
if (!$ref->{assemblyitem}) {
# adjust onhand in parts table
$form->update_balance($dbh, "parts", "onhand", qq|id = $ref->{parts_id}|, $ref->{qty});
}
# loop if it is an assembly
next if ($ref->{assembly});
if ($ref->{inventory_accno_id}) {
# de-allocated purchases
$query =
qq|SELECT i.id, i.trans_id, i.allocated
......
}
}
$ref->{onhand} *= 1;
push @{ $form->{item_list} }, $ref;
if ($form->{lizenzen}) {
SL/LICENSES.pm
$sth->execute || $form->dberror($query);
$sth->finish();
if ($form->{own_product}) {
$form->update_balance($dbh, "parts", "onhand", qq|id = ?|,
1, $form->{parts_id});
}
$dbh->disconnect();
$main::lxdebug->leave_sub();
SL/OE.pm
if ($form->{id}) {
&adj_onhand($dbh, $form, $ml) if $form->{type} =~ /_order$/;
$query = qq|DELETE FROM orderitems WHERE trans_id = ?|;
do_query($form, $dbh, $query, $form->{id});
......
}
$query .= qq|?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
(SELECT factor FROM price_factors WHERE id = ?), ?)|;
push(@values,
push(@values,
conv_i($form->{id}), conv_i($form->{"id_$i"}),
$form->{"description_$i"}, $form->{"longdescription_$i"},
$form->{"qty_$i"}, $baseqty,
......
}
}
if ($form->{type} =~ /_order$/) {
# adjust onhand
&adj_onhand($dbh, $form, $ml * -1);
}
$form->{saved_xyznumber} = $form->{$form->{type} =~ /_quotation$/ ?
"quonumber" : "ordnumber"};
......
}
$sth->finish;
$query = qq|SELECT o.parts_id, o.ship FROM orderitems o | .
qq|WHERE o.trans_id = ?|;
@values = (conv_i($form->{id}));
$sth = $dbh->prepare($query);
$sth->execute(@values) || $self->dberror($query);
while (my ($id, $ship) = $sth->fetchrow_array) {
$form->update_balance($dbh, "parts", "onhand", qq|id = $id|, $ship * -1);
}
$sth->finish;
# delete-values
@values = (conv_i($form->{id}));
# delete inventory
$query = qq|DELETE FROM inventory | .
qq|WHERE oe_id = ?|;
do_query($form, $dbh, $query, @values);
# delete status entries
$query = qq|DELETE FROM status | .
qq|WHERE trans_id = ?|;
......
return $value;
}
sub adj_onhand {
$main::lxdebug->enter_sub();
my ($dbh, $form, $ml) = @_;
my $all_units = $form->{all_units};
my $query =
qq|SELECT oi.parts_id, oi.ship, oi.unit, p.inventory_accno_id, p.assembly | .
qq| FROM orderitems oi | .
qq| JOIN parts p ON (p.id = oi.parts_id) | .
qq| WHERE oi.trans_id = ?|;
my @values = ($form->{id});
my $sth = $dbh->prepare($query);
$sth->execute(@values) || $form->dberror($query);
$query =
qq|SELECT sum(p.inventory_accno_id) | .
qq|FROM parts p | .
qq|JOIN assembly a ON (a.parts_id = p.id) | .
qq|WHERE a.id = ?|;
my $ath = $dbh->prepare($query) || $form->dberror($query);
my $ispa;
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
if ($ref->{inventory_accno_id} || $ref->{assembly}) {
# do not update if assembly consists of all services
if ($ref->{assembly}) {
$ath->execute($ref->{parts_id}) || $form->dberror($query);
($ispa) = $sth->fetchrow_array;
$ath->finish;
next unless $ispa;
}
# get item baseunit
$query = qq|SELECT unit FROM parts WHERE id = ?|;
my ($item_unit) = selectrow_query($form, $dbh, $query, $ref->{parts_id});
my $basefactor = 1;
if (defined($all_units->{$item_unit}->{factor}) && (($all_units->{$item_unit}->{factor} * 1) != 0)) {
$basefactor = $all_units->{$ref->{unit}}->{factor} / $all_units->{$item_unit}->{factor};
}
my $baseqty = $ref->{ship} * $basefactor;
# adjust onhand in parts table
$form->update_balance($dbh, "parts", "onhand", qq|id = $ref->{parts_id}|, $baseqty * $ml);
}
}
$sth->finish;
$main::lxdebug->leave_sub();
}
1;
SL/WH.pm
#====================================================================
# LX-Office ERP
# Copyright (C) 2004
# Based on SQL-Ledger Version 2.1.9
# Web http://www.lx-office.org
#
#=====================================================================
# SQL-Ledger Accounting
# Copyright (C) 1999-2003
#
# Author: Dieter Simader
# Email: dsimader@sql-ledger.org
# Web: http://www.sql-ledger.org
#
# Contributors:
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#======================================================================
#
# Warehouse module
#
#======================================================================
package WH;
use SL::AM;
use SL::DBUtils;
use SL::Form;
sub transfer {
$main::lxdebug->enter_sub();
my $self = shift;
if (!@_) {
$main::lxdebug->leave_sub();
return;
}
my $myconfig = \%main::myconfig;
my $form = $main::form;
my $dbh = $form->get_standard_dbh($myconfig);
my $units = AM->retrieve_units($myconfig, $form);
my $query = qq|SELECT * FROM transfer_type|;
my $sth = prepare_execute_query($form, $dbh, $query);
my %transfer_types;
while (my $ref = $sth->fetchrow_hashref()) {
$transfer_types{$ref->{direction}} ||= { };
$transfer_types{$ref->{direction}}->{$ref->{description}} = $ref->{id};
}
my @part_ids = map { $_->{parts_id} } @_;
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);
my ($now) = selectrow_query($form, $dbh, qq|SELECT current_date|);
$query = qq|INSERT INTO inventory (warehouse_id, bin_id, parts_id, chargenumber, oe_id, orderitems_id, shippingdate,
employee_id, project_id, trans_id, trans_type_id, comment, qty)
VALUES (?, ?, ?, ?, ?, ?, ?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?, ?, ?)|;
$sth = prepare_query($form, $dbh, $query);
my @directions = (undef, 'out', 'in', 'transfer');
while (@_) {
my $transfer = shift;
my ($trans_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
my ($direction, @values) = (0);
$direction |= 1 if ($transfer->{src_warehouse_id} && $transfer->{src_bin_id});
$direction |= 2 if ($transfer->{dst_warehouse_id} && $transfer->{dst_bin_id});
push @values, conv_i($transfer->{parts_id}), "$transfer->{chargenumber}", conv_i($transfer->{oe_id}), conv_i($transfer->{orderitems_id});
push @values, $transfer->{shippingdate} eq 'current_date' ? $now : conv_date($transfer->{shippingdate}), $form->{login}, conv_i($transfer->{project_id}), $trans_id;
if ($transfer->{transfer_type_id}) {
push @values, $transfer->{transfer_type_id};
} else {
push @values, $transfer_types{$directions[$direction]}->{$transfer->{transfer_type}};
}
push @values, "$transfer->{comment}";
$qty = $transfer->{qty};
if ($transfer->{unit}) {
my $partunit = $partunits{$transfer->{parts_id}};
$qty *= $units->{$transfer->{unit}}->{factor};
$qty /= $units->{$partunit}->{factor} || 1 if ($partunit);
}
if ($direction & 1) {
do_statement($form, $sth, $query, conv_i($transfer->{src_warehouse_id}), conv_i($transfer->{src_bin_id}), @values, $qty * -1);
}
if ($direction & 2) {
do_statement($form, $sth, $query, conv_i($transfer->{dst_warehouse_id}), conv_i($transfer->{dst_bin_id}), @values, $qty);
}
}
$sth->finish();
$dbh->commit();
$main::lxdebug->leave_sub();
}
sub get_warehouse_journal {
$main::lxdebug->enter_sub();
my $self = shift;
my %filter = @_;
my $myconfig = \%main::myconfig;
my $form = $main::form;
my $all_units = AM->retrieve_units($myconfig, $form);
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
# filters
my (@filter_ary, @filter_vars, $joins);
if ($filter{warehouse_id} ne '') {
push @filter_ary, "w1.id = ? OR w2.id = ?";
push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
}
if ($filter{bin_id} ne '') {
push @filter_ary, "b1.id = ? OR b2.id = ?";
push @filter_vars, $filter{bin_id}, $filter{bin_id};
}
if ($filter{partnumber}) {
push @filter_ary, "p.partnumber ILIKE ?";
push @filter_vars, '%' . $filter{partnumber} . '%';
}
if ($filter{description}) {
push @filter_ary, "(p.description ILIKE ?)";
push @filter_vars, '%' . $filter{description} . '%';
}
if ($filter{chargenumber}) {
push @filter_ary, "w1.chargenumber ILIKE ?";
push @filter_vars, '%' . $filter{chargenumber} . '%';
}
if ($form->{fromdate}) {
push @filter_ary, "?::DATE <= i1.itime::DATE";
push @filter_vars, $form->{fromdate};
}
if ($form->{todate}) {
push @filter_ary, "?::DATE >= i1.itime::DATE";
push @filter_vars, $form->{todate};
}
if ($form->{l_employee}) {
$joins .= "";
}
# prepare qty comparison for later filtering
my ($f_qty_op, $f_qty, $f_qty_base_unit);
if ($filter{qty_op} && defined($filter{qty}) && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
$f_qty_op = $filter{qty_op};
$f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
$f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
}
map { $_ = "(${_})"; } @filter_ary;
# if of a property number or description is requested,
# automatically check the matching id too.
map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
# customize shown entry for not available fields.
$filter{na} = '-' unless $filter{na};
# make order, search in $filter and $form
$form->{sort} = $filter{sort} unless $form->{sort};
$form->{order} = ($form->{sort} = 'itime') unless $form->{sort};
$form->{sort} = 'itime' if $form->{sort} eq "date";
$form->{order} = $filter{order} unless $form->{order};
$form->{sort} .= (($form->{order}) ? " DESC" : " ASC");
my $where_clause = join(" AND ", @filter_ary) . " AND " if (@filter_ary);
$select_tokens{'trans'} = {
"parts_id" => "i1.parts_id",
"qty" => "ABS(SUM(i1.qty))",
"partnumber" => "p.partnumber",
"partdescription" => "p.description",
"bindescription" => "b.description",
"chargenumber" => "i1.chargenumber",
"warehousedescription" => "w.description",
"partunit" => "p.unit",
"bin_from" => "b1.description",
"bin_to" => "b2.description",
"warehouse_from" => "w1.description",
"warehouse_to" => "w2.description",
"comment" => "i1.comment",
"trans_type" => "tt.description",
"trans_id" => "i1.trans_id",
"date" => "i1.itime::DATE",
"itime" => "i1.itime",
"employee" => "e.name",
"projectnumber" => "COALESCE(pr.projectnumber, '$filter{na}')",
};
$select_tokens{'out'} = {
"bin_to" => "'$filter{na}'",
"warehouse_to" => "'$filter{na}'",
};
$select_tokens{'in'} = {
"bin_from" => "'$filter{na}'",
"warehouse_from" => "'$filter{na}'",
};
# build the select clauses.
# take all the requested ones from the first hash and overwrite them from the out/in hashes if present.
for my $i ('trans', 'out', 'in') {
$select{$i} = join ', ', map { +/l_/; ($select_tokens{$i}{"$'"} || $select_tokens{'trans'}{"$'"}) . " AS r_$'" }
( grep( { !/qty$/ and /l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_qty l_partunit l_itime) );
}
my $group_clause = join ", ", map { +/^l_/; "r_$'" }
( grep( { !/qty$/ and /l_/ and $form->{$_} eq 'Y' } keys %$form), qw(l_parts_id l_partunit l_itime) );
my $query =
qq|SELECT DISTINCT $select{trans}
FROM inventory i1
LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
LEFT JOIN parts p ON i1.parts_id = p.id
LEFT JOIN bin b1 ON i1.bin_id = b1.id
LEFT JOIN bin b2 ON i2.bin_id = b2.id
LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
LEFT JOIN project pr ON i1.project_id = pr.id
LEFT JOIN employee e ON i1.employee_id = e.id
WHERE $where_clause i2.qty = -i1.qty AND i2.qty > 0 AND
i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 2 )
GROUP BY $group_clause
UNION
SELECT DISTINCT $select{out}
FROM inventory i1
LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
LEFT JOIN parts p ON i1.parts_id = p.id
LEFT JOIN bin b1 ON i1.bin_id = b1.id
LEFT JOIN bin b2 ON i2.bin_id = b2.id
LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
LEFT JOIN project pr ON i1.project_id = pr.id
LEFT JOIN employee e ON i1.employee_id = e.id
WHERE $where_clause i1.qty < 0 AND
i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
GROUP BY $group_clause
UNION
SELECT DISTINCT $select{in}
FROM inventory i1
LEFT JOIN inventory i2 ON i1.trans_id = i2.trans_id
LEFT JOIN parts p ON i1.parts_id = p.id
LEFT JOIN bin b1 ON i1.bin_id = b1.id
LEFT JOIN bin b2 ON i2.bin_id = b2.id
LEFT JOIN warehouse w1 ON i1.warehouse_id = w1.id
LEFT JOIN warehouse w2 ON i2.warehouse_id = w2.id
LEFT JOIN transfer_type tt ON i1.trans_type_id = tt.id
LEFT JOIN project pr ON i1.project_id = pr.id
LEFT JOIN employee e ON i1.employee_id = e.id
WHERE $where_clause i1.qty > 0 AND
i1.trans_id IN ( SELECT i.trans_id FROM inventory i GROUP BY i.trans_id HAVING COUNT(i.trans_id) = 1 )
GROUP BY $group_clause
ORDER BY r_$form->{sort}|;
my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars, @filter_vars, @filter_vars);
my @contents = ();
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
my $qty = $ref->{"qty"} * 1;
next unless ($qty > 0);
if ($f_qty_op) {
my $part_unit = $all_units->{$ref->{"partunit"}};
next unless ($part_unit && ($part_unit->{"base_unit"} eq $f_qty_base_unit));
$qty *= $part_unit->{"factor"};
next if (('=' eq $f_qty_op) && ($qty != $f_qty));
next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
}
push @contents, $ref;
}
$sth->finish();
$main::lxdebug->leave_sub();
return @contents;
}
#
# This sub is the primary function to retrieve information about items in warehouses.
# $filter is a hashref and supports the following keys:
# - warehouse_id - will return matches with this warehouse_id only
# - partnumber - will return only matches where the given string is a substring of the partnumber
# - partsid - will return matches with this parts_id only
# - description - will return only matches where the given string is a substring of the description
# - chargenumber - will return only matches where the given string is a substring of the chargenumber
# - charge_ids - must be an arrayref. will return contents with these ids only
# - expires_in - will only return matches that expire within the given number of days
# will also add a column named 'has_expired' containing if the match has already expired or not
# - hazardous - will return matches with the flag hazardous only
# - oil - will return matches with the flag oil only
# - qty, qty_op - quantity filter (more info to come)
# - sort, order_by - sorting (more to come)
# - reservation - will provide an extra column containing the amount reserved of this match
# note: reservation flag turns off warehouse_* or bin_* information. both together don't make sense, since reserved info is stored separately
#
sub get_warehouse_report {
$main::lxdebug->enter_sub();
my $self = shift;
my %filter = @_;
my $myconfig = \%main::myconfig;
my $form = $main::form;
my $all_units = AM->retrieve_units($myconfig, $form);
# connect to database
my $dbh = $form->get_standard_dbh($myconfig);
# filters
my (@filter_ary, @filter_vars, @wh_bin_filter_ary, @wh_bin_filter_vars, $columns, $group_by);
delete $form->{include_empty_bins} unless ($form->{l_warehousedescription} || $form->{l_bindescription});
if ($filter{warehouse_id}) {
push @wh_bin_filter_ary, "w.id = ?";
push @wh_bin_filter_vars, $filter{warehouse_id};
}
if ($filter{bin_id}) {
push @wh_bin_filter_ary, "b.id = ?";
push @wh_bin_filter_vars, $filter{bin_id};
}
push @filter_ary, @wh_bin_filter_ary;
push @filter_vars, @wh_bin_filter_vars;
if ($filter{partnumber}) {
push @filter_ary, "p.partnumber ILIKE ?";
push @filter_vars, '%' . $filter{partnumber} . '%';
}
if ($filter{description}) {
push @filter_ary, "p.description ILIKE ?";
push @filter_vars, '%' . $filter{description} . '%';
}
if ($filter{partsid}) {
push @filter_ary, "p.id = ?";
push @filter_vars, $filter{partsid};
}
if ($filter{chargenumber}) {
push @filter_ary, "i.chargenumber ILIKE ?";
push @filter_vars, '%' . $filter{chargenumber} . '%';
}
# prepare qty comparison for later filtering
my ($f_qty_op, $f_qty, $f_qty_base_unit);
if ($filter{qty_op} && defined $filter{qty} && $filter{qty_unit} && $all_units->{$filter{qty_unit}}) {
$f_qty_op = $filter{qty_op};
$f_qty = $filter{qty} * $all_units->{$filter{qty_unit}}->{factor};
$f_qty_base_unit = $all_units->{$filter{qty_unit}}->{base_unit};
}
map { $_ = "(${_})"; } @filter_ary;
# if of a property number or description is requested,
# automatically check the matching id too.
map { $form->{"l_${_}id"} = "Y" if ($form->{"l_${_}description"} || $form->{"l_${_}number"}); } qw(warehouse bin);
# make order, search in $filter and $form
$form->{sort} = $filter{sort} unless $form->{sort};
$form->{sort} = "parts_id" unless $form->{sort};
$form->{order} = $filter{order} unless $form->{order};
$form->{sort} =~ s/ASC|DESC//; # kill stuff left in from previous queries
my $orderby = $form->{sort};
$form->{sort} .= (($form->{order}) ? " DESC" : " ASC");
my $where_clause = join " AND ", ("1=1", @filter_ary);
my %select_tokens = (
"parts_id" => "i.parts_id",
"qty" => "SUM(i.qty)",
"warehouseid" => "i.warehouse_id",
"partnumber" => "p.partnumber",
"partdescription" => "p.description",
"bindescription" => "b.description",
"binid" => "b.id",
"chargenumber" => "i.chargenumber",
"chargeid" => "c.id",
"warehousedescription" => "w.description",
"partunit" => "p.unit",
);
my $select_clause = join ', ', map { +/l_/; "$select_tokens{$'} AS $'" }
( grep( { !/qty/ and /l_/ and $form->{$_} eq 'Y' } keys %$form),
qw(l_parts_id l_qty l_partunit) );
my $group_clause = join ", ", map { +/^l_/; "$'" }
( grep( { !/qty/ and /l_/ and $form->{$_} eq 'Y' } keys %$form),
qw(l_parts_id l_partunit) );
my $query =
qq|SELECT $select_clause
$columns
FROM inventory i
LEFT JOIN parts p ON i.parts_id = p.id
LEFT JOIN bin b ON i.bin_id = b.id
LEFT JOIN warehouse w ON i.warehouse_id = w.id
WHERE $where_clause
GROUP BY $group_clause $group_by
ORDER BY $form->{sort}|;
my $sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
my (%non_empty_bins, @all_fields, @contents);
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
$ref->{qty} *= 1;
my $qty = $ref->{qty};
next unless ($qty > 0);
if ($f_qty_op) {
my $part_unit = $all_units->{$ref->{partunit}};
next if (!$part_unit || ($part_unit->{base_unit} ne $f_qty_base_unit));
$qty *= $part_unit->{factor};
next if (('=' eq $f_qty_op) && ($qty != $f_qty));
next if (('>=' eq $f_qty_op) && ($qty < $f_qty));
next if (('<=' eq $f_qty_op) && ($qty > $f_qty));
}
if ($form->{include_empty_bins}) {
$non_empty_bins{$ref->{binid}} = 1;
@all_fields = keys %{ $ref } unless (@all_fields);
}
push @contents, $ref;
}
$sth->finish();
if ($form->{include_empty_bins}) {
$query =
qq|SELECT
w.id AS warehouseid, w.description AS warehousedescription,
b.id AS binid, b.description AS bindescription
FROM bin b
LEFT JOIN warehouse w ON (b.warehouse_id = w.id)|;
@filter_ary = @wh_bin_filter_ary;
@filter_vars = @wh_bin_filter_vars;
my @non_empty_bin_ids = keys %non_empty_bins;
if (@non_empty_bin_ids) {
push @filter_ary, qq|NOT b.id IN (| . join(', ', map { '?' } @non_empty_bin_ids) . qq|)|;
push @filter_vars, @non_empty_bin_ids;
}
$query .= qq| WHERE | . join(' AND ', map { "($_)" } @filter_ary) if (@filter_ary);
$sth = prepare_execute_query($form, $dbh, $query, @filter_vars);
while ($ref = $sth->fetchrow_hashref()) {
map { $ref->{$_} ||= "" } @all_fields;
push @contents, $ref;
}
$sth->finish();
if (grep { $orderby eq $_ } qw(bindescription warehousedescription)) {
@contents = sort { ($a->{$orderby} cmp $b->{$orderby}) * (($form->{order}) ? 1 : -1) } @contents;
}
}
$main::lxdebug->leave_sub();
return @contents;
}
sub convert_qty_op {
$main::lxdebug->enter_sub();
my ($self, $qty_op) = @_;
if (!$qty_op || ($qty_op eq "dontcare")) {
$main::lxdebug->leave_sub();
return undef;
}
if ($qty_op eq "atleast") {
$qty_op = '>=';
} elsif ($qty_op eq "atmost") {
$qty_op = '<=';
} else {
$qty_op = '=';
}
$main::lxdebug->leave_sub();
return $qty_op;
}
sub retrieve_transfer_types {
$main::lxdebug->enter_sub();
my $self = shift;
my $direction = shift;
my $myconfig = \%main::myconfig;
my $form = $main::form;
my $dbh = $form->get_standard_dbh($myconfig);
my $types = selectall_hashref_query($form, $dbh, qq|SELECT * FROM transfer_type WHERE direction = ? ORDER BY sortkey|, $direction);
$main::lxdebug->leave_sub();
return $types;
}
sub get_basic_bin_info {
$main::lxdebug->enter_sub();
my $self = shift;
my %params = @_;
Common::check_params(\%params, qw(id));
my $myconfig = \%main::myconfig;
my $form = $main::form;
my $dbh = $params{dbh} || $form->get_standard_dbh();
my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
my $query =
qq|SELECT b.id AS bin_id, b.description AS bin_description,
w.id AS warehouse_id, w.description AS warehouse_description
FROM bin b
LEFT JOIN warehouse w ON (b.warehouse_id = w.id)
WHERE b.id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
my $result = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
if ('' eq ref $params{id}) {
$result = $result->[0] || { };
$main::lxdebug->leave_sub();
return $result;
}
$main::lxdebug->leave_sub();
return map { $_->{bin_id} => $_ } @{ $result };
}
1;
bin/mozilla/am.pl
$lxdebug->leave_sub();
}
sub add_warehouse {
$lxdebug->enter_sub();
$auth->assert('config');
$form->{title} = $locale->text('Add Warehouse');
$form->{callback} ||= build_std_url('action=add_warehouse');
$form->{fokus} = 'description';
$form->header();
print $form->parse_html_template('am/edit_warehouse');
$lxdebug->leave_sub();
}
sub edit_warehouse {
$lxdebug->enter_sub();
$auth->assert('config');
AM->get_warehouse(\%myconfig, $form);
$form->get_lists('employees' => 'EMPLOYEES');
$form->{title} = $locale->text('Edit Warehouse');
$form->{callback} ||= build_std_url('action=list_warehouses');
$form->{fokus} = 'description';
$form->header();
print $form->parse_html_template('am/edit_warehouse');
$lxdebug->leave_sub();
}
sub list_warehouses {
$lxdebug->enter_sub();
$auth->assert('config');
AM->get_all_warehouses(\%myconfig, $form);
my $previous;
foreach my $current (@{ $form->{WAREHOUSES} }) {
if ($previous) {
$previous->{next_id} = $current->{id};
$current->{previous_id} = $previous->{id};
}
$previous = $current;
}
$form->{callback} = build_std_url('action=list_warehouses');
$form->{title} = $locale->text('Warehouses');
$form->{url_base} = build_std_url('callback');
$form->header();
print $form->parse_html_template('am/list_warehouses');
$lxdebug->leave_sub();
}
sub save_warehouse {
$lxdebug->enter_sub();
$auth->assert('config');
$form->isblank("description", $locale->text('Description missing!'));
$form->{number_of_new_bins} = $form->parse_amount(\%myconfig, $form->{number_of_new_bins});
AM->save_warehouse(\%myconfig, $form);
$form->{callback} .= '&saved_message=' . E($locale->text('Warehouse saved.')) if ($form->{callback});
$form->redirect($locale->text('Warehouse saved.'));
$lxdebug->leave_sub();
}
sub swap_warehouses {
$lxdebug->enter_sub();
$auth->assert('config');
AM->swap_sortkeys(\%myconfig, $form, 'warehouse');
list_warehouses();
$lxdebug->leave_sub();
}
sub delete_warehouse {
$lxdebug->enter_sub();
$auth->assert('config');
if (!$form->{confirmed}) {
$form->{title} = $locale->text('Confirmation');
$form->header();
print $form->parse_html_template('am/confirm_delete_warehouse');
exit 0;
}
if (AM->delete_warehouse(\%myconfig, $form)) {
$form->{callback} .= '&saved_message=' . E($locale->text('Warehouse deleted.')) if ($form->{callback});
$form->redirect($locale->text('Warehouse deleted.'));
} else {
$form->error($locale->text('The warehouse could not be deleted because it has already been used.'));
}
$lxdebug->leave_sub();
}
sub save_bin {
$lxdebug->enter_sub();
$auth->assert('config');
AM->save_bins(\%myconfig, $form);
$form->{callback} .= '&saved_message=' . E($locale->text('Bins saved.')) if ($form->{callback});
$form->redirect($locale->text('Bins saved.'));
$lxdebug->leave_sub();
}
bin/mozilla/common.pl
# -------------------------------------------------------------------------
sub select_part {
$lxdebug->enter_sub();
my ($callback_sub, @parts) = @_;
my $remap_parts_id = 0;
if (defined($parts[0]->{parts_id}) && !defined($parts[0]->{id})) {
$remap_parts_id = 1;
map { $_->{id} = $_->{parts_id}; } @parts;
}
my $remap_partnumber = 0;
if (defined($parts[0]->{partnumber}) && !defined($parts[0]->{number})) {
$remap_partnumber = 1;
map { $_->{number} = $_->{partnumber}; } @parts;
}
my $has_charge = 0;
if (defined($parts[0]->{chargenumber})) {
$has_charge = 1;
map { $_->{has_charge} = 1; } @parts;
}
my $old_form = save_form();
$form->header();
print $form->parse_html_template("generic/select_part",
{ "PARTS" => \@parts,
"old_form" => $old_form,
"title" => $locale->text("Select a part"),
"nextsub" => "select_part_internal",
"callback_sub" => $callback_sub,
"has_charge" => $has_charge,
"remap_parts_id" => $remap_parts_id,
"remap_partnumber" => $remap_partnumber });
$lxdebug->leave_sub();
}
sub select_part_internal {
$lxdebug->enter_sub();
my ($new_item, $callback_sub);
my $re = "^new_.*_" . $form->{selection};
foreach (grep /$re/, keys %{ $form }) {
my $new_key = $_;
$new_key =~ s/^new_//;
$new_key =~ s/_\d+$//;
$new_item->{$new_key} = $form->{$_};
}
if ($form->{remap_parts_id}) {
$new_item->{parts_id} = $new_item->{id};
delete $new_item->{id};
}
if ($form->{remap_partnumber}) {
$new_item->{partnumber} = $new_item->{number};
delete $new_item->{number};
}
my $callback_sub = $form->{callback_sub};
restore_form($form->{old_form});
call_sub($callback_sub, $new_item);
$lxdebug->leave_sub();
}
sub part_selection_internal {
$lxdebug->enter_sub();
$order_by = "description";
$order_by = $form->{"order_by"} if (defined($form->{"order_by"}));
$order_dir = 1;
$order_dir = $form->{"order_dir"} if (defined($form->{"order_dir"}));
%options = map { $_ => 1 } split m/:/, $form->{options};
map { $form->{$_} = 1 if ($options{$_}) } qw(no_services no_assemblies stockable);
$parts = Common->retrieve_parts(\%myconfig, $form, $order_by, $order_dir);
if (0 == scalar(@{$parts})) {
$form->show_generic_information($locale->text("No part was found matching the search parameters."));
} elsif (1 == scalar(@{$parts})) {
$onload = "part_selected('1')";
}
map { $parts->[$_]->{selected} = $_ ? 0 : 1; } (0..$#{$parts});
my $callback = build_std_url('action=part_selection_internal', qw(partnumber description input_partnumber input_description input_partsid),
grep({ /^[fl]_/ } keys %{ $form }));
my @header_sort = qw(partnumber description);
my %header_title = ( "partnumber" => $locale->text("Part Number"),
"description" => $locale->text("Part description"),
);
my @header =
map(+{ "column_title" => $header_title{$_},
"column" => $_,
"callback" => $callback . "order_by=${_}&order_dir=" . ($order_by eq $_ ? 1 - $order_dir : $order_dir),
},
@header_sort);
$form->{title} = $locale->text("Select a part");
$form->header();
print $form->parse_html_template("generic/part_selection", { "HEADER" => \@header,
"PARTS" => $parts,
"onload" => $onload });
$lxdebug->leave_sub();
}
# -------------------------------------------------------------------------
sub delivery_customer_selection {
$lxdebug->enter_sub();
bin/mozilla/wh.pl
#=====================================================================
# LX-Office ERP
# Copyright (C) 2004
# Based on SQL-Ledger Version 2.1.9
# Web http://www.lx-office.org
#############################################################################
# SQL-Ledger, Accounting
# Copyright (c) 1998-2002
#
# Author: Dieter Simader
# Email: dsimader@sql-ledger.org
# Web: http://www.sql-ledger.org
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#######################################################################
#
# warehouse and packinglist
#
#######################################################################
use List::Util qw(min max first);
use POSIX qw(strftime);
use SL::Form;
use SL::User;
use SL::AM;
use SL::CT;
use SL::IC;
use SL::WH;
use SL::OE;
use SL::ReportGenerator;
use Data::Dumper;
require "bin/mozilla/common.pl";
require "bin/mozilla/reportgenerator.pl";
# parserhappy(R):
# contents of the "transfer_type" table:
# $locale->text('back')
# $locale->text('correction')
# $locale->text('disposed')
# $locale->text('found')
# $locale->text('missing')
# $locale->text('stock')
# $locale->text('transfer')
# $locale->text('used')
# $locale->text('return_material')
# $locale->text('release_material')
# --------------------------------------------------------------------
# Transfer
# --------------------------------------------------------------------
sub transfer_warehouse_selection {
$lxdebug->enter_sub();
$auth->assert('warehouse_management');
... Dieser Diff wurde abgeschnitten, weil er die maximale Anzahl anzuzeigender Zeilen überschreitet.

Auch abrufbar als: Unified diff