Projekt

Allgemein

Profil

Herunterladen (56 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/IC.pm @ 79ae46a4

4d0f405c Sven Schöling
#=====================================================================
d319704a Moritz Bunkus
# 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) 2001
#
# 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.
#======================================================================
#
# Inventory Control backend
#
#======================================================================

package IC;
8c7e4493 Moritz Bunkus
07d71c33 Stephan Köhler
use Data::Dumper;
60ebd03b Sven Schöling
use List::MoreUtils qw(all any uniq);
8c7e4493 Moritz Bunkus
use YAML;

b2f44e3d Moritz Bunkus
use SL::CVar;
08aa44f6 Sven Schöling
use SL::DBUtils;
df0d4d3f Moritz Bunkus
use SL::TransNumber;
081a4f97 Moritz Bunkus
80f6efd0 Sven Schöling
use strict;

d319704a Moritz Bunkus
sub get_part {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

# connect to db
my $dbh = $form->dbconnect($myconfig);

2a9ed0d5 Moritz Bunkus
my $sth;

my $query =
qq|SELECT p.*,
c1.accno AS inventory_accno,
c2.accno AS income_accno,
c3.accno AS expense_accno,
pg.partsgroup
FROM parts p
LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id)
LEFT JOIN chart c2 ON (p.income_accno_id = c2.id)
LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id)
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE p.id = ? |;
my $ref = selectfirst_hashref_query($form, $dbh, $query, conv_i($form->{id}));
d319704a Moritz Bunkus
# copy to $form variables
map { $form->{$_} = $ref->{$_} } (keys %{$ref});

8c7e4493 Moritz Bunkus
$form->{onhand} *= 1;

d319704a Moritz Bunkus
# part or service item
$form->{item} = ($form->{inventory_accno}) ? 'part' : 'service';
if ($form->{assembly}) {
$form->{item} = 'assembly';

# retrieve assembly items
2a9ed0d5 Moritz Bunkus
$query =
qq|SELECT p.id, p.partnumber, p.description,
b3eb24ef Geoffrey Richardson
p.sellprice, p.lastcost, p.weight, a.qty, a.bom, p.unit,
73c6a726 Sven Schöling
pg.partsgroup, p.price_factor_id, pfac.factor AS price_factor
2a9ed0d5 Moritz Bunkus
FROM parts p
JOIN assembly a ON (a.parts_id = p.id)
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
73c6a726 Sven Schöling
LEFT JOIN price_factors pfac ON pfac.id = p.price_factor_id
2a9ed0d5 Moritz Bunkus
WHERE (a.id = ?)
5b2980ad Sven Schöling
ORDER BY a.oid|;
2a9ed0d5 Moritz Bunkus
$sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{id}));

d319704a Moritz Bunkus
$form->{assembly_rows} = 0;
594f0e99 Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
d319704a Moritz Bunkus
$form->{assembly_rows}++;
foreach my $key (keys %{$ref}) {
$form->{"${key}_$form->{assembly_rows}"} = $ref->{$key};
}
}
$sth->finish;

}

# setup accno hash for <option checked> {amount} is used in create_links
$form->{amount}{IC} = $form->{inventory_accno};
$form->{amount}{IC_income} = $form->{income_accno};
$form->{amount}{IC_sale} = $form->{income_accno};
$form->{amount}{IC_expense} = $form->{expense_accno};
$form->{amount}{IC_cogs} = $form->{expense_accno};

07d71c33 Stephan Köhler
# get prices
7c2886a7 Moritz Bunkus
$query = <<SQL;
SELECT pg.pricegroup, pg.id AS pricegroup_id, COALESCE(pr.price, 0) AS price
FROM pricegroup pg
LEFT JOIN prices pr ON (pr.pricegroup_id = pg.id) AND (pr.parts_id = ?)
ORDER BY lower(pg.pricegroup)
SQL

my $row = 1;
foreach $ref (selectall_hashref_query($form, $dbh, $query, conv_i($form->{id}))) {
$form->{"${_}_${row}"} = $ref->{$_} for qw(pricegroup_id pricegroup price);
$row++;
07d71c33 Stephan Köhler
}
7c2886a7 Moritz Bunkus
$form->{price_rows} = $row - 1;
07d71c33 Stephan Köhler
f0d897b6 Sven Schöling
# get makes
if ($form->{makemodel}) {
#hli
$query = qq|SELECT m.make, m.model,m.lastcost,m.lastcost,m.lastupdate,m.sortorder FROM makemodel m | .
qq|WHERE m.parts_id = ? order by m.sortorder asc|;
my @values = ($form->{id});
$sth = $dbh->prepare($query);
$sth->execute(@values) || $form->dberror("$query (" . join(', ', @values) . ")");

my $i = 1;

while (($form->{"make_$i"}, $form->{"model_$i"}, $form->{"old_lastcost_$i"},
$form->{"lastcost_$i"}, $form->{"lastupdate_$i"}, $form->{"sortorder_$i"}) = $sth->fetchrow_array)
{
$i++;
d319704a Moritz Bunkus
}
f0d897b6 Sven Schöling
$sth->finish;
$form->{makemodel_rows} = $i - 1;

d319704a Moritz Bunkus
}

54e4131e Moritz Bunkus
# get translations
$form->{language_values} = "";
0c4036d2 Moritz Bunkus
$query = qq|SELECT language_id, translation, longdescription
FROM translation
WHERE parts_id = ?|;
2a9ed0d5 Moritz Bunkus
my $trq = prepare_execute_query($form, $dbh, $query, conv_i($form->{id}));
594f0e99 Sven Schöling
while (my $tr = $trq->fetchrow_hashref("NAME_lc")) {
0c4036d2 Moritz Bunkus
$form->{language_values} .= "---+++---" . join('--++--', @{$tr}{qw(language_id translation longdescription)});
54e4131e Moritz Bunkus
}
$trq->finish;

d319704a Moritz Bunkus
# is it an orphan
37ffd321 Niclas Zimmermann
my @referencing_tables = qw(invoice orderitems inventory);
d0779d01 Moritz Bunkus
my %column_map = ( );
my $parts_id = conv_i($form->{id});
2a9ed0d5 Moritz Bunkus
d0779d01 Moritz Bunkus
$form->{orphaned} = 1;
2a9ed0d5 Moritz Bunkus
d0779d01 Moritz Bunkus
foreach my $table (@referencing_tables) {
my $column = $column_map{$table} || 'parts_id';
$query = qq|SELECT $column FROM $table WHERE $column = ? LIMIT 1|;
my ($found) = selectrow_query($form, $dbh, $query, $parts_id);
d319704a Moritz Bunkus
d0779d01 Moritz Bunkus
if ($found) {
$form->{orphaned} = 0;
54e4131e Moritz Bunkus
last;
}
}

d0779d01 Moritz Bunkus
$form->{"unit_changeable"} = $form->{orphaned};

d319704a Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

07d71c33 Stephan Köhler
sub get_pricegroups {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

2a9ed0d5 Moritz Bunkus
my $dbh = $form->dbconnect($myconfig);
07d71c33 Stephan Köhler
2a9ed0d5 Moritz Bunkus
# get pricegroups
7c2886a7 Moritz Bunkus
my $query = qq|SELECT id, pricegroup FROM pricegroup ORDER BY lower(pricegroup)|;
2a9ed0d5 Moritz Bunkus
my $pricegroups = selectall_hashref_query($form, $dbh, $query);
07d71c33 Stephan Köhler
2a9ed0d5 Moritz Bunkus
my $i = 1;
1cf7af35 Sven Schöling
foreach my $pg (@{ $pricegroups }) {
2a9ed0d5 Moritz Bunkus
$form->{"klass_$i"} = "$pg->{id}";
$form->{"price_$i"} = $form->format_amount($myconfig, $form->{"price_$i"}, -2);
$form->{"pricegroup_id_$i"} = "$pg->{id}";
$form->{"pricegroup_$i"} = "$pg->{pricegroup}";
$i++;
07d71c33 Stephan Köhler
}

#correct rows
$form->{price_rows} = $i - 1;

$dbh->disconnect;

$main::lxdebug->leave_sub();
12240c79 Sven Schöling
return $pricegroups;
07d71c33 Stephan Köhler
}

54e4131e Moritz Bunkus
sub retrieve_buchungsgruppen {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

my ($query, $sth);

my $dbh = $form->dbconnect($myconfig);

# get buchungsgruppen
2a9ed0d5 Moritz Bunkus
$query = qq|SELECT id, description FROM buchungsgruppen ORDER BY sortkey|;
$form->{BUCHUNGSGRUPPEN} = selectall_hashref_query($form, $dbh, $query);
54e4131e Moritz Bunkus
$main::lxdebug->leave_sub();
}

d319704a Moritz Bunkus
sub save {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;
2a9ed0d5 Moritz Bunkus
my @values;
d319704a Moritz Bunkus
# connect to database, turn off AutoCommit
af281b3c Moritz Bunkus
my $dbh = $form->get_standard_dbh;
d319704a Moritz Bunkus
# save the part
# make up a unique handle and store in partnumber field
# then retrieve the record based on the unique handle to get the id
# replace the partnumber field with the actual variable
# add records for makemodel

# if there is a $form->{id} then replace the old entry
# delete all makemodel entries and add the new ones

# undo amount formatting
map { $form->{$_} = $form->parse_amount($myconfig, $form->{$_}) }
550a75a6 Geoffrey Richardson
qw(rop weight listprice sellprice gv lastcost);
d319704a Moritz Bunkus
2a9ed0d5 Moritz Bunkus
my $makemodel = (($form->{make_1}) || ($form->{model_1})) ? 1 : 0;
d319704a Moritz Bunkus
$form->{assembly} = ($form->{item} eq 'assembly') ? 1 : 0;

my ($query, $sth);

8071d62e Moritz Bunkus
my $priceupdate = ', priceupdate = current_date';

d319704a Moritz Bunkus
if ($form->{id}) {
df0d4d3f Moritz Bunkus
my $trans_number = SL::TransNumber->new(type => $form->{item}, dbh => $dbh, number => $form->{partnumber}, id => $form->{id});
if (!$trans_number->is_unique) {
$::lxdebug->leave_sub;
return 3;
}
d319704a Moritz Bunkus
# get old price
2a9ed0d5 Moritz Bunkus
$query = qq|SELECT sellprice, weight FROM parts WHERE id = ?|;
my ($sellprice, $weight) = selectrow_query($form, $dbh, $query, conv_i($form->{id}));
d319704a Moritz Bunkus
# if item is part of an assembly adjust all assemblies
2a9ed0d5 Moritz Bunkus
$query = qq|SELECT id, qty FROM assembly WHERE parts_id = ?|;
$sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{id}));
d319704a Moritz Bunkus
while (my ($id, $qty) = $sth->fetchrow_array) {
&update_assembly($dbh, $form, $id, $qty, $sellprice * 1, $weight * 1);
}
$sth->finish;

