|
#====================================================================
|
|
# 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., 51 Franklin Street, Fifth Floor, Boston,
|
|
# MA 02110-1335, USA.
|
|
#======================================================================
|
|
#
|
|
# Warehouse module
|
|
#
|
|
#======================================================================
|
|
|
|
package WH;
|
|
|
|
use Carp qw(croak);
|
|
use List::MoreUtils qw(any);
|
|
|
|
use SL::AM;
|
|
use SL::DBUtils;
|
|
use SL::DB::Inventory;
|
|
use SL::Form;
|
|
use SL::Locale::String qw(t8);
|
|
use SL::Util qw(trim);
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
sub transfer {
|
|
$::lxdebug->enter_sub;
|
|
|
|
my ($self, @args) = @_;
|
|
|
|
if (!@args) {
|
|
$::lxdebug->leave_sub;
|
|
return;
|
|
}
|
|
|
|
require SL::DB::TransferType;
|
|
require SL::DB::Part;
|
|
require SL::DB::Employee;
|
|
|
|
my $employee = SL::DB::Manager::Employee->current;
|
|
my ($now) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
|
|
my @directions = (undef, qw(out in transfer));
|
|
|
|
my $objectify = sub {
|
|
my ($transfer, $field, $class, @find_by) = @_;
|
|
|
|
@find_by = (description => $transfer->{$field}) unless @find_by;
|
|
|
|
if ($transfer->{$field} || $transfer->{"${field}_id"}) {
|
|
return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
|
|
: $transfer->{$field} ? $class->_get_manager_class->find_by(@find_by)
|
|
: $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
|
|
}
|
|
return;
|
|
};
|
|
|
|
my @trans_ids;
|
|
|
|
my $db = SL::DB::Inventory->new->db;
|
|
$db->with_transaction(sub{
|
|
while (my $transfer = shift @args) {
|
|
my $trans_id;
|
|
($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|) if $transfer->{qty};
|
|
|
|
my $part = $objectify->($transfer, 'parts', 'SL::DB::Part');
|
|
my $unit = $objectify->($transfer, 'unit', 'SL::DB::Unit', name => $transfer->{unit});
|
|
my $qty = $transfer->{qty};
|
|
my $src_bin = $objectify->($transfer, 'src_bin', 'SL::DB::Bin');
|
|
my $dst_bin = $objectify->($transfer, 'dst_bin', 'SL::DB::Bin');
|
|
my $src_wh = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
|
|
my $dst_wh = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
|
|
my $project = $objectify->($transfer, 'project', 'SL::DB::Project');
|
|
|
|
$src_wh ||= $src_bin->warehouse if $src_bin;
|
|
$dst_wh ||= $dst_bin->warehouse if $dst_bin;
|
|
|
|
my $direction = 0; # bit mask
|
|
$direction |= 1 if $src_bin;
|
|
$direction |= 2 if $dst_bin;
|
|
|
|
my $transfer_type_id;
|
|
if ($transfer->{transfer_type_id}) {
|
|
$transfer_type_id = $transfer->{transfer_type_id};
|
|
} else {
|
|
my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction => $directions[$direction],
|
|
description => $transfer->{transfer_type});
|
|
$transfer_type_id = $transfer_type->id;
|
|
}
|
|
|
|
my $stocktaking_qty = $transfer->{stocktaking_qty};
|
|
|
|
my %params = (
|
|
part => $part,
|
|
employee => $employee,
|
|
trans_type_id => $transfer_type_id,
|
|
project => $project,
|
|
trans_id => $trans_id,
|
|
shippingdate => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
|
|
? $now : $transfer->{shippingdate},
|
|
map { $_ => $transfer->{$_} } qw(chargenumber bestbefore oe_id delivery_order_items_stock_id invoice_id comment),
|
|
);
|
|
|
|
if ($unit) {
|
|
$qty = $unit->convert_to($qty, $part->unit_obj);
|
|
$stocktaking_qty = $unit->convert_to($stocktaking_qty, $part->unit_obj);
|
|
}
|
|
|
|
$params{chargenumber} ||= '';
|
|
|
|
my @inventories;
|
|
if ($qty && $direction & 1) {
|
|
push @inventories, SL::DB::Inventory->new(
|
|
%params,
|
|
warehouse => $src_wh,
|
|
bin => $src_bin,
|
|
qty => $qty * -1,
|
|
)->save;
|
|
}
|
|
|
|
if ($qty && $direction & 2) {
|
|
push @inventories, SL::DB::Inventory->new(
|
|
%params,
|
|
warehouse => $dst_wh->id,
|
|
bin => $dst_bin->id,
|
|
qty => $qty,
|
|
)->save;
|
|
# Standardlagerplatz in Stammdaten gleich mitverschieben
|
|
if (defined($transfer->{change_default_bin})){
|
|
$part->update_attributes(warehouse_id => $dst_wh->id, bin_id => $dst_bin->id);
|
|
}
|
|
}
|
|
|
|
# Record stocktaking if requested.
|
|
# This is only possible if transfer was a stock in or stock out,
|
|
# but not both (transfer).
|
|
if ($transfer->{record_stocktaking}) {
|
|
die 'Stocktaking can only be recorded for stock in or stock out, but not on a transfer.' if scalar @inventories > 1;
|
|
|
|
my $inventory_id;
|
|
$inventory_id = $inventories[0]->id if $inventories[0];
|
|
|
|
SL::DB::Stocktaking->new(
|
|
inventory_id => $inventory_id,
|
|
warehouse => $src_wh || $dst_wh,
|
|
bin => $src_bin || $dst_bin,
|
|
parts_id => $part->id,
|
|
employee_id => $employee->id,
|
|
qty => $stocktaking_qty,
|
|
comment => $transfer->{comment},
|
|
cutoff_date => $transfer->{stocktaking_cutoff_date},
|
|
chargenumber => $transfer->{chargenumber},
|
|
bestbefore => $transfer->{bestbefore},
|
|
)->save;
|
|
|
|
}
|
|
|
|
push @trans_ids, $trans_id;
|
|
}
|
|
|
|
1;
|
|
}) or do {
|
|
$::form->error("Warehouse transfer error: " . join("\n", (split(/\n/, $db->error))[0..2]));
|
|
};
|
|
|
|
$::lxdebug->leave_sub;
|
|
|
|
return @trans_ids;
|
|
}
|
|
|
|
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, %select_tokens, %select);
|
|
|
|
if ($filter{warehouse_id}) {
|
|
push @filter_ary, "w1.id = ? OR w2.id = ?";
|
|
push @filter_vars, $filter{warehouse_id}, $filter{warehouse_id};
|
|
}
|
|
|
|
if ($filter{bin_id}) {
|
|
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, like($filter{partnumber});
|
|
}
|
|
|
|
if ($filter{description}) {
|
|
push @filter_ary, "(p.description ILIKE ?)";
|
|
push @filter_vars, like($filter{description});
|
|
}
|
|
|
|
if ($filter{classification_id}) {
|
|
push @filter_ary, "p.classification_id = ?";
|
|
push @filte |