f0d897b6 Sven Schöling
# delete makemodel records
do_query($form, $dbh, qq|DELETE FROM makemodel WHERE parts_id = ?|, conv_i($form->{id}));
d319704a Moritz Bunkus
if ($form->{item} eq 'assembly') {
# delete assembly records
2a9ed0d5 Moritz Bunkus
do_query($form, $dbh, qq|DELETE FROM assembly WHERE id = ?|, conv_i($form->{id}));
d319704a Moritz Bunkus
}

54e4131e Moritz Bunkus
# delete translations
2a9ed0d5 Moritz Bunkus
do_query($form, $dbh, qq|DELETE FROM translation WHERE parts_id = ?|, conv_i($form->{id}));
54e4131e Moritz Bunkus
8071d62e Moritz Bunkus
# Check whether or not the prices have changed. If they haven't
# then 'priceupdate' should not be updated.
my $previous_values = selectfirst_hashref_query($form, $dbh, qq|SELECT * FROM parts WHERE id = ?|, conv_i($form->{id})) || {};
d6369b1f Moritz Bunkus
$priceupdate = '' if (all { $previous_values->{$_} == $form->{$_} } qw(sellprice lastcost listprice));
8071d62e Moritz Bunkus
d319704a Moritz Bunkus
} else {
df0d4d3f Moritz Bunkus
my $trans_number = SL::TransNumber->new(type => $form->{item}, dbh => $dbh, number => $form->{partnumber}, save => 1);

if ($form->{partnumber} && !$trans_number->is_unique) {
$::lxdebug->leave_sub;
d319704a Moritz Bunkus
return 3;
}

c4d0fd51 Moritz Bunkus
$form->{partnumber} ||= $trans_number->create_unique;
df0d4d3f Moritz Bunkus
d8c2fd90 Moritz Bunkus
($form->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
41293e59 Jan Büren
do_query($form, $dbh, qq|INSERT INTO parts (id, partnumber, unit) VALUES (?, ?, ?)|, $form->{id}, $form->{partnumber}, $form->{unit});
d319704a Moritz Bunkus
$form->{orphaned} = 1;
}
23a596b9 Moritz Bunkus
my $partsgroup_id = undef;
d319704a Moritz Bunkus
if ($form->{partsgroup}) {
1cf7af35 Sven Schöling
(my $partsgroup, $partsgroup_id) = split(/--/, $form->{partsgroup});
d319704a Moritz Bunkus
}

b80a03a9 Moritz Bunkus
my ($subq_inventory, $subq_expense, $subq_income);
if ($form->{"item"} eq "part") {
$subq_inventory =
2a9ed0d5 Moritz Bunkus
qq|(SELECT bg.inventory_accno_id
FROM buchungsgruppen bg
WHERE bg.id = | . conv_i($form->{"buchungsgruppen_id"}, 'NULL') . qq|)|;
b80a03a9 Moritz Bunkus
} else {
$subq_inventory = "NULL";
}

if ($form->{"item"} ne "assembly") {
$subq_expense =
2a9ed0d5 Moritz Bunkus
qq|(SELECT bg.expense_accno_id_0
FROM buchungsgruppen bg
WHERE bg.id = | . conv_i($form->{"buchungsgruppen_id"}, 'NULL') . qq|)|;
b80a03a9 Moritz Bunkus
} else {
$subq_expense = "NULL";
}

2a9ed0d5 Moritz Bunkus
$query =
qq|UPDATE parts SET
partnumber = ?,
description = ?,
makemodel = ?,
alternate = 'f',
assembly = ?,
listprice = ?,
sellprice = ?,
lastcost = ?,
weight = ?,
unit = ?,
notes = ?,
formel = ?,
rop = ?,
bin = ?,
buchungsgruppen_id = ?,
payment_id = ?,
inventory_accno_id = $subq_inventory,
income_accno_id = (SELECT bg.income_accno_id_0 FROM buchungsgruppen bg WHERE bg.id = ?),
expense_accno_id = $subq_expense,
obsolete = ?,
image = ?,
drawing = ?,
shop = ?,
ve = ?,
gv = ?,
ean = ?,
bb55aa59 Holger Lindemann
has_sernumber = ?,
2a9ed0d5 Moritz Bunkus
not_discountable = ?,
microfiche = ?,
1e251313 Moritz Bunkus
partsgroup_id = ?,
price_factor_id = ?
8071d62e Moritz Bunkus
$priceupdate
2a9ed0d5 Moritz Bunkus
WHERE id = ?|;
@values = ($form->{partnumber},
$form->{description},
$makemodel ? 't' : 'f',
$form->{assembly} ? 't' : 'f',
$form->{listprice},
$form->{sellprice},
$form->{lastcost},
$form->{weight},
$form->{unit},
$form->{notes},
$form->{formel},
$form->{rop},
$form->{bin},
conv_i($form->{buchungsgruppen_id}),
conv_i($form->{payment_id}),
conv_i($form->{buchungsgruppen_id}),
$form->{obsolete} ? 't' : 'f',
$form->{image},
$form->{drawing},
$form->{shop} ? 't' : 'f',
conv_i($form->{ve}),
conv_i($form->{gv}),
$form->{ean},
bb55aa59 Holger Lindemann
$form->{has_sernumber} ? 't' : 'f',
2a9ed0d5 Moritz Bunkus
$form->{not_discountable} ? 't' : 'f',
$form->{microfiche},
conv_i($partsgroup_id),
1e251313 Moritz Bunkus
conv_i($form->{price_factor_id}),
2a9ed0d5 Moritz Bunkus
conv_i($form->{id})
);
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
54e4131e Moritz Bunkus
# delete translation records
2a9ed0d5 Moritz Bunkus
do_query($form, $dbh, qq|DELETE FROM translation WHERE parts_id = ?|, conv_i($form->{id}));
54e4131e Moritz Bunkus
if ($form->{language_values} ne "") {
1cf7af35 Sven Schöling
foreach my $item (split(/---\+\+\+---/, $form->{language_values})) {
2a9ed0d5 Moritz Bunkus
my ($language_id, $translation, $longdescription) = split(/--\+\+--/, $item);
54e4131e Moritz Bunkus
if ($translation ne "") {
2a9ed0d5 Moritz Bunkus
$query = qq|INSERT into translation (parts_id, language_id, translation, longdescription)
VALUES ( ?, ?, ?, ? )|;
@values = (conv_i($form->{id}), conv_i($language_id), $translation, $longdescription);
do_query($form, $dbh, $query, @values);
54e4131e Moritz Bunkus
}
}
}
2a9ed0d5 Moritz Bunkus
07d71c33 Stephan Köhler
# delete price records
2a9ed0d5 Moritz Bunkus
do_query($form, $dbh, qq|DELETE FROM prices WHERE parts_id = ?|, conv_i($form->{id}));

0d190035 Moritz Bunkus
$query = qq|INSERT INTO prices (parts_id, pricegroup_id, price) VALUES(?, ?, ?)|;
$sth = prepare_query($form, $dbh, $query);

07d71c33 Stephan Köhler
# insert price records only if different to sellprice
for my $i (1 .. $form->{price_rows}) {
41fd494a Sven Schöling
my $price = $form->parse_amount($myconfig, $form->{"price_$i"});
0d190035 Moritz Bunkus
next unless $price && ($price != $form->{sellprice});

@values = (conv_i($form->{id}), conv_i($form->{"pricegroup_id_$i"}), $price);
do_statement($form, $sth, $query, @values);
07d71c33 Stephan Köhler
}

0d190035 Moritz Bunkus
$sth->finish;

d319704a Moritz Bunkus
# insert makemodel records
85ffde7a Holger Lindemann
my $lastupdate = '';
my $value = 0;
d319704a Moritz Bunkus
for my $i (1 .. $form->{makemodel_rows}) {
if (($form->{"make_$i"}) || ($form->{"model_$i"})) {
85ffde7a Holger Lindemann
#hli
$value = $form->parse_amount($myconfig, $form->{"lastcost_$i"});
9a7a811d Bernd Bleßmann
if ($value == $form->parse_amount($myconfig, $form->{"old_lastcost_$i"}))
85ffde7a Holger Lindemann
{
38f76dd9 Sven Schöling
if ($form->{"lastupdate_$i"} eq "") {
a9a6bc13 Holger Lindemann
$lastupdate = 'now()';
} else {
$lastupdate = $dbh->quote($form->{"lastupdate_$i"});
}
85ffde7a Holger Lindemann
} else {
$lastupdate = 'now()';
}
$query = qq|INSERT INTO makemodel (parts_id, make, model, lastcost, lastupdate, sortorder) | .
qq|VALUES (?, ?, ?, ?, ?, ?)|;
@values = (conv_i($form->{id}), conv_i($form->{"make_$i"}), $form->{"model_$i"}, $value, $lastupdate, conv_i($form->{"sortorder_$i"}) );
4bbf708c Geoffrey Richardson
2a9ed0d5 Moritz Bunkus
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
}
}

# add assembly records
if ($form->{item} eq 'assembly') {

for my $i (1 .. $form->{assembly_rows}) {
$form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});

if ($form->{"qty_$i"} != 0) {
$form->{"bom_$i"} *= 1;
2a9ed0d5 Moritz Bunkus
$query = qq|INSERT INTO assembly (id, parts_id, qty, bom) | .
c09536f4 Sven Schöling
qq|VALUES (?, ?, ?, ?)|;
@values = (conv_i($form->{id}), conv_i($form->{"id_$i"}), conv_i($form->{"qty_$i"}), $form->{"bom_$i"} ? 't' : 'f');
2a9ed0d5 Moritz Bunkus
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
}
}

1cf7af35 Sven Schöling
my @a = localtime;
d319704a Moritz Bunkus
$a[5] += 1900;
$a[4]++;
my $shippingdate = "$a[5]-$a[4]-$a[3]";

$form->get_employee($dbh);

}

#set expense_accno=inventory_accno if they are different => bilanz
594f0e99 Sven Schöling
my $vendor_accno =
d319704a Moritz Bunkus
($form->{expense_accno} != $form->{inventory_accno})
? $form->{inventory_accno}
: $form->{expense_accno};

# get tax rates and description
594f0e99 Sven Schöling
my $accno_id =
d319704a Moritz Bunkus
($form->{vc} eq "customer") ? $form->{income_accno} : $vendor_accno;
2a9ed0d5 Moritz Bunkus
$query =
qq|SELECT c.accno, c.description, t.rate, t.taxnumber
FROM chart c, tax t
WHERE (c.id = t.chart_id) AND (t.taxkey IN (SELECT taxkey_id FROM chart where accno = ?))
ORDER BY c.accno|;
1cf7af35 Sven Schöling
my $stw = prepare_execute_query($form, $dbh, $query, $accno_id);
d319704a Moritz Bunkus
$form->{taxaccount} = "";
594f0e99 Sven Schöling
while (my $ptr = $stw->fetchrow_hashref("NAME_lc")) {
d319704a Moritz Bunkus
$form->{taxaccount} .= "$ptr->{accno} ";
5cf977e5 Moritz Bunkus
if (!($form->{taxaccount2} =~ /\Q$ptr->{accno}\E/)) {
d319704a Moritz Bunkus
$form->{"$ptr->{accno}_rate"} = $ptr->{rate};
$form->{"$ptr->{accno}_description"} = $ptr->{description};
$form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber};
$form->{taxaccount2} .= " $ptr->{accno} ";
}
}

2bfb8a50 Moritz Bunkus
CVar->save_custom_variables(dbh => $dbh,
module => 'IC',
trans_id => $form->{id},
variables => $form,
save_validity => 1);
b2f44e3d Moritz Bunkus
d319704a Moritz Bunkus
# commit
my $rc = $dbh->commit;

$main::lxdebug->leave_sub();

return $rc;
}

sub update_assembly {
$main::lxdebug->enter_sub();

my ($dbh, $form, $id, $qty, $sellprice, $weight) = @_;

2a9ed0d5 Moritz Bunkus
my $query = qq|SELECT id, qty FROM assembly WHERE parts_id = ?|;
my $sth = prepare_execute_query($form, $dbh, $query, conv_i($id));
d319704a Moritz Bunkus
while (my ($pid, $aqty) = $sth->fetchrow_array) {
&update_assembly($dbh, $form, $pid, $aqty * $qty, $sellprice, $weight);
}
$sth->finish;

2a9ed0d5 Moritz Bunkus
$query =
qq|UPDATE parts SET sellprice = sellprice + ?, weight = weight + ?
WHERE id = ?|;
594f0e99 Sven Schöling
my @values = ($qty * ($form->{sellprice} - $sellprice),
2a9ed0d5 Moritz Bunkus
$qty * ($form->{weight} - $weight), conv_i($id));
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub retrieve_assemblies {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

# connect to database
my $dbh = $form->dbconnect($myconfig);

2a9ed0d5 Moritz Bunkus
my $where = qq|NOT p.obsolete|;
my @values;
d319704a Moritz Bunkus
if ($form->{partnumber}) {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND (p.partnumber ILIKE ?)|;
push(@values, '%' . $form->{partnumber} . '%');
d319704a Moritz Bunkus
}

if ($form->{description}) {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND (p.description ILIKE ?)|;
push(@values, '%' . $form->{description} . '%');
d319704a Moritz Bunkus
}

# retrieve assembly items
2a9ed0d5 Moritz Bunkus
my $query =
qq|SELECT p.id, p.partnumber, p.description,
p.bin, p.onhand, p.rop,
(SELECT sum(p2.inventory_accno_id)
FROM parts p2, assembly a
WHERE (p2.id = a.parts_id) AND (a.id = p.id)) AS inventory
FROM parts p
WHERE NOT p.obsolete AND p.assembly $where|;
d319704a Moritz Bunkus
2a9ed0d5 Moritz Bunkus
$form->{assembly_items} = selectall_hashref_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

sub delete {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;
2a9ed0d5 Moritz Bunkus
my @values = (conv_i($form->{id}));
d319704a Moritz Bunkus
# connect to database, turn off AutoCommit
my $dbh = $form->dbconnect_noauto($myconfig);

d0779d01 Moritz Bunkus
my %columns = ( "assembly" => "id", "parts" => "id" );
d319704a Moritz Bunkus
9f07753b Moritz Bunkus
for my $table (qw(prices makemodel inventory assembly translation parts)) {
2a9ed0d5 Moritz Bunkus
my $column = defined($columns{$table}) ? $columns{$table} : "parts_id";
do_query($form, $dbh, qq|DELETE FROM $table WHERE $column = ?|, @values);
d319704a Moritz Bunkus
}

# commit
my $rc = $dbh->commit;
$dbh->disconnect;

$main::lxdebug->leave_sub();

return $rc;
}

sub assembly_item {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

my $i = $form->{assembly_rows};
my $var;
2a9ed0d5 Moritz Bunkus
my $where = qq|1 = 1|;
my @values;
d319704a Moritz Bunkus
2a9ed0d5 Moritz Bunkus
my %columns = ("partnumber" => "p", "description" => "p", "partsgroup" => "pg");

while (my ($column, $table) = each(%columns)) {
next unless ($form->{"${column}_$i"});
$where .= qq| AND ${table}.${column} ILIKE ?|;
push(@values, '%' . $form->{"${column}_$i"} . '%');
d319704a Moritz Bunkus
}

if ($form->{id}) {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND NOT (p.id = ?)|;
push(@values, conv_i($form->{id}));
d319704a Moritz Bunkus
}

5074cc50 Moritz Bunkus
# Search for part ID overrides all other criteria.
if ($form->{"id_${i}"}) {
$where = qq|p.id = ?|;
@values = ($form->{"id_${i}"});
}

594f0e99 Sven Schöling
if ($form->{partnumber}) {
2a9ed0d5 Moritz Bunkus
$where .= qq| ORDER BY p.partnumber|;
d319704a Moritz Bunkus
} else {
2a9ed0d5 Moritz Bunkus
$where .= qq| ORDER BY p.description|;
d319704a Moritz Bunkus
}

# connect to database
my $dbh = $form->dbconnect($myconfig);

2a9ed0d5 Moritz Bunkus
my $query =
b5a41731 Sven Schöling
qq|SELECT p.id, p.partnumber, p.description, p.sellprice,
c82106b1 Geoffrey Richardson
p.weight, p.onhand, p.unit, pg.partsgroup, p.lastcost,
p.price_factor_id, pfac.factor AS price_factor
2a9ed0d5 Moritz Bunkus
FROM parts p
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
ccde19fe Sven Schöling
LEFT JOIN price_factors pfac ON pfac.id = p.price_factor_id
2a9ed0d5 Moritz Bunkus
WHERE $where|;
$form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

2efc8cbc Sven Schöling
#
# Report for Wares.
# Warning, deep magic ahead.
# This function gets all parts from the database according to the filters specified
#
193c7381 Sven Schöling
# specials:
# sort revers - sorting field + direction
# top100
2efc8cbc Sven Schöling
#
193c7381 Sven Schöling
# simple filter strings (every one of those also has a column flag prefixed with 'l_' associated):
a596e63e Moritz Bunkus
# partnumber ean description partsgroup microfiche drawing
2efc8cbc Sven Schöling
#
# column flags:
a596e63e Moritz Bunkus
# l_partnumber l_description l_listprice l_sellprice l_lastcost l_priceupdate l_weight l_unit l_bin l_rop l_image l_drawing l_microfiche l_partsgroup
2efc8cbc Sven Schöling
#
193c7381 Sven Schöling
# exclusives:
# itemstatus = active | onhand | short | obsolete | orphaned
# searchitems = part | assembly | service
#
# joining filters:
# make model - makemodel
# serialnumber transdatefrom transdateto - invoice/orderitems
a596e63e Moritz Bunkus
#
2efc8cbc Sven Schöling
# binary flags:
a596e63e Moritz Bunkus
# bought sold onorder ordered rfq quoted - aggreg joins with invoices/orders
193c7381 Sven Schöling
# l_linetotal l_subtotal - aggreg joins to display totals (complicated) - NOT IMPLEMENTED here, implementation at frontend
# l_soldtotal - aggreg join to display total of sold quantity
# onhand - as above, but masking the simple itemstatus results (doh!)
# short - NOT IMPLEMENTED as form filter, only as itemstatus option
# l_serialnumber - belonges to serialnumber filter
# l_deliverydate - displays deliverydate is sold etc. flags are active
0cf83814 Sven Schöling
# l_soldtotal - aggreg join to display total of sold quantity, works as long as there's no bullshit in soldtotal
193c7381 Sven Schöling
#
a596e63e Moritz Bunkus
# not working:
193c7381 Sven Schöling
# onhand - as above, but masking the simple itemstatus results (doh!)
c19f41e1 Sven Schöling
# warehouse onhand
5f783ffe Sven Schöling
# search by overrides of description
193c7381 Sven Schöling
#
# disabled sanity checks and changes:
# - searchitems = assembly will no longer disable bought
5f783ffe Sven Schöling
# - searchitems = service will no longer disable make and model, although services don't have make/model, it doesn't break the query
# - itemstatus = orphaned will no longer disable onhand short bought sold onorder ordered rfq quoted transdate[from|to]
# - itemstatus = obsolete will no longer disable onhand, short
193c7381 Sven Schöling
# - allow sorting by ean
# - serialnumber filter also works if l_serialnumber isn't ticked
# - sorting will now change sorting if the requested sorting column isn't checked and doesn't get checked as a side effect
2efc8cbc Sven Schöling
#
d319704a Moritz Bunkus
sub all_parts {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;
193c7381 Sven Schöling
my $dbh = $form->get_standard_dbh($myconfig);

0cf83814 Sven Schöling
$form->{parts} = +{ };
$form->{soldtotal} = undef if $form->{l_soldtotal}; # security fix. top100 insists on putting strings in there...
193c7381 Sven Schöling
29795499 Sven Schöling
my @simple_filters = qw(partnumber ean description partsgroup microfiche drawing onhand);
5b0450c3 Sven Schöling
my @project_filters = qw(projectnumber projectdescription);
193c7381 Sven Schöling
my @makemodel_filters = qw(make model);
my @invoice_oi_filters = qw(serialnumber soldtotal);
my @apoe_filters = qw(transdate);
4d0f405c Sven Schöling
my @like_filters = (@simple_filters, @invoice_oi_filters);
5b0450c3 Sven Schöling
my @all_columns = (@simple_filters, @makemodel_filters, @apoe_filters, @project_filters, qw(serialnumber));
35ca31c0 Niclas Zimmermann
my @simple_l_switches = (@all_columns, qw(notes listprice sellprice lastcost priceupdate weight unit bin rop image));
193c7381 Sven Schöling
my @oe_flags = qw(bought sold onorder ordered rfq quoted);
c19f41e1 Sven Schöling
my @qsooqr_flags = qw(invnumber ordnumber quonumber trans_id name module qty);
193c7381 Sven Schöling
my @deliverydate_flags = qw(deliverydate);
# my @other_flags = qw(onhand); # ToDO: implement these
# my @inactive_flags = qw(l_subtotal short l_linetotal);

5f783ffe Sven Schöling
my @select_tokens = qw(id factor);
my @where_tokens = qw(1=1);
my @group_tokens = ();
my @bind_vars = ();
my %joins_needed = ();

193c7381 Sven Schöling
my %joins = (
1e251313 Moritz Bunkus
partsgroup => 'LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id)',
makemodel => 'LEFT JOIN makemodel mm ON (mm.parts_id = p.id)',
pfac => 'LEFT JOIN price_factors pfac ON (pfac.id = p.price_factor_id)',
a596e63e Moritz Bunkus
invoice_oi =>
q|LEFT JOIN (
5b0450c3 Sven Schöling
SELECT parts_id, description, serialnumber, trans_id, unit, sellprice, qty, assemblyitem, deliverydate, 'invoice' AS ioi, project_id, id FROM invoice UNION
SELECT parts_id, description, serialnumber, trans_id, unit, sellprice, qty, FALSE AS assemblyitem, NULL AS deliverydate, 'orderitems' AS ioi, project_id, id FROM orderitems
193c7381 Sven Schöling
) AS ioi ON ioi.parts_id = p.id|,
a596e63e Moritz Bunkus
apoe =>
q|LEFT JOIN (
5b0450c3 Sven Schöling
SELECT id, transdate, 'ir' AS module, ordnumber, quonumber, invnumber, FALSE AS quotation, NULL AS customer_id, vendor_id, NULL AS deliverydate, globalproject_id, 'invoice' AS ioi FROM ap UNION
SELECT id, transdate, 'is' AS module, ordnumber, quonumber, invnumber, FALSE AS quotation, customer_id, NULL AS vendor_id, deliverydate, globalproject_id, 'invoice' AS ioi FROM ar UNION
SELECT id, transdate, 'oe' AS module, ordnumber, quonumber, NULL AS invnumber, quotation, customer_id, vendor_id, reqdate AS deliverydate, globalproject_id, 'orderitems' AS ioi FROM oe
2b688418 Moritz Bunkus
) AS apoe ON ((ioi.trans_id = apoe.id) AND (ioi.ioi = apoe.ioi))|,
193c7381 Sven Schöling
cv =>
a596e63e Moritz Bunkus
q|LEFT JOIN (
SELECT id, name, 'customer' AS cv FROM customer UNION
SELECT id, name, 'vendor' AS cv FROM vendor
193c7381 Sven Schöling
) AS cv ON cv.id = apoe.customer_id OR cv.id = apoe.vendor_id|,
4d0f405c Sven Schöling
mv => 'LEFT JOIN vendor AS mv ON mv.id = mm.make',
5b0450c3 Sven Schöling
project => 'LEFT JOIN project AS pj ON pj.id = COALESCE(ioi.project_id, apoe.globalproject_id)',
193c7381 Sven Schöling
);
5b0450c3 Sven Schöling
my @join_order = qw(partsgroup makemodel mv invoice_oi apoe cv pfac project);
594f0e99 Sven Schöling
my %table_prefix = (
deliverydate => 'apoe.', serialnumber => 'ioi.',
transdate => 'apoe.', trans_id => 'ioi.',
module => 'apoe.', name => 'cv.',
ordnumber => 'apoe.', make => 'mm.',
quonumber => 'apoe.', model => 'mm.',
invnumber => 'apoe.', partsgroup => 'pg.',
85ffde7a Holger Lindemann
lastcost => 'p.', , soldtotal => ' ',
5b0450c3 Sven Schöling
factor => 'pfac.', projectnumber => 'pj.',
'SUM(ioi.qty)' => ' ', projectdescription => 'pj.',
5f783ffe Sven Schöling
description => 'p.',
qty => 'ioi.',
serialnumber => 'ioi.',
ed661987 Sven Schöling
quotation => 'apoe.',
cv => 'cv.',
1163cee7 Sven Schöling
"ioi.id" => ' ',
"ioi.ioi" => ' ',
594f0e99 Sven Schöling
);

5f783ffe Sven Schöling
# if the join condition in these blocks are met, the column
# of the scecified table will gently override (coalesce actually) the original value
# use it to conditionally coalesce values from subtables
my @column_override = (
5b0450c3 Sven Schöling
# column name, prefix, joins_needed, nick name (in case column is named like another)
5f783ffe Sven Schöling
[ 'description', 'ioi.', 'invoice_oi' ],
[ 'deliverydate', 'ioi.', 'invoice_oi' ],
93618a69 Sven Schöling
[ 'transdate', 'apoe.', 'apoe' ],
[ 'unit', 'ioi.', 'invoice_oi' ],
1b9eff96 Sven Schöling
[ 'sellprice', 'ioi.', 'invoice_oi' ],
5f783ffe Sven Schöling
);

# careful with renames. these are HARD, and any filters done on the original column will break
594f0e99 Sven Schöling
my %renamed_columns = (
'factor' => 'price_factor',
'SUM(ioi.qty)' => 'soldtotal',
1163cee7 Sven Schöling
'ioi.id' => 'ioi_id',
'ioi.ioi' => 'ioi',
5b0450c3 Sven Schöling
'projectdescription' => 'projectdescription',
);

my %real_column = (
projectdescription => 'description',
594f0e99 Sven Schöling
);

7e2f7d89 Moritz Bunkus
if (($form->{searchitems} eq 'assembly') && $form->{l_lastcost}) {
@simple_l_switches = grep { $_ ne 'lastcost' } @simple_l_switches;
}

5f783ffe Sven Schöling
my $make_token_builder = sub {
my $joins_needed = shift;
sub {
5b0450c3 Sven Schöling
my ($nick, $alias) = @_;
my ($col) = $real_column{$nick} || $nick;
5f783ffe Sven Schöling
my @coalesce_tokens =
0ade2438 Sven Schöling
map { ($_->[1] || 'p.') . $_->[0] }
5f783ffe Sven Schöling
grep { !$_->[2] || $joins_needed->{$_->[2]} }
5b0450c3 Sven Schöling
grep { ($_->[3] || $_->[0]) eq $nick }
@column_override, [ $col, $table_prefix{$nick}, undef , $nick ];
5f783ffe Sven Schöling
0ade2438 Sven Schöling
my $coalesce = scalar @coalesce_tokens > 1;
5f783ffe Sven Schöling
return ($coalesce
? sprintf 'COALESCE(%s)', join ', ', @coalesce_tokens
: shift @coalesce_tokens)
5b0450c3 Sven Schöling
. ($alias && ($coalesce || $renamed_columns{$nick})
? " AS " . ($renamed_columns{$nick} || $nick)
5f783ffe Sven Schöling
: '');
}
};
193c7381 Sven Schöling
5f783ffe Sven Schöling
#===== switches and simple filters ========#
193c7381 Sven Schöling
# special case transdate
if (grep { $form->{$_} } qw(transdatefrom transdateto)) {
$form->{"l_transdate"} = 1;
push @select_tokens, 'transdate';
for (qw(transdatefrom transdateto)) {
next unless $form->{$_};
push @where_tokens, sprintf "transdate %s ?", /from$/ ? '>=' : '<=';
push @bind_vars, $form->{$_};
d319704a Moritz Bunkus
}
}

83560c63 Bernd Bleßmann
if ($form->{"partsgroup_id"}) {
$form->{"l_partsgroup"} = '1'; # show the column
push @where_tokens, "pg.id = ?";
push @bind_vars, $form->{"partsgroup_id"};
}

5f783ffe Sven Schöling
foreach (@like_filters) {
193c7381 Sven Schöling
next unless $form->{$_};
$form->{"l_$_"} = '1'; # show the column
451843cf Sven Schöling
push @where_tokens, "$table_prefix{$_}$_ ILIKE ?";
193c7381 Sven Schöling
push @bind_vars, "%$form->{$_}%";
d319704a Moritz Bunkus
}
2a9ed0d5 Moritz Bunkus
193c7381 Sven Schöling
foreach (@simple_l_switches) {
next unless $form->{"l_$_"};
push @select_tokens, $_;
d319704a Moritz Bunkus
}
2a9ed0d5 Moritz Bunkus
193c7381 Sven Schöling
for ($form->{searchitems}) {
push @where_tokens, 'p.inventory_accno_id > 0' if /part/;
push @where_tokens, 'p.inventory_accno_id IS NULL' if /service/;
push @where_tokens, 'NOT p.assembly' if /service/;
push @where_tokens, ' p.assembly' if /assembly/;
d319704a Moritz Bunkus
}
2a9ed0d5 Moritz Bunkus
193c7381 Sven Schöling
for ($form->{itemstatus}) {
a596e63e Moritz Bunkus
push @where_tokens, 'p.id NOT IN
(SELECT DISTINCT parts_id FROM invoice UNION
SELECT DISTINCT parts_id FROM assembly UNION
193c7381 Sven Schöling
SELECT DISTINCT parts_id FROM orderitems)' if /orphaned/;
push @where_tokens, 'p.onhand = 0' if /orphaned/;
push @where_tokens, 'NOT p.obsolete' if /active/;
push @where_tokens, ' p.obsolete', if /obsolete/;
push @where_tokens, 'p.onhand > 0', if /onhand/;
push @where_tokens, 'p.onhand < p.rop', if /short/;
a596e63e Moritz Bunkus
}
193c7381 Sven Schöling
7e2f7d89 Moritz Bunkus
my $q_assembly_lastcost =
qq|(SELECT SUM(a_lc.qty * p_lc.lastcost / COALESCE(pfac_lc.factor, 1))
FROM assembly a_lc
LEFT JOIN parts p_lc ON (a_lc.parts_id = p_lc.id)
LEFT JOIN price_factors pfac_lc ON (p_lc.price_factor_id = pfac_lc.id)
WHERE (a_lc.id = p.id)) AS lastcost|;
5f783ffe Sven Schöling
$table_prefix{$q_assembly_lastcost} = ' ';
bd8bd95b Geoffrey Richardson
4d0f405c Sven Schöling
# special case makemodel search
# all_parts is based upon the assumption that every parameter is named like the column it represents
# unfortunately make would have to match vendor.name which is already taken for vendor.name in bsooqr mode.
# fortunately makemodel doesn't need to be displayed later, so adding a special clause to where_token is sufficient.
if ($form->{make}) {
push @where_tokens, 'mv.name ILIKE ?';
push @bind_vars, "%$form->{make}%";
}
if ($form->{model}) {
push @where_tokens, 'mm.model ILIKE ?';
push @bind_vars, "%$form->{model}%";
}

b6dc5623 Sven Schöling
# special case: sorting by partnumber
# since partnumbers are expected to be prefixed integers, a special sorting is implemented sorting first lexically by prefix and then by suffix.
# and yes, that expression is designed to hold that array of regexes only once, so the map is kinda messy, sorry about that.
# ToDO: implement proper functional sorting
bd8bd95b Geoffrey Richardson
# Nette Idee von Sven, gibt aber Probleme wenn die Artikelnummern groesser als 32bit sind. Korrekt waere es, dass Sort-Natural-Modul zu nehmen
1cf7af35 Sven Schöling
# Ich lass das mal hier drin, damit die Idee erhalten bleibt jb 28.5.2009 bug 1018
bd8bd95b Geoffrey Richardson
#$form->{sort} = join ', ', map { push @select_tokens, $_; ($table_prefix{$_} = "substring(partnumber,'[") . $_ } qw|^[:digit:]]+') [:digit:]]+')::INTEGER|
# if $form->{sort} eq 'partnumber';
b6dc5623 Sven Schöling
bd8bd95b Geoffrey Richardson
#my $order_clause = " ORDER BY $form->{sort} $sort_order";
193c7381 Sven Schöling
872f1493 Sven Schöling
my $limit_clause;
$limit_clause = " LIMIT 100" if $form->{top100};
$limit_clause = " LIMIT " . $form->{limit} * 1 if $form->{limit} * 1;
193c7381 Sven Schöling
#=== joins and complicated filters ========#
a596e63e Moritz Bunkus
5f783ffe Sven Schöling
my $bsooqr = any { $form->{$_} } @oe_flags;
1cf7af35 Sven Schöling
my @bsooqr_tokens = ();
5f783ffe Sven Schöling
1163cee7 Sven Schöling
push @select_tokens, @qsooqr_flags, 'quotation', 'cv', 'ioi.id', 'ioi.ioi' if $bsooqr;
193c7381 Sven Schöling
push @select_tokens, @deliverydate_flags if $bsooqr && $form->{l_deliverydate};
7e2f7d89 Moritz Bunkus
push @select_tokens, $q_assembly_lastcost if ($form->{searchitems} eq 'assembly') && $form->{l_lastcost};
193c7381 Sven Schöling
push @bsooqr_tokens, q|module = 'ir' AND NOT ioi.assemblyitem| if $form->{bought};
push @bsooqr_tokens, q|module = 'is' AND NOT ioi.assemblyitem| if $form->{sold};
push @bsooqr_tokens, q|module = 'oe' AND NOT quotation AND cv = 'customer'| if $form->{ordered};
push @bsooqr_tokens, q|module = 'oe' AND NOT quotation AND cv = 'vendor'| if $form->{onorder};
push @bsooqr_tokens, q|module = 'oe' AND quotation AND cv = 'customer'| if $form->{quoted};
push @bsooqr_tokens, q|module = 'oe' AND quotation AND cv = 'vendor'| if $form->{rfq};
push @where_tokens, join ' OR ', map { "($_)" } @bsooqr_tokens if $bsooqr;

$joins_needed{partsgroup} = 1;
1e251313 Moritz Bunkus
$joins_needed{pfac} = 1;
5b0450c3 Sven Schöling
$joins_needed{project} = 1 if grep { $form->{$_} || $form->{"l_$_"} } @project_filters;
193c7381 Sven Schöling
$joins_needed{makemodel} = 1 if grep { $form->{$_} || $form->{"l_$_"} } @makemodel_filters;
4d0f405c Sven Schöling
$joins_needed{mv} = 1 if $joins_needed{makemodel};
193c7381 Sven Schöling
$joins_needed{cv} = 1 if $bsooqr;
ce19e5ec Bernd Bleßmann
$joins_needed{apoe} = 1 if $joins_needed{project} || $joins_needed{cv} || grep { $form->{$_} || $form->{"l_$_"} } @apoe_filters;
5b0450c3 Sven Schöling
$joins_needed{invoice_oi} = 1 if $joins_needed{project} || $joins_needed{apoe} || grep { $form->{$_} || $form->{"l_$_"} } @invoice_oi_filters;
193c7381 Sven Schöling
# special case for description search.
# up in the simple filter section the description filter got interpreted as something like: WHERE description ILIKE '%$form->{description}%'
# now we'd like to search also for the masked description entered in orderitems and invoice, so...
# find the old entries in of @where_tokens and @bind_vars, and adjust them
if ($joins_needed{invoice_oi}) {
for (my ($wi, $bi) = (0)x2; $wi <= $#where_tokens; $bi++ if $where_tokens[$wi++] =~ /\?/) {
5f783ffe Sven Schöling
next unless $where_tokens[$wi] =~ /\bdescription ILIKE/;
193c7381 Sven Schöling
splice @where_tokens, $wi, 1, 'p.description ILIKE ? OR ioi.description ILIKE ?';
splice @bind_vars, $bi, 0, $bind_vars[$bi];
last;
}
d319704a Moritz Bunkus
}

193c7381 Sven Schöling
# now the master trick: soldtotal.
d319704a Moritz Bunkus
if ($form->{l_soldtotal}) {
6a8531b6 Sven Schöling
push @where_tokens, 'NOT ioi.qty = 0';
193c7381 Sven Schöling
push @group_tokens, @select_tokens;
9d2ac13b Sven Schöling
map { s/.*\sAS\s+//si } @group_tokens;
1e251313 Moritz Bunkus
push @select_tokens, 'SUM(ioi.qty)';
d319704a Moritz Bunkus
}

193c7381 Sven Schöling
#============= build query ================#
d319704a Moritz Bunkus
5f783ffe Sven Schöling
my $token_builder = $make_token_builder->(\%joins_needed);
572fafbe Moritz Bunkus
5f783ffe Sven Schöling
my @sort_cols = (@simple_filters, qw(id bin priceupdate onhand invnumber ordnumber quonumber name serialnumber soldtotal deliverydate));
$form->{sort} = 'id' unless grep { $form->{"l_$_"} } grep { $form->{sort} eq $_ } @sort_cols; # sort by id if unknown or invisible column
my $sort_order = ($form->{revers} ? ' DESC' : ' ASC');
my $order_clause = " ORDER BY " . $token_builder->($form->{sort}) . ($form->{revers} ? ' DESC' : ' ASC');
193c7381 Sven Schöling
5f783ffe Sven Schöling
my $select_clause = join ', ', map { $token_builder->($_, 1) } @select_tokens;
193c7381 Sven Schöling
my $join_clause = join ' ', @joins{ grep $joins_needed{$_}, @join_order };
my $where_clause = join ' AND ', map { "($_)" } @where_tokens;
74fca575 Sven Schöling
my $group_clause = @group_tokens ? ' GROUP BY ' . join ', ', map { $token_builder->($_) } @group_tokens : '';
193c7381 Sven Schöling
60ebd03b Sven Schöling
my %oe_flag_to_cvar = (
bought => 'invoice',
sold => 'invoice',
onorder => 'orderitems',
ordered => 'orderitems',
rfq => 'orderitems',
quoted => 'orderitems',
);

my ($cvar_where, @cvar_values) = CVar->build_filter_query(
module => 'IC',
trans_id_field => $bsooqr ? 'ioi.id': 'p.id',
filter => $form,
sub_module => $bsooqr ? [ uniq grep { $oe_flag_to_cvar{$form->{$_}} } @oe_flags ] : undef,
);

b2f44e3d Moritz Bunkus
if ($cvar_where) {
$where_clause .= qq| AND ($cvar_where)|;
push @bind_vars, @cvar_values;
}

1163cee7 Sven Schöling
my $query = <<" SQL";
SELECT DISTINCT $select_clause
FROM parts p
$join_clause
WHERE $where_clause
$group_clause
$order_clause
$limit_clause
SQL
1e251313 Moritz Bunkus
193c7381 Sven Schöling
$form->{parts} = selectall_hashref_query($form, $dbh, $query, @bind_vars);

83914eeb Moritz Bunkus
map { $_->{onhand} *= 1 } @{ $form->{parts} };

b062ede8 Sven Schöling
# fix qty sign in ap. those are saved negative
if ($bsooqr && $form->{bought}) {
for my $row (@{ $form->{parts} }) {
$row->{qty} *= -1 if $row->{module} eq 'ir';
}
}

158bf855 Sven Schöling
# post processing for assembly parts lists (bom)
# for each part get the assembly parts and add them into the partlist.
2a9ed0d5 Moritz Bunkus
my @assemblies;
d319704a Moritz Bunkus
if ($form->{searchitems} eq 'assembly' && $form->{bom}) {
2a9ed0d5 Moritz Bunkus
$query =
qq|SELECT p.id, p.partnumber, p.description, a.qty AS onhand,
35ca31c0 Niclas Zimmermann
p.unit, p.bin, p.notes,
2a9ed0d5 Moritz Bunkus
p.sellprice, p.listprice, p.lastcost,
p.rop, p.weight, p.priceupdate,
158bf855 Sven Schöling
p.image, p.drawing, p.microfiche,
pfac.factor
FROM parts p
INNER JOIN assembly a ON (p.id = a.parts_id)
$joins{pfac}
WHERE a.id = ?|;
1cf7af35 Sven Schöling
my $sth = prepare_query($form, $dbh, $query);
d319704a Moritz Bunkus
1cf7af35 Sven Schöling
foreach my $item (@{ $form->{parts} }) {
2a9ed0d5 Moritz Bunkus
push(@assemblies, $item);
do_statement($form, $sth, $query, conv_i($item->{id}));
d319704a Moritz Bunkus
594f0e99 Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
d319704a Moritz Bunkus
$ref->{assemblyitem} = 1;
158bf855 Sven Schöling
map { $ref->{$_} /= $ref->{factor} || 1 } qw(sellprice listprice lastcost);
2a9ed0d5 Moritz Bunkus
push(@assemblies, $ref);
d319704a Moritz Bunkus
}
$sth->finish;
}

# copy assemblies to $form->{parts}
2a9ed0d5 Moritz Bunkus
$form->{parts} = \@assemblies;
d319704a Moritz Bunkus
}

8470071b Geoffrey Richardson
if ($form->{l_pricegroups} ) {
my $query = <<SQL;
SELECT parts_id, price, pricegroup_id
FROM prices
WHERE parts_id = ?
SQL

my $sth = prepare_query($form, $dbh, $query);

foreach my $part (@{ $form->{parts} }) {
do_statement($form, $sth, $query, conv_i($part->{id}));

while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
$part->{"pricegroup_$ref->{pricegroup_id}"} = $ref->{price};
}
$sth->finish;
}
};


d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
6be015fa Sven Schöling
return wantarray ? @{ $form->{parts} } : $form->{parts};
d319704a Moritz Bunkus
}

7942a6ac Moritz Bunkus
sub _create_filter_for_priceupdate {
54e4131e Moritz Bunkus
$main::lxdebug->enter_sub();

7942a6ac Moritz Bunkus
my $self = shift;
my $myconfig = \%main::myconfig;
my $form = $main::form;

2a9ed0d5 Moritz Bunkus
my @where_values;
54e4131e Moritz Bunkus
my $where = '1 = 1';

7942a6ac Moritz Bunkus
foreach my $item (qw(partnumber drawing microfiche make model pg.partsgroup)) {
my $column = $item;
$column =~ s/.*\.//;
next unless ($form->{$column});
54e4131e Moritz Bunkus
7942a6ac Moritz Bunkus
$where .= qq| AND $item ILIKE ?|;
push(@where_values, '%' . $form->{$column} . '%');
54e4131e Moritz Bunkus
}

7942a6ac Moritz Bunkus
foreach my $item (qw(description serialnumber)) {
next unless ($form->{$item});
54e4131e Moritz Bunkus
7942a6ac Moritz Bunkus
$where .= qq| AND (${item} ILIKE ?)|;
push(@where_values, '%' . $form->{$item} . '%');
54e4131e Moritz Bunkus
}


# items which were never bought, sold or on an order
if ($form->{itemstatus} eq 'orphaned') {
2a9ed0d5 Moritz Bunkus
$where .=
qq| AND (p.onhand = 0)
AND p.id NOT IN
(
SELECT DISTINCT parts_id FROM invoice
UNION
SELECT DISTINCT parts_id FROM assembly
UNION
SELECT DISTINCT parts_id FROM orderitems
)|;
54e4131e Moritz Bunkus
7942a6ac Moritz Bunkus
} elsif ($form->{itemstatus} eq 'active') {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND p.obsolete = '0'|;

7942a6ac Moritz Bunkus
} elsif ($form->{itemstatus} eq 'obsolete') {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND p.obsolete = '1'|;

7942a6ac Moritz Bunkus
} elsif ($form->{itemstatus} eq 'onhand') {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND p.onhand > 0|;

7942a6ac Moritz Bunkus
} elsif ($form->{itemstatus} eq 'short') {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND p.onhand < p.rop|;
7942a6ac Moritz Bunkus
54e4131e Moritz Bunkus
}

2a9ed0d5 Moritz Bunkus
foreach my $column (qw(make model)) {
1cf7af35 Sven Schöling
next unless ($form->{$column});
2a9ed0d5 Moritz Bunkus
$where .= qq| AND p.id IN (SELECT DISTINCT parts_id FROM makemodel WHERE $column ILIKE ?|;
push(@where_values, '%' . $form->{$column} . '%');
}
54e4131e Moritz Bunkus
7942a6ac Moritz Bunkus
$main::lxdebug->leave_sub();

return ($where, @where_values);
}

sub get_num_matches_for_priceupdate {
$main::lxdebug->enter_sub();

my $self = shift;

my $myconfig = \%main::myconfig;
my $form = $main::form;

1cf7af35 Sven Schöling
my $dbh = $form->get_standard_dbh($myconfig);
7942a6ac Moritz Bunkus
my ($where, @where_values) = $self->_create_filter_for_priceupdate();

my $num_updated = 0;
my $query;

for my $column (qw(sellprice listprice)) {
next if ($form->{$column} eq "");

$query =
qq|SELECT COUNT(*)
FROM parts
WHERE id IN
(SELECT p.id
FROM parts p
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE $where)|;
1cf7af35 Sven Schöling
my ($result) = selectfirst_array_query($form, $dbh, $query, @where_values);
7942a6ac Moritz Bunkus
$num_updated += $result if (0 <= $result);
}

$query =
qq|SELECT COUNT(*)
FROM prices
WHERE parts_id IN
(SELECT p.id
FROM parts p
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE $where) AND (pricegroup_id = ?)|;
my $sth = prepare_query($form, $dbh, $query);

for my $i (1 .. $form->{price_rows}) {
next if ($form->{"price_$i"} eq "");

my ($result) = do_statement($form, $sth, $query, @where_values, conv_i($form->{"pricegroup_id_$i"}));
$num_updated += $result if (0 <= $result);
}
$sth->finish();

$main::lxdebug->leave_sub();

return $num_updated;
}

sub update_prices {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

my ($where, @where_values) = $self->_create_filter_for_priceupdate();
my $num_updated = 0;

54e4131e Moritz Bunkus
# connect to database
my $dbh = $form->dbconnect_noauto($myconfig);

2a9ed0d5 Moritz Bunkus
for my $column (qw(sellprice listprice)) {
next if ($form->{$column} eq "");
54e4131e Moritz Bunkus
2a9ed0d5 Moritz Bunkus
my $value = $form->parse_amount($myconfig, $form->{$column});
my $operator = '+';
54e4131e Moritz Bunkus
2a9ed0d5 Moritz Bunkus
if ($form->{"${column}_type"} eq "percent") {
$value = ($value / 100) + 1;
$operator = '*';
}
54e4131e Moritz Bunkus
1cf7af35 Sven Schöling
my $query =
2a9ed0d5 Moritz Bunkus
qq|UPDATE parts SET $column = $column $operator ?
WHERE id IN
(SELECT p.id
FROM parts p
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE $where)|;
1cf7af35 Sven Schöling
my $result = do_query($form, $dbh, $query, $value, @where_values);
7942a6ac Moritz Bunkus
$num_updated += $result if (0 <= $result);
2a9ed0d5 Moritz Bunkus
}

my $q_add =
qq|UPDATE prices SET price = price + ?
WHERE parts_id IN
(SELECT p.id
FROM parts p
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE $where) AND (pricegroup_id = ?)|;
my $sth_add = prepare_query($form, $dbh, $q_add);

my $q_multiply =
qq|UPDATE prices SET price = price * ?
WHERE parts_id IN
(SELECT p.id
FROM parts p
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE $where) AND (pricegroup_id = ?)|;
my $sth_multiply = prepare_query($form, $dbh, $q_multiply);
54e4131e Moritz Bunkus
for my $i (1 .. $form->{price_rows}) {
2a9ed0d5 Moritz Bunkus
next if ($form->{"price_$i"} eq "");
54e4131e Moritz Bunkus
2a9ed0d5 Moritz Bunkus
my $value = $form->parse_amount($myconfig, $form->{"price_$i"});
7942a6ac Moritz Bunkus
my $result;
2a9ed0d5 Moritz Bunkus
if ($form->{"pricegroup_type_$i"} eq "percent") {
7942a6ac Moritz Bunkus
$result = do_statement($form, $sth_multiply, $q_multiply, ($value / 100) + 1, @where_values, conv_i($form->{"pricegroup_id_$i"}));
2a9ed0d5 Moritz Bunkus
} else {
7942a6ac Moritz Bunkus
$result = do_statement($form, $sth_add, $q_add, $value, @where_values, conv_i($form->{"pricegroup_id_$i"}));
54e4131e Moritz Bunkus
}
7942a6ac Moritz Bunkus
$num_updated += $result if (0 <= $result);
54e4131e Moritz Bunkus
}

2a9ed0d5 Moritz Bunkus
$sth_add->finish();
$sth_multiply->finish();
54e4131e Moritz Bunkus
my $rc= $dbh->commit;
$dbh->disconnect;
2a9ed0d5 Moritz Bunkus
54e4131e Moritz Bunkus
$main::lxdebug->leave_sub();

7942a6ac Moritz Bunkus
return $num_updated;
54e4131e Moritz Bunkus
}

d319704a Moritz Bunkus
sub create_links {
$main::lxdebug->enter_sub();

my ($self, $module, $myconfig, $form) = @_;

# connect to database
my $dbh = $form->dbconnect($myconfig);

2a9ed0d5 Moritz Bunkus
my @values = ('%' . $module . '%');
1cf7af35 Sven Schöling
my $query;
2a9ed0d5 Moritz Bunkus
d319704a Moritz Bunkus
if ($form->{id}) {
2a9ed0d5 Moritz Bunkus
$query =
qq|SELECT c.accno, c.description, c.link, c.id,
p.inventory_accno_id, p.income_accno_id, p.expense_accno_id
FROM chart c, parts p
WHERE (c.link LIKE ?) AND (p.id = ?)
ORDER BY c.accno|;
push(@values, conv_i($form->{id}));

d319704a Moritz Bunkus
} else {
2a9ed0d5 Moritz Bunkus
$query =
qq|SELECT c.accno, c.description, c.link, c.id,
d.inventory_accno_id, d.income_accno_id, d.expense_accno_id
FROM chart c, defaults d
WHERE c.link LIKE ?
ORDER BY c.accno|;
d319704a Moritz Bunkus
}

2a9ed0d5 Moritz Bunkus
my $sth = prepare_execute_query($form, $dbh, $query, @values);
594f0e99 Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
2a9ed0d5 Moritz Bunkus
foreach my $key (split(/:/, $ref->{link})) {
5cf977e5 Moritz Bunkus
if ($key =~ /\Q$module\E/) {
d319704a Moritz Bunkus
if ( ($ref->{id} eq $ref->{inventory_accno_id})
|| ($ref->{id} eq $ref->{income_accno_id})
|| ($ref->{id} eq $ref->{expense_accno_id})) {
push @{ $form->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
description => $ref->{description},
selected => "selected" };
54e4131e Moritz Bunkus
$form->{"${key}_default"} = "$ref->{accno}--$ref->{description}";
d319704a Moritz Bunkus
} else {
push @{ $form->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
description => $ref->{description},
selected => "" };
}
}
}
}
$sth->finish;

54e4131e Moritz Bunkus
# get buchungsgruppen
2a9ed0d5 Moritz Bunkus
$form->{BUCHUNGSGRUPPEN} = selectall_hashref_query($form, $dbh, qq|SELECT id, description FROM buchungsgruppen|);
54e4131e Moritz Bunkus
# get payment terms
2a9ed0d5 Moritz Bunkus
$form->{payment_terms} = selectall_hashref_query($form, $dbh, qq|SELECT id, description FROM payment_terms ORDER BY sortkey|);
54e4131e Moritz Bunkus
5ebbc846 Moritz Bunkus
if (!$form->{id}) {
2a9ed0d5 Moritz Bunkus
($form->{priceupdate}) = selectrow_query($form, $dbh, qq|SELECT current_date|);
d319704a Moritz Bunkus
}

$dbh->disconnect;
$main::lxdebug->leave_sub();
}

# get partnumber, description, unit, sellprice and soldtotal with choice through $sortorder for Top100
sub get_parts {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form, $sortorder) = @_;
my $dbh = $form->dbconnect($myconfig);
2a9ed0d5 Moritz Bunkus
my $order = qq| p.partnumber|;
my $where = qq|1 = 1|;
my @values;
d319704a Moritz Bunkus
if ($sortorder eq "all") {
2a9ed0d5 Moritz Bunkus
$where .= qq| AND (partnumber ILIKE ?) AND (description ILIKE ?)|;
push(@values, '%' . $form->{partnumber} . '%', '%' . $form->{description} . '%');

} elsif ($sortorder eq "partnumber") {
$where .= qq| AND (partnumber ILIKE ?)|;
push(@values, '%' . $form->{partnumber} . '%');

} elsif ($sortorder eq "description") {
$where .= qq| AND (description ILIKE ?)|;
push(@values, '%' . $form->{description} . '%');
$order = "description";

d319704a Moritz Bunkus
}

my $query =
2a9ed0d5 Moritz Bunkus
qq|SELECT id, partnumber, description, unit, sellprice
FROM parts
WHERE $where ORDER BY $order|;

my $sth = prepare_execute_query($form, $dbh, $query, @values);

d319704a Moritz Bunkus
my $j = 0;
594f0e99 Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
d319704a Moritz Bunkus
if (($ref->{partnumber} eq "*") && ($ref->{description} eq "")) {
2a9ed0d5 Moritz Bunkus
next;
}

$j++;
$form->{"id_$j"} = $ref->{id};
$form->{"partnumber_$j"} = $ref->{partnumber};
$form->{"description_$j"} = $ref->{description};
$form->{"unit_$j"} = $ref->{unit};
$form->{"sellprice_$j"} = $ref->{sellprice};
$form->{"soldtotal_$j"} = get_soldtotal($dbh, $ref->{id});
d319704a Moritz Bunkus
} #while
$form->{rows} = $j;
$sth->finish;
$dbh->disconnect;

$main::lxdebug->leave_sub();

return $self;
} #end get_parts()

# gets sum of sold part with part_id
sub get_soldtotal {
$main::lxdebug->enter_sub();

my ($dbh, $id) = @_;

2a9ed0d5 Moritz Bunkus
my $query = qq|SELECT sum(qty) FROM invoice WHERE parts_id = ?|;
594f0e99 Sven Schöling
my ($sum) = selectrow_query($main::form, $dbh, $query, conv_i($id));
2a9ed0d5 Moritz Bunkus
$sum ||= 0;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $sum;
} #end get_soldtotal

54e4131e Moritz Bunkus
sub retrieve_languages {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $form) = @_;

# connect to database
my $dbh = $form->dbconnect($myconfig);

2a9ed0d5 Moritz Bunkus
my @values;
my $where;
1cf7af35 Sven Schöling
my $query;
54e4131e Moritz Bunkus
if ($form->{language_values} ne "") {
2a9ed0d5 Moritz Bunkus
$query =
qq|SELECT l.id, l.description, tr.translation, tr.longdescription
FROM language l
174fe30e Moritz Bunkus
LEFT OUTER JOIN translation tr ON (tr.language_id = l.id) AND (tr.parts_id = ?)
ORDER BY lower(l.description)|;
2a9ed0d5 Moritz Bunkus
@values = (conv_i($form->{id}));

54e4131e Moritz Bunkus
} else {
174fe30e Moritz Bunkus
$query = qq|SELECT id, description
FROM language
ORDER BY lower(description)|;
54e4131e Moritz Bunkus
}

2a9ed0d5 Moritz Bunkus
my $languages = selectall_hashref_query($form, $dbh, $query, @values);
54e4131e Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();

2a9ed0d5 Moritz Bunkus
return $languages;
54e4131e Moritz Bunkus
}

48de433a Moritz Bunkus
sub follow_account_chain {
0fee52dd Sven Schöling
$main::lxdebug->enter_sub(2);
48de433a Moritz Bunkus
my ($self, $form, $dbh, $transdate, $accno_id, $accno) = @_;

my @visited_accno_ids = ($accno_id);

my ($query, $sth);

ee454f5b Sven Schöling
$form->{ACCOUNT_CHAIN_BY_ID} ||= {
map { $_->{id} => $_ }
a9a6bc13 Holger Lindemann
selectall_hashref_query($form, $dbh, <<SQL, $transdate) };
SELECT c.id, c.new_chart_id, date(?) >= c.valid_from AS is_valid, cnew.accno
ee454f5b Sven Schöling
FROM chart c
LEFT JOIN chart cnew ON c.new_chart_id = cnew.id
WHERE NOT c.new_chart_id IS NULL AND (c.new_chart_id > 0)
SQL
48de433a Moritz Bunkus
while (1) {
ee454f5b Sven Schöling
my $ref = $form->{ACCOUNT_CHAIN_BY_ID}->{$accno_id};
48de433a Moritz Bunkus
last unless ($ref && $ref->{"is_valid"} &&
!grep({ $_ == $ref->{"new_chart_id"} } @visited_accno_ids));
$accno_id = $ref->{"new_chart_id"};
$accno = $ref->{"accno"};
push(@visited_accno_ids, $accno_id);
}

0fee52dd Sven Schöling
$main::lxdebug->leave_sub(2);
48de433a Moritz Bunkus
return ($accno_id, $accno);
}

sub retrieve_accounts {
a87dd0ec Sven Schöling
$main::lxdebug->enter_sub;
b3501bdf Moritz Bunkus
1228aa97 Sven Schöling
my $self = shift;
my $myconfig = shift;
my $form = shift;
my $dbh = $form->get_standard_dbh;
a87dd0ec Sven Schöling
my %args = @_; # index => part_id
b3501bdf Moritz Bunkus
dd011621 Sven Schöling
$form->{taxzone_id} *= 1;
b3501bdf Moritz Bunkus
a87dd0ec Sven Schöling
return unless grep $_, values %args; # shortfuse if no part_id supplied

1228aa97 Sven Schöling
# transdate madness.
b3501bdf Moritz Bunkus
my $transdate = "";
a2ab888d digifoto
if ($form->{type} eq "invoice" or $form->{type} eq "credit_note") {
# use deliverydate for sales and purchase invoice, if it exists
# also use deliverydate for credit notes
if (!$form->{deliverydate}) {
$transdate = $form->{invdate};
} else {
$transdate = $form->{deliverydate};
}
} elsif ($form->{script} eq 'ir.pl') {
# when a purchase invoice is opened from the report of purchase invoices
# $form->{type} isn't set, but $form->{script} is, not sure why this is or
# whether this distinction matters in some other scenario. Otherwise one
# could probably take out this elsif and add a
# " or $form->{script} eq 'ir.pl' "
# to the above if-statement
if (!$form->{deliverydate}) {
b3501bdf Moritz Bunkus
$transdate = $form->{invdate};
} else {
$transdate = $form->{deliverydate};
}
a1a1263b Geoffrey Richardson
} elsif (($form->{type} eq "credit_note") and $form->{deliverydate}) {
# if credit_note has a deliverydate, use this instead of invdate
# useful for credit_notes of invoices from an old period with different tax
# if there is no deliverydate then invdate is used, old default (see next elsif)
2f6e7625 Jan Büren
# Falls hier der Stichtag für Steuern anders bestimmt wird,
# entsprechend auch bei Taxkeys.pm anpassen
a1a1263b Geoffrey Richardson
$transdate = $form->{deliverydate};
1cb6c085 Moritz Bunkus
} elsif (($form->{type} eq "credit_note") || ($form->{script} eq 'ir.pl')) {
0c7cc1e4 Moritz Bunkus
$transdate = $form->{invdate};
b3501bdf Moritz Bunkus
} else {
$transdate = $form->{transdate};
}

if ($transdate eq "") {
6fd4ac20 Moritz Bunkus
$transdate = DateTime->today_local->to_lxoffice;
b3501bdf Moritz Bunkus
} else {
a9a6bc13 Holger Lindemann
$transdate = $dbh->quote($transdate);
b3501bdf Moritz Bunkus
}
1228aa97 Sven Schöling
#/transdate
ee454f5b Sven Schöling
my $inc_exp = $form->{"vc"} eq "customer" ? "income_accno_id" : "expense_accno_id";
a87dd0ec Sven Schöling
my @part_ids = grep { $_ } values %args;
my $in = join ',', ('?') x @part_ids;
b3501bdf Moritz Bunkus
a87dd0ec Sven Schöling
my %accno_by_part = map { $_->{id} => $_ }
selectall_hashref_query($form, $dbh, <<SQL, @part_ids);
dd011621 Sven Schöling
SELECT
a87dd0ec Sven Schöling
p.id, p.inventory_accno_id AS is_part,
dd011621 Sven Schöling
bg.inventory_accno_id,
bg.income_accno_id_$form->{taxzone_id} AS income_accno_id,
bg.expense_accno_id_$form->{taxzone_id} AS expense_accno_id,
c1.accno AS inventory_accno,
c2.accno AS income_accno,
c3.accno AS expense_accno
FROM parts p
LEFT JOIN buchungsgruppen bg ON p.buchungsgruppen_id = bg.id
LEFT JOIN chart c1 ON bg.inventory_accno_id = c1.id
LEFT JOIN chart c2 ON bg.income_accno_id_$form->{taxzone_id} = c2.id
LEFT JOIN chart c3 ON bg.expense_accno_id_$form->{taxzone_id} = c3.id
a87dd0ec Sven Schöling
WHERE p.id IN ($in)
dd011621 Sven Schöling
SQL
b3501bdf Moritz Bunkus
6f7c3b10 Sven Schöling
my $sth_tax = prepare_query($::form, $dbh, <<SQL);
dd011621 Sven Schöling
SELECT c.accno, t.taxdescription AS description, t.rate, t.taxnumber
FROM tax t
LEFT JOIN chart c ON c.id = t.chart_id
WHERE t.id IN
(SELECT tk.tax_id
FROM taxkeys tk
a9a6bc13 Holger Lindemann
WHERE tk.chart_id = ? AND startdate <= ?
dd011621 Sven Schöling
ORDER BY startdate DESC LIMIT 1)
SQL
70a063c3 Moritz Bunkus
a87dd0ec Sven Schöling
while (my ($index => $part_id) = each %args) {
my $ref = $accno_by_part{$part_id} or next;
1228aa97 Sven Schöling
$ref->{"inventory_accno_id"} = undef unless $ref->{"is_part"};

my %accounts;
for my $type (qw(inventory income expense)) {
next unless $ref->{"${type}_accno_id"};
($accounts{"${type}_accno_id"}, $accounts{"${type}_accno"}) =
$self->follow_account_chain($form, $dbh, $transdate, $ref->{"${type}_accno_id"}, $ref->{"${type}_accno"});
}

$form->{"${_}_accno_$index"} = $accounts{"${_}_accno"} for qw(inventory income expense);

a9a6bc13 Holger Lindemann
$sth_tax->execute($accounts{$inc_exp}, quote_db_date($transdate));
6f7c3b10 Sven Schöling
$ref = $sth_tax->fetchrow_hashref or next;
1228aa97 Sven Schöling
$form->{"taxaccounts_$index"} = $ref->{"accno"};
$form->{"taxaccounts"} .= "$ref->{accno} "if $form->{"taxaccounts"} !~ /$ref->{accno}/;
b3501bdf Moritz Bunkus
1228aa97 Sven Schöling
$form->{"$ref->{accno}_${_}"} = $ref->{$_} for qw(rate description taxnumber);
b3501bdf Moritz Bunkus
}

6f7c3b10 Sven Schöling
$sth_tax->finish;

a87dd0ec Sven Schöling
$::lxdebug->leave_sub;
b3501bdf Moritz Bunkus
}
213317d3 Moritz Bunkus
8c7e4493 Moritz Bunkus
sub get_basic_part_info {
$main::lxdebug->enter_sub();

my $self = shift;
my %params = @_;

Common::check_params(\%params, qw(id));

my @ids = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});

if (!scalar @ids) {
$main::lxdebug->leave_sub();
return ();
}

my $myconfig = \%main::myconfig;
my $form = $main::form;

my $dbh = $form->get_standard_dbh($myconfig);

cc3a0a33 Sven Schöling
my $query = qq|SELECT * FROM parts WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
8c7e4493 Moritz Bunkus
my $info = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);

if ('' eq ref $params{id}) {
$info = $info->[0] || { };

$main::lxdebug->leave_sub();
return $info;
}

my %info_map = map { $_->{id} => $_ } @{ $info };

$main::lxdebug->leave_sub();

return %info_map;
}

47c3bf62 Moritz Bunkus
sub prepare_parts_for_printing {
$main::lxdebug->enter_sub();

my $self = shift;
my %params = @_;

my $myconfig = \%main::myconfig;
my $form = $main::form;

my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);

my $prefix = $params{prefix} || 'id_';
my $rowcount = defined $params{rowcount} ? $params{rowcount} : $form->{rowcount};

my @part_ids = keys %{ { map { $_ => 1 } grep { $_ } map { $form->{"${prefix}${_}"} } (1 .. $rowcount) } };

if (!@part_ids) {
$main::lxdebug->leave_sub();
return;
}

my $placeholders = join ', ', ('?') x scalar(@part_ids);
9a7a811d Bernd Bleßmann
my $query = qq|SELECT mm.parts_id, mm.model, mm.lastcost, v.name AS make
4bbf708c Geoffrey Richardson
FROM makemodel mm
9cd47c3f Geoffrey Richardson
LEFT JOIN vendor v ON (mm.make = v.id)
4bbf708c Geoffrey Richardson
WHERE mm.parts_id IN ($placeholders)|;

47c3bf62 Moritz Bunkus
my %makemodel = ();

my $sth = prepare_execute_query($form, $dbh, $query, @part_ids);

while (my $ref = $sth->fetchrow_hashref()) {
$makemodel{$ref->{parts_id}} ||= [];
push @{ $makemodel{$ref->{parts_id}} }, $ref;
}

$sth->finish();

b5a41731 Sven Schöling
my @columns = qw(ean image microfiche drawing weight);
47c3bf62 Moritz Bunkus
$query = qq|SELECT id, | . join(', ', @columns) . qq|
FROM parts
WHERE id IN ($placeholders)|;

my %data = selectall_as_map($form, $dbh, $query, 'id', \@columns, @part_ids);

b5a41731 Sven Schöling
map { $form->{TEMPLATE_ARRAYS}{$_} = [] } (qw(make model), @columns);
47c3bf62 Moritz Bunkus
foreach my $i (1 .. $rowcount) {
my $id = $form->{"${prefix}${i}"};

next if (!$id);

foreach (@columns) {
b5a41731 Sven Schöling
push @{ $form->{TEMPLATE_ARRAYS}{$_} }, $data{$id}->{$_};
47c3bf62 Moritz Bunkus
}

b5a41731 Sven Schöling
push @{ $form->{TEMPLATE_ARRAYS}{make} }, [];
push @{ $form->{TEMPLATE_ARRAYS}{model} }, [];
47c3bf62 Moritz Bunkus
next if (!$makemodel{$id});

foreach my $ref (@{ $makemodel{$id} }) {
b5a41731 Sven Schöling
map { push @{ $form->{TEMPLATE_ARRAYS}{$_}->[-1] }, $ref->{$_} } qw(make model);
47c3bf62 Moritz Bunkus
}
}

$main::lxdebug->leave_sub();
}

8c7e4493 Moritz Bunkus
d319704a Moritz Bunkus
1;