Projekt

Allgemein

Profil

Herunterladen (120 KB) Statistiken
| Zweig: | Markierung: | Revision:
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) 1998-2002
#
# 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
f7b15d43 Christian Wittmer
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1335, USA.
d319704a Moritz Bunkus
#======================================================================
#
# Inventory invoicing module
#
#======================================================================

package IS;

7be3a773 Bernd Bleßmann
use List::Util qw(max sum0);
b73ca44e Bernd Bleßmann
use List::MoreUtils qw(any);
d9c9bc22 Moritz Bunkus
c1ec3f4f Geoffrey Richardson
use Carp;
b8330aee Jan Büren
use Data::Dumper;

54e4131e Moritz Bunkus
use SL::AM;
247a26dc Moritz Bunkus
use SL::ARAP;
8688e71e Moritz Bunkus
use SL::CVar;
8e206587 Moritz Bunkus
use SL::Common;
7e7a1369 Sven Schöling
use SL::DATEV qw(:CONSTANTS);
f2463a51 Tamino Steinert
use SL::Util qw(trim);
5b47ed3e Moritz Bunkus
use SL::DBUtils;
3c1ceacd Moritz Bunkus
use SL::DO;
e09347c8 Geoffrey Richardson
use SL::GenericTranslations;
5f6d6d4e Moritz Bunkus
use SL::HTML::Restrict;
1a83013a Jan Büren
use SL::Locale::String qw(t8);
5fdc44cb Moritz Bunkus
use SL::MoreCommon;
47c3bf62 Moritz Bunkus
use SL::IC;
40c2c37c Moritz Bunkus
use SL::IO;
6dcf04cf Moritz Bunkus
use SL::TransNumber;
044c3707 Bernd Bleßmann
use SL::DB::Chart;
db101cc6 Cem Aydin
use SL::DB::Customer;
97954312 Bernd Bleßmann
use SL::DB::Default;
c954dea7 Moritz Bunkus
use SL::DB::Draft;
e90048c8 Bernd Bleßmann
use SL::DB::Tax;
1c62d23e Geoffrey Richardson
use SL::DB::TaxZone;
7e4a1765 Bernd Bleßmann
use SL::DB::ValidityToken;
99724025 Moritz Bunkus
use SL::TransNumber;
b9442827 Sven Schöling
use SL::DB;
0aa885f4 Sven Schöling
use SL::Presenter::Part qw(type_abbreviation classification_abbreviation);
db101cc6 Cem Aydin
use SL::Helper::QrBillFunctions qw(get_qrbill_account assemble_ref_number);
aab96bbe Cem Aydin
use SL::Helper::ISO3166;
76c486e3 Sven Schöling
use strict;
65d2537d Martin Helmling
use constant PCLASS_OK => 0;
use constant PCLASS_NOTFORSALE => 1;
use constant PCLASS_NOTFORPURCHASE => 2;
76c486e3 Sven Schöling
d319704a Moritz Bunkus
sub invoice_details {
$main::lxdebug->enter_sub();

c1ec3f4f Geoffrey Richardson
# prepare invoice for printing

d319704a Moritz Bunkus
my ($self, $myconfig, $form, $locale) = @_;

532b0d4c Moritz Bunkus
$form->{duedate} ||= $form->{invdate};
d319704a Moritz Bunkus
# connect to database
74b9dd67 Sven Schöling
my $dbh = $form->get_standard_dbh;
532b0d4c Moritz Bunkus
my $sth;
d319704a Moritz Bunkus
fde1df0b Sven Schöling
my (@project_ids);
51649b5b Sven Schöling
$form->{TEMPLATE_ARRAYS} = {};
96d10ecc Moritz Bunkus
push(@project_ids, $form->{"globalproject_id"}) if ($form->{"globalproject_id"});

1e251313 Moritz Bunkus
$form->get_lists('price_factors' => 'ALL_PRICE_FACTORS');
my %price_factors;

foreach my $pfac (@{ $form->{ALL_PRICE_FACTORS} }) {
$price_factors{$pfac->{id}} = $pfac;
$pfac->{factor} *= 1;
$pfac->{formatted_factor} = $form->format_amount($myconfig, $pfac->{factor});
}

96d10ecc Moritz Bunkus
# sort items by partsgroup
b8da8785 Sven Schöling
for my $i (1 .. $form->{rowcount}) {
# $partsgroup = "";
# if ($form->{"partsgroup_$i"} && $form->{groupitems}) {
# $partsgroup = $form->{"partsgroup_$i"};
# }
# push @partsgroup, [$i, $partsgroup];
96d10ecc Moritz Bunkus
push(@project_ids, $form->{"project_id_$i"}) if ($form->{"project_id_$i"});
}

fde1df0b Sven Schöling
my $projects = [];
my %projects_by_id;
96d10ecc Moritz Bunkus
if (@project_ids) {
fde1df0b Sven Schöling
$projects = SL::DB::Manager::Project->get_all(query => [ id => \@project_ids ]);
%projects_by_id = map { $_->id => $_ } @$projects;
96d10ecc Moritz Bunkus
}

fde1df0b Sven Schöling
if ($projects_by_id{$form->{"globalproject_id"}}) {
896ef9aa Sven Schöling
$form->{globalprojectnumber} = $projects_by_id{$form->{"globalproject_id"}}->projectnumber;
$form->{globalprojectdescription} = $projects_by_id{$form->{"globalproject_id"}}->description;

fde1df0b Sven Schöling
for (@{ $projects_by_id{$form->{"globalproject_id"}}->cvars_by_config }) {
$form->{"project_cvar_" . $_->config->name} = $_->value_as_text;
}
}
96d10ecc Moritz Bunkus
d319704a Moritz Bunkus
my $tax = 0;
my $item;
my $i;
my @partsgroup = ();
my $partsgroup;

# sort items by partsgroup
for $i (1 .. $form->{rowcount}) {
$partsgroup = "";
if ($form->{"partsgroup_$i"} && $form->{groupitems}) {
$partsgroup = $form->{"partsgroup_$i"};
}
push @partsgroup, [$i, $partsgroup];
}

my $sameitem = "";
my @taxaccounts;
my %taxaccounts;
my %taxbase;
my $taxrate;
my $taxamount;
my $taxbase;
my $taxdiff;
54e4131e Moritz Bunkus
my $nodiscount;
my $yesdiscount;
my $nodiscount_subtotal = 0;
my $discount_subtotal = 0;
my $position = 0;
my $subtotal_header = 0;
my $subposition = 0;

af59820c Moritz Bunkus
$form->{discount} = [];

0e470b13 Bernd Bleßmann
# get some values of parts from db on store them in extra array,
# so that they can be sorted in later
my %prepared_template_arrays = IC->prepare_parts_for_printing(myconfig => $myconfig, form => $form);
my @prepared_arrays = keys %prepared_template_arrays;
219d88ab Martin Helmling
my @separate_totals = qw(non_separate_subtotal);
47c3bf62 Moritz Bunkus
98452aaa Moritz Bunkus
my $ic_cvar_configs = CVar->get_configs(module => 'IC');
fde1df0b Sven Schöling
my $project_cvar_configs = CVar->get_configs(module => 'Projects');
98452aaa Moritz Bunkus
96d10ecc Moritz Bunkus
my @arrays =
0e470b13 Bernd Bleßmann
qw(runningnumber number description longdescription qty qty_nofmt unit bin
deliverydate_oe ordnumber_oe donumber_do transdate_oe invnumber invdate
partnotes serialnumber reqdate sellprice sellprice_nofmt listprice listprice_nofmt netprice netprice_nofmt
discount discount_nofmt p_discount discount_sub discount_sub_nofmt nodiscount_sub nodiscount_sub_nofmt
linetotal linetotal_nofmt nodiscount_linetotal nodiscount_linetotal_nofmt tax_rate projectnumber projectdescription
price_factor price_factor_name partsgroup weight weight_nofmt lineweight lineweight_nofmt);
96d10ecc Moritz Bunkus
98452aaa Moritz Bunkus
push @arrays, map { "ic_cvar_$_->{name}" } @{ $ic_cvar_configs };
fde1df0b Sven Schöling
push @arrays, map { "project_cvar_$_->{name}" } @{ $project_cvar_configs };
98452aaa Moritz Bunkus
4e8e33e9 Geoffrey Richardson
my @tax_arrays = qw(taxbase tax taxdescription taxrate taxnumber tax_id);
9c63c160 Moritz Bunkus
my @payment_arrays = qw(payment paymentaccount paymentdate paymentsource paymentmemo);

b82c049e Bernd Bleßmann
my @invoices_for_advance_payment_arrays = qw(iap_invnumber iap_transdate
iap_amount iap_amount_nofmt
iap_taxamount iap_taxamount_nofmt
44b4b931 Jan Büren
iap_open_amount iap_open_amount_nofmt
iap_netamount);
7be3a773 Bernd Bleßmann
map { $form->{TEMPLATE_ARRAYS}->{$_} = [] } (@arrays, @tax_arrays, @payment_arrays, @prepared_arrays, @invoices_for_advance_payment_arrays);
96d10ecc Moritz Bunkus
79c048aa Niclas Zimmermann
my $totalweight = 0;
d319704a Moritz Bunkus
foreach $item (sort { $a->[1] cmp $b->[1] } @partsgroup) {
$i = $item->[0];

if ($item->[1] ne $sameitem) {
0e470b13 Bernd Bleßmann
push(@{ $form->{TEMPLATE_ARRAYS}->{entry_type} }, 'partsgroup');
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{description} }, qq|$item->[1]|);
d319704a Moritz Bunkus
$sameitem = $item->[1];

0e470b13 Bernd Bleßmann
map({ push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, "") } grep({ $_ ne "description" } (@arrays, @prepared_arrays)));
d319704a Moritz Bunkus
}

$form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});

8c89bb02 Moritz Bunkus
if ($form->{"id_$i"} != 0) {
d319704a Moritz Bunkus
c1ec3f4f Geoffrey Richardson
# Prepare linked items for printing
if ( $form->{"invoice_id_$i"} ) {

require SL::DB::InvoiceItem;
my $invoice_item = SL::DB::Manager::InvoiceItem->find_by( id => $form->{"invoice_id_$i"} );
my $linkeditems = $invoice_item->linked_records( direction => 'from', recursive => 1 );

# check for (recursively) linked sales quotation items, sales order
# items and sales delivery order items.

# The checks for $form->{"ordnumber_$i"} and quo and do are for the old
# behaviour, where this data was stored in its own database fields in
# the invoice items, and there were no record links for the items.

# If this information were to be fetched in retrieve_invoice, e.g. for showing
# this information in the second row, then these fields will already have
# been set and won't be calculated again. This shouldn't be done there
# though, as each invocation creates several database calls per item, and would
# make the interface very slow for many items. So currently these
# requests are only made when printing the record.

# When using the workflow an invoice item can only be (recursively) linked to at
# most one sales quotation item and at most one delivery order item. But it may
# be linked back to several order items, if collective orders were involved. If
# that is the case we will always choose the very first order item from the
# original order, i.e. where it first appeared in an order.

# TODO: credit note items aren't checked for a record link to their
# invoice item

unless ( $form->{"ordnumber_$i"} ) {

# $form->{"ordnumber_$i"} comes from ordnumber in invoice, if an
# entry exists this must be from before the change from ordnumber to linked items.
# So we just use that value and don't check for linked items.
# In that case there won't be any links for quo or do items either

# sales order items are fetched and sorted by id, the lowest id is first
# It is assumed that the id always grows, so the item we want (the original) will have the lowest id
# better solution: filter the order_item that doesn't have any links from other order_items
# or maybe fetch linked_records with param save_path and order by _record_length_depth
my @linked_orderitems = grep { $_->isa("SL::DB::OrderItem") && $_->record->type eq 'sales_order' } @{$linkeditems};
if ( scalar @linked_orderitems ) {
@linked_orderitems = sort { $a->id <=> $b->id } @linked_orderitems;
my $orderitem = $linked_orderitems[0]; # 0: the original order item, -1: the last collective order item

$form->{"ordnumber_$i"} = $orderitem->record->record_number;
$form->{"transdate_oe_$i"} = $orderitem->record->transdate->to_kivitendo;
$form->{"cusordnumber_oe_$i"} = $orderitem->record->cusordnumber;
};

my @linked_quoitems = grep { $_->isa("SL::DB::OrderItem") && $_->record->type eq 'sales_quotation' } @{$linkeditems};
if ( scalar @linked_quoitems ) {
croak "an invoice item may only be linked back to 1 sales quotation item, something is wrong\n" unless scalar @linked_quoitems == 1;
$form->{"quonumber_$i"} = $linked_quoitems[0]->record->record_number;
$form->{"transdate_quo_$i"} = $linked_quoitems[0]->record->transdate->to_kivitendo;
};

my @linked_deliveryorderitems = grep { $_->isa("SL::DB::DeliveryOrderItem") && $_->record->type eq 'sales_delivery_order' } @{$linkeditems};
if ( scalar @linked_deliveryorderitems ) {
croak "an invoice item may only be linked back to 1 sales delivery item, something is wrong\n" unless scalar @linked_deliveryorderitems == 1;
$form->{"donumber_$i"} = $linked_deliveryorderitems[0]->record->record_number;
$form->{"transdate_do_$i"} = $linked_deliveryorderitems[0]->record->transdate->to_kivitendo;
};
};
};


54e4131e Moritz Bunkus
# add number, description and qty to $form->{number},
if ($form->{"subtotal_$i"} && !$subtotal_header) {
$subtotal_header = $i;
$position = int($position);
$subposition = 0;
$position++;
} elsif ($subtotal_header) {
$subposition += 1;
$position = int($position);
$position = $position.".".$subposition;
} else {
$position = int($position);
$position++;
}
d9c9bc22 Moritz Bunkus
1e251313 Moritz Bunkus
my $price_factor = $price_factors{$form->{"price_factor_id_$i"}} || { 'factor' => 1 };

0e470b13 Bernd Bleßmann
push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, $prepared_template_arrays{$_}[$i - 1]) for @prepared_arrays;

push @{ $form->{TEMPLATE_ARRAYS}->{entry_type} }, 'normal';
9c63c160 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{runningnumber} }, $position;
push @{ $form->{TEMPLATE_ARRAYS}->{number} }, $form->{"partnumber_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{serialnumber} }, $form->{"serialnumber_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{bin} }, $form->{"bin_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{partnotes} }, $form->{"partnotes_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{description} }, $form->{"description_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{longdescription} }, $form->{"longdescription_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"});
8461199d Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{qty_nofmt} }, $form->{"qty_$i"};
9c63c160 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{unit} }, $form->{"unit_$i"};
103bf7e8 Sven Schöling
push @{ $form->{TEMPLATE_ARRAYS}->{deliverydate_oe} }, $form->{"reqdate_$i"};
9c63c160 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{sellprice} }, $form->{"sellprice_$i"};
8461199d Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{sellprice_nofmt} }, $form->parse_amount($myconfig, $form->{"sellprice_$i"});
c1ec3f4f Geoffrey Richardson
# linked item print variables
push @{ $form->{TEMPLATE_ARRAYS}->{quonumber_quo} }, $form->{"quonumber_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{transdate_quo} }, $form->{"transdate_quo_$i"};
9c63c160 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{ordnumber_oe} }, $form->{"ordnumber_$i"};
c1ec3f4f Geoffrey Richardson
push @{ $form->{TEMPLATE_ARRAYS}->{transdate_oe} }, $form->{"transdate_oe_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{cusordnumber_oe} }, $form->{"cusordnumber_oe_$i"};
bb7e2e85 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{donumber_do} }, $form->{"donumber_$i"};
c1ec3f4f Geoffrey Richardson
push @{ $form->{TEMPLATE_ARRAYS}->{transdate_do} }, $form->{"transdate_do_$i"};

9c63c160 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{invnumber} }, $form->{"invnumber"};
push @{ $form->{TEMPLATE_ARRAYS}->{invdate} }, $form->{"invdate"};
push @{ $form->{TEMPLATE_ARRAYS}->{price_factor} }, $price_factor->{formatted_factor};
push @{ $form->{TEMPLATE_ARRAYS}->{price_factor_name} }, $price_factor->{description};
push @{ $form->{TEMPLATE_ARRAYS}->{partsgroup} }, $form->{"partsgroup_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{reqdate} }, $form->{"reqdate_$i"};
2f6636f6 Bernd Bleßmann
push @{ $form->{TEMPLATE_ARRAYS}->{listprice} }, $form->format_amount($myconfig, $form->{"listprice_$i"}, 2);
push(@{ $form->{TEMPLATE_ARRAYS}->{listprice_nofmt} }, $form->{"listprice_$i"});
d319704a Moritz Bunkus
d9c9bc22 Moritz Bunkus
my $sellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"});
my ($dec) = ($sellprice =~ /\.(\d+)/);
my $decimalplaces = max 2, length($dec);
d319704a Moritz Bunkus
c126984e Geoffrey Richardson
my $parsed_discount = $form->parse_amount($myconfig, $form->{"discount_$i"});

my $linetotal_exact = $form->{"qty_$i"} * $sellprice * (100 - $parsed_discount) / 100 / $price_factor->{factor};
my $linetotal = $form->round_amount($linetotal_exact, 2);

my $nodiscount_exact_linetotal = $form->{"qty_$i"} * $sellprice / $price_factor->{factor};
my $nodiscount_linetotal = $form->round_amount($nodiscount_exact_linetotal,2);

my $discount = $nodiscount_linetotal - $linetotal; # is always rounded because $nodiscount_linetotal and $linetotal are rounded

my $discount_round_error = $discount + ($linetotal_exact - $nodiscount_exact_linetotal); # not used

99d8aaf4 Geoffrey Richardson
$form->{"netprice_$i"} = $form->round_amount($form->{"qty_$i"} ? ($linetotal / $form->{"qty_$i"}) : 0, $decimalplaces);
d9c9bc22 Moritz Bunkus
8461199d Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : '';
push @{ $form->{TEMPLATE_ARRAYS}->{netprice_nofmt} }, ($form->{"netprice_$i"} != 0) ? $form->{"netprice_$i"} : '';
d9c9bc22 Moritz Bunkus
$linetotal = ($linetotal != 0) ? $linetotal : '';

8461199d Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{discount} }, ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, 2) : '';
push @{ $form->{TEMPLATE_ARRAYS}->{discount_nofmt} }, ($discount != 0) ? $discount * -1 : '';
push @{ $form->{TEMPLATE_ARRAYS}->{p_discount} }, $form->{"discount_$i"};
d9c9bc22 Moritz Bunkus
219d88ab Martin Helmling
if ( $prepared_template_arrays{separate}[$i - 1] ) {
my $pabbr = $prepared_template_arrays{separate}[$i - 1];
if ( ! $form->{"separate_${pabbr}_subtotal"} ) {
push @separate_totals , "separate_${pabbr}_subtotal";
$form->{"separate_${pabbr}_subtotal"} = 0;
}
$form->{"separate_${pabbr}_subtotal"} += $linetotal;
} else {
$form->{non_separate_subtotal} += $linetotal;
}

d9c9bc22 Moritz Bunkus
$form->{total} += $linetotal;
54e4131e Moritz Bunkus
$form->{nodiscount_total} += $nodiscount_linetotal;
d9c9bc22 Moritz Bunkus
$form->{discount_total} += $discount;

if ($subtotal_header) {
$discount_subtotal += $linetotal;
$nodiscount_subtotal += $nodiscount_linetotal;
}
54e4131e Moritz Bunkus
if ($form->{"subtotal_$i"} && $subtotal_header && ($subtotal_header != $i)) {
8461199d Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub} }, $form->format_amount($myconfig, $discount_subtotal, 2);
push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub_nofmt} }, $discount_subtotal;
push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub} }, $form->format_amount($myconfig, $nodiscount_subtotal, 2);
push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub_nofmt} }, $nodiscount_subtotal;
d9c9bc22 Moritz Bunkus
$discount_subtotal = 0;
54e4131e Moritz Bunkus
$nodiscount_subtotal = 0;
d9c9bc22 Moritz Bunkus
$subtotal_header = 0;

54e4131e Moritz Bunkus
} else {
e1a38ef7 Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{$_} }, "" for qw(discount_sub nodiscount_sub discount_sub_nofmt nodiscount_sub_nofmt);
54e4131e Moritz Bunkus
}

d9c9bc22 Moritz Bunkus
if (!$form->{"discount_$i"}) {
54e4131e Moritz Bunkus
$nodiscount += $linetotal;
}
d319704a Moritz Bunkus
8461199d Moritz Bunkus
push @{ $form->{TEMPLATE_ARRAYS}->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2);
push @{ $form->{TEMPLATE_ARRAYS}->{linetotal_nofmt} }, $linetotal_exact;
push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal} }, $form->format_amount($myconfig, $nodiscount_linetotal, 2);
push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal_nofmt} }, $nodiscount_linetotal;
54e4131e Moritz Bunkus
fde1df0b Sven Schöling
my $project = $projects_by_id{$form->{"project_id_$i"}} || SL::DB::Project->new;

push @{ $form->{TEMPLATE_ARRAYS}->{projectnumber} }, $project->projectnumber;
push @{ $form->{TEMPLATE_ARRAYS}->{projectdescription} }, $project->description;
d319704a Moritz Bunkus
79c048aa Niclas Zimmermann
my $lineweight = $form->{"qty_$i"} * $form->{"weight_$i"};
$totalweight += $lineweight;
push @{ $form->{TEMPLATE_ARRAYS}->{weight} }, $form->format_amount($myconfig, $form->{"weight_$i"}, 3);
push @{ $form->{TEMPLATE_ARRAYS}->{weight_nofmt} }, $form->{"weight_$i"};
push @{ $form->{TEMPLATE_ARRAYS}->{lineweight} }, $form->format_amount($myconfig, $lineweight, 3);
push @{ $form->{TEMPLATE_ARRAYS}->{lineweight_nofmt} }, $lineweight;

532b0d4c Moritz Bunkus
@taxaccounts = split(/ /, $form->{"taxaccounts_$i"});
d319704a Moritz Bunkus
$taxrate = 0;
$taxdiff = 0;

map { $taxrate += $form->{"${_}_rate"} } @taxaccounts;

if ($form->{taxincluded}) {

# calculate tax
$taxamount = $linetotal * $taxrate / (1 + $taxrate);
$taxbase = $linetotal - $taxamount;
} else {
$taxamount = $linetotal * $taxrate;
$taxbase = $linetotal;
}

if ($form->round_amount($taxrate, 7) == 0) {
if ($form->{taxincluded}) {
eeb560af Moritz Bunkus
foreach my $accno (@taxaccounts) {
$taxamount = $form->round_amount($linetotal * $form->{"${accno}_rate"} / (1 + abs($form->{"${accno}_rate"})), 2);
d319704a Moritz Bunkus
eeb560af Moritz Bunkus
$taxaccounts{$accno} += $taxamount;
$taxdiff += $taxamount;
d319704a Moritz Bunkus
eeb560af Moritz Bunkus
$taxbase{$accno} += $taxbase;
d319704a Moritz Bunkus
}
$taxaccounts{ $taxaccounts[0] } += $taxdiff;
} else {
eeb560af Moritz Bunkus
foreach my $accno (@taxaccounts) {
$taxaccounts{$accno} += $linetotal * $form->{"${accno}_rate"};
$taxbase{$accno} += $taxbase;
d319704a Moritz Bunkus
}
}
} else {
eeb560af Moritz Bunkus
foreach my $accno (@taxaccounts) {
$taxaccounts{$accno} += $taxamount * $form->{"${accno}_rate"} / $taxrate;
$taxbase{$accno} += $taxbase;
d319704a Moritz Bunkus
}
}
b8da8785 Sven Schöling
my $tax_rate = $taxrate * 100;
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{tax_rate} }, qq|$tax_rate|);
5bc5af9f Geoffrey Richardson
if ($form->{"part_type_$i"} eq 'assembly') {
d319704a Moritz Bunkus
$sameitem = "";

# get parts and push them onto the stack
my $sortorder = "";
if ($form->{groupitems}) {
$sortorder =
53db54a8 Moritz Bunkus
qq|ORDER BY pg.partsgroup, a.position|;
d319704a Moritz Bunkus
} else {
53db54a8 Moritz Bunkus
$sortorder = qq|ORDER BY a.position|;
d319704a Moritz Bunkus
}

464f44ac Moritz Bunkus
my $query =
532b0d4c Moritz Bunkus
qq|SELECT p.partnumber, p.description, p.unit, a.qty, pg.partsgroup
FROM assembly a
JOIN parts p ON (a.parts_id = p.id)
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
WHERE (a.bom = '1') AND (a.id = ?) $sortorder|;
$sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{"id_$i"}));
d319704a Moritz Bunkus
b8da8785 Sven Schöling
while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
if ($form->{groupitems} && $ref->{partsgroup} ne $sameitem) {
0e470b13 Bernd Bleßmann
map({ push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, "") } grep({ $_ ne "description" } (@arrays, @prepared_arrays)));
d319704a Moritz Bunkus
$sameitem = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--";
0e470b13 Bernd Bleßmann
push(@{ $form->{TEMPLATE_ARRAYS}->{entry_type} }, 'assembly-item-partsgroup');
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{description} }, $sameitem);
d319704a Moritz Bunkus
}

map { $form->{"a_$_"} = $ref->{$_} } qw(partnumber description);

0e470b13 Bernd Bleßmann
push(@{ $form->{TEMPLATE_ARRAYS}->{entry_type} }, 'assembly-item');
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{description} },
d319704a Moritz Bunkus
$form->format_amount($myconfig, $ref->{qty} * $form->{"qty_$i"}
)
. qq| -- $form->{"a_partnumber"}, $form->{"a_description"}|);
0e470b13 Bernd Bleßmann
map({ push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, "") } grep({ $_ ne "description" } (@arrays, @prepared_arrays)));
d319704a Moritz Bunkus
}
$sth->finish;
}
98452aaa Moritz Bunkus
be42a450 Bernd Bleßmann
CVar->get_non_editable_ic_cvars(form => $form,
dbh => $dbh,
97ac8565 Jan Büren
row => $i,
be42a450 Bernd Bleßmann
sub_module => 'invoice',
may_converted_from => ['delivery_order_items', 'orderitems', 'invoice']);
d557935a Bernd Bleßmann
d729e328 Sven Schöling
push @{ $form->{TEMPLATE_ARRAYS}->{"ic_cvar_$_->{name}"} },
CVar->format_to_template(CVar->parse($form->{"ic_cvar_$_->{name}_$i"}, $_), $_)
for @{ $ic_cvar_configs };
fde1df0b Sven Schöling
push @{ $form->{TEMPLATE_ARRAYS}->{"project_cvar_" . $_->config->name} }, $_->value_as_text for @{ $project->cvars_by_config };
d319704a Moritz Bunkus
}
}

79c048aa Niclas Zimmermann
$form->{totalweight} = $form->format_amount($myconfig, $totalweight, 3);
$form->{totalweight_nofmt} = $totalweight;
fe6275f8 Niclas Zimmermann
my $defaults = AM->get_defaults();
$form->{weightunit} = $defaults->{weightunit};
79c048aa Niclas Zimmermann
d319704a Moritz Bunkus
foreach my $item (sort keys %taxaccounts) {
54e4131e Moritz Bunkus
$tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2);
d319704a Moritz Bunkus
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2));
8461199d Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase_nofmt} }, $taxbase{$item});
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{tax} }, $form->format_amount($myconfig, $taxamount, 2));
8461199d Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{tax_nofmt} }, $taxamount );
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate} }, $form->format_amount($myconfig, $form->{"${item}_rate"} * 100));
8461199d Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate_nofmt} }, $form->{"${item}_rate"} * 100);
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{taxnumber} }, $form->{"${item}_taxnumber"});
4e8e33e9 Geoffrey Richardson
push(@{ $form->{TEMPLATE_ARRAYS}->{tax_id} }, $form->{"${item}_tax_id"});
e90048c8 Bernd Bleßmann
4e8e33e9 Geoffrey Richardson
# taxnumber (= accno) is used for grouping the amounts of the various taxes and as a prefix in form
543d7822 Geoffrey Richardson
4e8e33e9 Geoffrey Richardson
# This code used to assume that at most one tax entry can point to the same
543d7822 Geoffrey Richardson
# chart_id, even though chart_id does not have a unique constraint!

4e8e33e9 Geoffrey Richardson
# This chart_id was then looked up via its accno, which is the key that is
543d7822 Geoffrey Richardson
# used to group the different taxes by for a record

4e8e33e9 Geoffrey Richardson
# As we now also store the tax_id we can use that to look up the tax
# instead, this is only done here to get the (translated) taxdescription.
543d7822 Geoffrey Richardson
4e8e33e9 Geoffrey Richardson
if ( $form->{"${item}_tax_id"} ) {
my $tax_obj = SL::DB::Manager::Tax->find_by(id => $form->{"${item}_tax_id"}) or die "Can't find tax with id " . $form->{"${item}_tax_id"};
my $description = $tax_obj ? $tax_obj->translated_attribute('taxdescription', $form->{language_id}, 0) : '';
push(@{ $form->{TEMPLATE_ARRAYS}->{taxdescription} }, $description . q{ } . 100 * $form->{"${item}_rate"} . q{%});
543d7822 Geoffrey Richardson
}
4e8e33e9 Geoffrey Richardson
d319704a Moritz Bunkus
}

for my $i (1 .. $form->{paidaccounts}) {
if ($form->{"paid_$i"}) {
532b0d4c Moritz Bunkus
my ($accno, $description) = split(/--/, $form->{"AR_paid_$i"});
9c63c160 Moritz Bunkus
push(@{ $form->{TEMPLATE_ARRAYS}->{payment} }, $form->{"paid_$i"});
push(@{ $form->{TEMPLATE_ARRAYS}->{paymentaccount} }, $description);
push(@{ $form->{TEMPLATE_ARRAYS}->{paymentdate} }, $form->{"datepaid_$i"});
push(@{ $form->{TEMPLATE_ARRAYS}->{paymentsource} }, $form->{"source_$i"});
push(@{ $form->{TEMPLATE_ARRAYS}->{paymentmemo} }, $form->{"memo_$i"});
d319704a Moritz Bunkus
$form->{paid} += $form->parse_amount($myconfig, $form->{"paid_$i"});
}
}
02aab73f Thomas Kasulke
if($form->{taxincluded}) {
8461199d Moritz Bunkus
$form->{subtotal} = $form->format_amount($myconfig, $form->{total} - $tax, 2);
1e26c0d4 Wulf Coulmann
$form->{subtotal_nofmt} = $form->{total} - $tax;
02aab73f Thomas Kasulke
}
else {
8461199d Moritz Bunkus
$form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2);
1e26c0d4 Wulf Coulmann
$form->{subtotal_nofmt} = $form->{total};
02aab73f Thomas Kasulke
}
d9c9bc22 Moritz Bunkus
54e4131e Moritz Bunkus
$form->{nodiscount_subtotal} = $form->format_amount($myconfig, $form->{nodiscount_total}, 2);
d9c9bc22 Moritz Bunkus
$form->{discount_total} = $form->format_amount($myconfig, $form->{discount_total}, 2);
$form->{nodiscount} = $form->format_amount($myconfig, $nodiscount, 2);
$form->{yesdiscount} = $form->format_amount($myconfig, $form->{nodiscount_total} - $nodiscount, 2);
54e4131e Moritz Bunkus
c0cc8bb2 Rolf Fluehmann
my $grossamount = ($form->{taxincluded}) ? $form->{total} : $form->{total} + $tax;
$form->{invtotal} = $form->round_amount($grossamount, 2, 1);
$form->{rounding} = $form->round_amount(
$form->{invtotal} - $form->round_amount($grossamount, 2),
2
);

2ed8c38b Bernd Bleßmann
$form->{rounding_nofmt} = $form->{rounding};
$form->{total_nofmt} = $form->{total};
$form->{invtotal_nofmt} = $form->{invtotal};
$form->{paid_nofmt} = $form->{paid};

c0cc8bb2 Rolf Fluehmann
$form->{rounding} = $form->format_amount($myconfig, $form->{rounding}, 2);
d9c9bc22 Moritz Bunkus
$form->{total} = $form->format_amount($myconfig, $form->{invtotal} - $form->{paid}, 2);
b9b02c1a Philip Reetz
$form->{invtotal} = $form->format_amount($myconfig, $form->{invtotal}, 2);
d9c9bc22 Moritz Bunkus
$form->{paid} = $form->format_amount($myconfig, $form->{paid}, 2);

de009a3f Moritz Bunkus
$form->set_payment_options($myconfig, $form->{invdate}, 'sales_invoice');
d319704a Moritz Bunkus
6b64a63e Jan Büren
$form->{department} = SL::DB::Manager::Department->find_by(id => $form->{department_id})->description if $form->{department_id};
2134f89a Moritz Bunkus
$form->{delivery_term} = SL::DB::Manager::DeliveryTerm->find_by(id => $form->{delivery_term_id} || undef);
$form->{delivery_term}->description_long($form->{delivery_term}->translated_attribute('description_long', $form->{language_id})) if $form->{delivery_term} && $form->{language_id};
03d3d025 Bernd Bleßmann
d319704a Moritz Bunkus
$form->{username} = $myconfig->{name};
219d88ab Martin Helmling
$form->{$_} = $form->format_amount($myconfig, $form->{$_}, 2) for @separate_totals;
d319704a Moritz Bunkus
72e545d6 Bernd Bleßmann
my $id_for_iap = $form->{convert_from_oe_ids} || $form->{convert_from_ar_ids} || $form->{id};
my $from_order = !!$form->{convert_from_oe_ids};
foreach my $invoice_for_advance_payment (@{$self->_get_invoices_for_advance_payment($id_for_iap, $from_order)}) {
9c668ab9 Bernd Bleßmann
# Collect VAT of invoices for advance payment.
# Set sellprices to fxsellprices for items, because
# the PriceTaxCalculator sets fxsellprice from sellprice before calculating.
$_->sellprice($_->fxsellprice) for @{$invoice_for_advance_payment->items};
7be3a773 Bernd Bleßmann
my %pat = $invoice_for_advance_payment->calculate_prices_and_taxes;
my $taxamount = sum0 values %{ $pat{taxes_by_tax_id} };

07e01856 Bernd Bleßmann
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_$_"} }, $invoice_for_advance_payment->$_) for qw(invnumber transdate);
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_amount_nofmt"} }, $invoice_for_advance_payment->amount);
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_amount"} }, $invoice_for_advance_payment->amount_as_number);
44b4b931 Jan Büren
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_netamount"} }, $invoice_for_advance_payment->netamount_as_number);
07e01856 Bernd Bleßmann
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_taxamount_nofmt"} }, $taxamount);
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_taxamount"} }, $form->format_amount($myconfig, $taxamount, 2));

my $open_amount = $form->round_amount($invoice_for_advance_payment->open_amount, 2);
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_open_amount_nofmt"} }, $open_amount);
push(@{ $form->{TEMPLATE_ARRAYS}->{"iap_open_amount"} }, $form->format_amount($myconfig, $open_amount, 2));

$form->{iap_amount_nofmt} += $invoice_for_advance_payment->amount;
$form->{iap_taxamount_nofmt} += $taxamount;
$form->{iap_open_amount_nofmt} += $open_amount;
$form->{iap_existing} = 1;
7be3a773 Bernd Bleßmann
}
07e01856 Bernd Bleßmann
$form->{iap_amount} = $form->format_amount($myconfig, $form->{iap_amount_nofmt}, 2);
$form->{iap_taxamount} = $form->format_amount($myconfig, $form->{iap_taxamount_nofmt}, 2);
$form->{iap_open_amount} = $form->format_amount($myconfig, $form->{iap_open_amount_nofmt}, 2);
7be3a773 Bernd Bleßmann
2ed8c38b Bernd Bleßmann
$form->{iap_final_amount_nofmt} = $form->{invtotal_nofmt} - $form->{iap_amount_nofmt};
$form->{iap_final_amount} = $form->format_amount($myconfig, $form->{iap_final_amount_nofmt}, 2);

aab96bbe Cem Aydin
# set variables for swiss QR bill, if feature enabled
# handling errors gracefully (don't die if undef)
if ($::instance_conf->get_create_qrbill_invoices && $form->{formname} eq 'invoice') {
my ($qr_account, $error) = get_qrbill_account();
$form->{qrbill_iban} = $qr_account->{iban};

my $biller_country = $::instance_conf->get_address_country() || 'CH';
my $biller_countrycode = SL::Helper::ISO3166::map_name_to_alpha_2_code($biller_country);
$form->{qrbill_biller_countrycode} = $biller_countrycode;

my $customer_country = $form->{'country'} || 'CH';
my $customer_countrycode = SL::Helper::ISO3166::map_name_to_alpha_2_code($customer_country);
$form->{qrbill_customer_countrycode} = $customer_countrycode;

$form->{qrbill_amount} = sprintf("%.2f", $form->parse_amount($myconfig, $form->{'total'}));
}
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

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

f83b4aff Moritz Bunkus
my ($self, $myconfig, $form, @wanted_vars) = @_;
d319704a Moritz Bunkus
# connect to database
74b9dd67 Sven Schöling
my $dbh = $form->get_standard_dbh;
d319704a Moritz Bunkus
e09347c8 Geoffrey Richardson
my $language_id = $form->{language_id};

d319704a Moritz Bunkus
# get contact id, set it if nessessary
54e4131e Moritz Bunkus
$form->{cp_id} *= 1;
d319704a Moritz Bunkus
6ed3eaf6 Moritz Bunkus
my @values = (conv_i($form->{customer_id}));
532b0d4c Moritz Bunkus
my $where = "";
d319704a Moritz Bunkus
if ($form->{cp_id}) {
532b0d4c Moritz Bunkus
$where = qq| AND (cp.cp_id = ?) |;
push(@values, conv_i($form->{cp_id}));
d319704a Moritz Bunkus
}

# get rest for the customer
532b0d4c Moritz Bunkus
my $query =
qq|SELECT ct.*, cp.*, ct.notes as customernotes,
94802c79 Bernd Bleßmann
ct.phone AS customerphone, ct.fax AS customerfax, ct.email AS customeremail,
ba6a1366 Niclas Zimmermann
cu.name AS currency
532b0d4c Moritz Bunkus
FROM customer ct
LEFT JOIN contacts cp on ct.id = cp.cp_cv_id
ba6a1366 Niclas Zimmermann
LEFT JOIN currencies cu ON (ct.currency_id = cu.id)
532b0d4c Moritz Bunkus
WHERE (ct.id = ?) $where
ORDER BY cp.cp_id
LIMIT 1|;
my $ref = selectfirst_hashref_query($form, $dbh, $query, @values);
a4e4f1a7 Jan Büren
# we have no values, probably a invalid contact person. hotfix and first idea for issue #10
25e65781 Jan Büren
if (!$ref) {
my $customer = SL::DB::Manager::Customer->find_by(id => $::form->{customer_id});
a4e4f1a7 Jan Büren
if ($customer) {
$ref->{name} = $customer->name;
$ref->{street} = $customer->street;
$ref->{zipcode} = $customer->zipcode;
$ref->{country} = $customer->country;
1c181c11 Bernd Bleßmann
$ref->{gln} = $customer->gln;
a4e4f1a7 Jan Büren
}
25e65781 Jan Büren
my $contact = SL::DB::Manager::Contact->find_by(cp_id => $::form->{cp_id});
a4e4f1a7 Jan Büren
if ($contact) {
$ref->{cp_name} = $contact->cp_name;
$ref->{cp_givenname} = $contact->cp_givenname;
$ref->{cp_gender} = $contact->cp_gender;
}
25e65781 Jan Büren
}
c0ed7d2f Martin Helmling
# remove id,notes (double of customernotes) and taxincluded before copy back
delete @$ref{qw(id taxincluded notes)};
f83b4aff Moritz Bunkus
d416d4c4 Moritz Bunkus
@wanted_vars = grep({ $_ } @wanted_vars);
f83b4aff Moritz Bunkus
if (scalar(@wanted_vars) > 0) {
my %h_wanted_vars;
map({ $h_wanted_vars{$_} = 1; } @wanted_vars);
map({ delete($ref->{$_}) unless ($h_wanted_vars{$_}); } keys(%{$ref}));
}

7d2455cf Stephan Köhler
map { $form->{$_} = $ref->{$_} } keys %$ref;
54e4131e Moritz Bunkus
if ($form->{delivery_customer_id}) {
532b0d4c Moritz Bunkus
$query =
qq|SELECT *, notes as customernotes
FROM customer
WHERE id = ?
LIMIT 1|;
$ref = selectfirst_hashref_query($form, $dbh, $query, conv_i($form->{delivery_customer_id}));
54e4131e Moritz Bunkus
map { $form->{"dc_$_"} = $ref->{$_} } keys %$ref;
}

if ($form->{delivery_vendor_id}) {
532b0d4c Moritz Bunkus
$query =
qq|SELECT *, notes as customernotes
FROM customer
WHERE id = ?
LIMIT 1|;
$ref = selectfirst_hashref_query($form, $dbh, $query, conv_i($form->{delivery_vendor_id}));
54e4131e Moritz Bunkus
map { $form->{"dv_$_"} = $ref->{$_} } keys %$ref;
}
8688e71e Moritz Bunkus
my $custom_variables = CVar->get_custom_variables('dbh' => $dbh,
'module' => 'CT',
'trans_id' => $form->{customer_id});
map { $form->{"vc_cvar_$_->{name}"} = $_->{value} } @{ $custom_variables };

98056ff9 Moritz Bunkus
if ($form->{cp_id}) {
$custom_variables = CVar->get_custom_variables(dbh => $dbh,
module => 'Contacts',
trans_id => $form->{cp_id});
$form->{"cp_cvar_$_->{name}"} = $_->{value} for @{ $custom_variables };
}

e09347c8 Geoffrey Richardson
$form->{cp_greeting} = GenericTranslations->get('dbh' => $dbh,
'translation_type' => 'greetings::' . ($form->{cp_gender} eq 'f' ? 'female' : 'male'),
'language_id' => $language_id,
'allow_fallback' => 1);


d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub post_invoice {
1de19311 Moritz Bunkus
my ($self, $myconfig, $form, $provided_dbh, %params) = @_;
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();
0bb0eb67 Stephan Köhler
1de19311 Moritz Bunkus
my $rc = SL::DB->client->with_transaction(\&_post_invoice, $self, $myconfig, $form, $provided_dbh, %params);
b9442827 Sven Schöling
$::lxdebug->leave_sub;
return $rc;
}

sub _post_invoice {
1de19311 Moritz Bunkus
my ($self, $myconfig, $form, $provided_dbh, %params) = @_;
d319704a Moritz Bunkus
7e4a1765 Bernd Bleßmann
my $validity_token;
if (!$form->{id}) {
$validity_token = SL::DB::Manager::ValidityToken->fetch_valid_token(
scope => SL::DB::ValidityToken::SCOPE_SALES_INVOICE_POST(),
token => $form->{form_validity_token},
);

die $::locale->text('The form is not valid anymore.') if !$validity_token;
}

1de19311 Moritz Bunkus
my $payments_only = $params{payments_only};
b9442827 Sven Schöling
my $dbh = $provided_dbh || SL::DB->client->dbh;
5f6d6d4e Moritz Bunkus
my $restricter = SL::HTML::Restrict->create;
d319704a Moritz Bunkus
5fdc44cb Moritz Bunkus
my ($query, $sth, $null, $project_id, @values);
d319704a Moritz Bunkus
my $exchangerate = 0;

98452aaa Moritz Bunkus
my $ic_cvar_configs = CVar->get_configs(module => 'IC',
dbh => $dbh);

820545bc Moritz Bunkus
if (!$form->{employee_id}) {
d319704a Moritz Bunkus
$form->get_employee($dbh);
}
8fa48153 Sven Schöling
fb37acdc Moritz Bunkus
$form->{defaultcurrency} = $form->get_default_currency($myconfig);
d331a3d7 Niclas Zimmermann
my $defaultcurrency = $form->{defaultcurrency};

532b0d4c Moritz Bunkus
my $all_units = AM->retrieve_units($myconfig, $form);
54e4131e Moritz Bunkus
242119d5 Bernd Bleßmann
my $already_booked = !!$form->{id};

5fdc44cb Moritz Bunkus
if (!$payments_only) {
0560b39e Bernd Bleßmann
if ($form->{storno}) {
_delete_transfers($dbh, $form, $form->{storno_id});
}
5fdc44cb Moritz Bunkus
if ($form->{id}) {
&reverse_invoice($dbh, $form);
0560b39e Bernd Bleßmann
_delete_transfers($dbh, $form, $form->{id});
1c084510 Moritz Bunkus
5fdc44cb Moritz Bunkus
} else {
6dcf04cf Moritz Bunkus
my $trans_number = SL::TransNumber->new(type => $form->{type}, dbh => $dbh, number => $form->{invnumber}, save => 1);
$form->{invnumber} = $trans_number->create_unique unless $trans_number->is_unique;

5fdc44cb Moritz Bunkus
$query = qq|SELECT nextval('glid')|;
($form->{"id"}) = selectrow_query($form, $dbh, $query);
d319704a Moritz Bunkus
ea14cfa5 Moritz Bunkus
$query = qq|INSERT INTO ar (id, invnumber, currency_id, taxzone_id) VALUES (?, ?, (SELECT id FROM currencies WHERE name=?), ?)|;
do_query($form, $dbh, $query, $form->{"id"}, $form->{"id"}, $form->{currency}, $form->{taxzone_id});
7712480e Moritz Bunkus
5fdc44cb Moritz Bunkus
if (!$form->{invnumber}) {
99724025 Moritz Bunkus
my $trans_number = SL::TransNumber->new(type => $form->{type}, dbh => $dbh, number => $form->{invnumber}, id => $form->{id});
$form->{invnumber} = $trans_number->create_unique;
5fdc44cb Moritz Bunkus
}
7712480e Moritz Bunkus
}
d319704a Moritz Bunkus
}

my ($netamount, $invoicediff) = (0, 0);
my ($amount, $linetotal, $lastincomeaccno);

5fdc44cb Moritz Bunkus
if ($form->{currency} eq $defaultcurrency) {
d319704a Moritz Bunkus
$form->{exchangerate} = 1;
} else {
3dee6f25 Jan Büren
$exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{invdate}, 'buy');
$form->{exchangerate} = $form->parse_amount($myconfig, $form->{exchangerate}, 5);

# if default exchangerate is not defined, define one
unless ($exchangerate) {
$form->update_exchangerate($dbh, $form->{currency}, $form->{invdate}, $form->{exchangerate}, 0);
# delete records exchangerate -> if user sets new invdate for record
$query = qq|UPDATE ar set exchangerate = NULL where id = ?|;
do_query($form, $dbh, $query, $form->{"id"});
}
# update record exchangerate, if the default is set and differs from current
if ($exchangerate && ($form->{exchangerate} != $exchangerate)) {
$form->update_exchangerate($dbh, $form->{currency}, $form->{invdate},
$form->{exchangerate}, 0, $form->{id}, 'ar');
}
d319704a Moritz Bunkus
}

$form->{expense_inventory} = "";

532b0d4c Moritz Bunkus
my %baseunits;

1e251313 Moritz Bunkus
$form->get_lists('price_factors' => 'ALL_PRICE_FACTORS');
my %price_factors = map { $_->{id} => $_->{factor} } @{ $form->{ALL_PRICE_FACTORS} };
my $price_factor;

6078d376 Moritz Bunkus
$form->{amount} = {};
3b1eaa1a Moritz Bunkus
$form->{amount_cogs} = {};

f087c373 Jan Büren
my @processed_invoice_ids;

d319704a Moritz Bunkus
foreach my $i (1 .. $form->{rowcount}) {
54e4131e Moritz Bunkus
if ($form->{type} eq "credit_note") {
$form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}) * -1;
532b0d4c Moritz Bunkus
$form->{shipped} = 1;
54e4131e Moritz Bunkus
} else {
$form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
}
my $basefactor;
b8da8785 Sven Schöling
my $baseqty;
54e4131e Moritz Bunkus
4d8a6515 Philip Reetz
$form->{"marge_percent_$i"} = $form->parse_amount($myconfig, $form->{"marge_percent_$i"}) * 1;
da804bf2 Geoffrey Richardson
$form->{"marge_absolut_$i"} = $form->parse_amount($myconfig, $form->{"marge_absolut_$i"}) * 1;
$form->{"lastcost_$i"} = $form->parse_amount($myconfig, $form->{"lastcost_$i"}) * 1;
4d8a6515 Philip Reetz
54e4131e Moritz Bunkus
if ($form->{storno}) {
$form->{"qty_$i"} *= -1;
}
d319704a Moritz Bunkus
8c89bb02 Moritz Bunkus
if ($form->{"id_$i"}) {
532b0d4c Moritz Bunkus
my $item_unit;
93dc3778 Bernd Bleßmann
my $position = $i;
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
if (defined($baseunits{$form->{"id_$i"}})) {
$item_unit = $baseunits{$form->{"id_$i"}};
54e4131e Moritz Bunkus
} else {
532b0d4c Moritz Bunkus
# get item baseunit
$query = qq|SELECT unit FROM parts WHERE id = ?|;
($item_unit) = selectrow_query($form, $dbh, $query, conv_i($form->{"id_$i"}));
$baseunits{$form->{"id_$i"}} = $item_unit;
54e4131e Moritz Bunkus
}

532b0d4c Moritz Bunkus
if (defined($all_units->{$item_unit}->{factor})
&& ($all_units->{$item_unit}->{factor} ne '')
&& ($all_units->{$item_unit}->{factor} != 0)) {
$basefactor = $all_units->{$form->{"unit_$i"}}->{factor} / $all_units->{$item_unit}->{factor};
} else {
$basefactor = 1;
}
$baseqty = $form->{"qty_$i"} * $basefactor;
d319704a Moritz Bunkus
my ($allocated, $taxrate) = (0, 0);
my $taxamount;

d9c9bc22 Moritz Bunkus
# add tax rates
map { $taxrate += $form->{"${_}_rate"} } split(/ /, $form->{"taxaccounts_$i"});

d319704a Moritz Bunkus
# keep entered selling price
my $fxsellprice =
$form->parse_amount($myconfig, $form->{"sellprice_$i"});

my ($dec) = ($fxsellprice =~ /\.(\d+)/);
$dec = length $dec;
my $decimalplaces = ($dec > 2) ? $dec : 2;

d9c9bc22 Moritz Bunkus
# undo discount formatting
$form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100;
d319704a Moritz Bunkus
d9c9bc22 Moritz Bunkus
# deduct discount
$form->{"sellprice_$i"} = $fxsellprice * (1 - $form->{"discount_$i"});
d319704a Moritz Bunkus
# round linetotal to 2 decimal places
1e251313 Moritz Bunkus
$price_factor = $price_factors{ $form->{"price_factor_id_$i"} } || 1;
$linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"} / $price_factor, 2);
d319704a Moritz Bunkus
if ($form->{taxincluded}) {
$taxamount = $linetotal * ($taxrate / (1 + $taxrate));
$form->{"sellprice_$i"} =
$form->{"sellprice_$i"} * (1 / (1 + $taxrate));
} else {
$taxamount = $linetotal * $taxrate;
}

$netamount += $linetotal;

if ($taxamount != 0) {
map {
$form->{amount}{ $form->{id} }{$_} +=
$taxamount * $form->{"${_}_rate"} / $taxrate
532b0d4c Moritz Bunkus
} split(/ /, $form->{"taxaccounts_$i"});
d319704a Moritz Bunkus
}

# add amount to income, $form->{amount}{trans_id}{accno}
1e251313 Moritz Bunkus
$amount = $form->{"sellprice_$i"} * $form->{"qty_$i"} * $form->{exchangerate} / $price_factor;
d319704a Moritz Bunkus
1e251313 Moritz Bunkus
$linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"} / $price_factor, 2) * $form->{exchangerate};
d319704a Moritz Bunkus
$linetotal = $form->round_amount($linetotal, 2);

# this is the difference from the inventory
$invoicediff += ($amount - $linetotal);

$form->{amount}{ $form->{id} }{ $form->{"income_accno_$i"} } +=
$linetotal;

$lastincomeaccno = $form->{"income_accno_$i"};

# adjust and round sellprice
$form->{"sellprice_$i"} =
$form->round_amount($form->{"sellprice_$i"} * $form->{exchangerate},
$decimalplaces);

5fdc44cb Moritz Bunkus
next if $payments_only;

2624618d Jan Büren

# do cogs only if inventory_sytem perpetual is active
if ($::instance_conf->get_inventory_system eq 'perpetual'
&& $form->{"inventory_accno_$i"} || $form->{"part_type_$i"} eq 'assembly') {
d319704a Moritz Bunkus
5bc5af9f Geoffrey Richardson
if ($form->{"part_type_$i"} eq 'assembly') {
d319704a Moritz Bunkus
# record assembly item as allocated
93dc3778 Bernd Bleßmann
&process_assembly($dbh, $myconfig, $form, $position, $form->{"id_$i"}, $baseqty);
bb439145 Moritz Bunkus
d319704a Moritz Bunkus
} else {
306fad80 Geoffrey Richardson
$allocated = &cogs($dbh, $myconfig, $form, $form->{"id_$i"}, $baseqty, $basefactor, $i);
d319704a Moritz Bunkus
}
}

b632cee8 Moritz Bunkus
# Get pricegroup_id and save it. Unfortunately the interface
# also uses ID "0" for signalling that none is selected, but "0"
# must not be stored in the database. Therefore we cannot simply
# use conv_i().
532b0d4c Moritz Bunkus
($null, my $pricegroup_id) = split(/--/, $form->{"sellprice_pg_$i"});
07d71c33 Stephan Köhler
$pricegroup_id *= 1;
b632cee8 Moritz Bunkus
$pricegroup_id = undef if !$pricegroup_id;
07d71c33 Stephan Köhler
be42a450 Bernd Bleßmann
CVar->get_non_editable_ic_cvars(form => $form,
dbh => $dbh,
97ac8565 Jan Büren
row => $i,
be42a450 Bernd Bleßmann
sub_module => 'invoice',
may_converted_from => ['delivery_order_items', 'orderitems', 'invoice']);

f087c373 Jan Büren
if (!$form->{"invoice_id_$i"}) {
# there is no persistent id, therefore create one with all necessary constraints
my $q_invoice_id = qq|SELECT nextval('invoiceid')|;
my $h_invoice_id = prepare_query($form, $dbh, $q_invoice_id);
do_statement($form, $h_invoice_id, $q_invoice_id);
$form->{"invoice_id_$i"} = $h_invoice_id->fetchrow_array();
93dc3778 Bernd Bleßmann
my $q_create_invoice_id = qq|INSERT INTO invoice (id, trans_id, position, parts_id) values (?, ?, ?, ?)|;
do_query($form, $dbh, $q_create_invoice_id, conv_i($form->{"invoice_id_$i"}),
conv_i($form->{id}), conv_i($position), conv_i($form->{"id_$i"}));
f087c373 Jan Büren
$h_invoice_id->finish();
}
98452aaa Moritz Bunkus
d319704a Moritz Bunkus
# save detail record in invoice table
f087c373 Jan Büren
$query = <<SQL;
93dc3778 Bernd Bleßmann
UPDATE invoice SET trans_id = ?, position = ?, parts_id = ?, description = ?, longdescription = ?, qty = ?,
f087c373 Jan Büren
sellprice = ?, fxsellprice = ?, discount = ?, allocated = ?, assemblyitem = ?,
unit = ?, deliverydate = ?, project_id = ?, serialnumber = ?, pricegroup_id = ?,
c1ec3f4f Geoffrey Richardson
base_qty = ?, subtotal = ?,
f087c373 Jan Büren
marge_percent = ?, marge_total = ?, lastcost = ?, active_price_source = ?, active_discount_source = ?,
price_factor_id = ?, price_factor = (SELECT factor FROM price_factors WHERE id = ?), marge_price_factor = ?
WHERE id = ?
SQL

93dc3778 Bernd Bleßmann
@values = (conv_i($form->{id}), conv_i($position), conv_i($form->{"id_$i"}),
5f6d6d4e Moritz Bunkus
$form->{"description_$i"}, $restricter->process($form->{"longdescription_$i"}), $form->{"qty_$i"},
532b0d4c Moritz Bunkus
$form->{"sellprice_$i"}, $fxsellprice,
$form->{"discount_$i"}, $allocated, 'f',
ca57b730 Philip Reetz
$form->{"unit_$i"}, conv_date($form->{"reqdate_$i"}), conv_i($form->{"project_id_$i"}),
f2463a51 Tamino Steinert
trim($form->{"serialnumber_$i"}), $pricegroup_id,
c1ec3f4f Geoffrey Richardson
$baseqty, $form->{"subtotal_$i"} ? 't' : 'f',
9c7c96a8 Sven Schöling
$form->{"marge_percent_$i"}, $form->{"marge_absolut_$i"},
1e251313 Moritz Bunkus
$form->{"lastcost_$i"},
89b26688 Sven Schöling
$form->{"active_price_source_$i"}, $form->{"active_discount_source_$i"},
1e251313 Moritz Bunkus
conv_i($form->{"price_factor_id_$i"}), conv_i($form->{"price_factor_id_$i"}),
f087c373 Jan Büren
conv_i($form->{"marge_price_factor_$i"}),
conv_i($form->{"invoice_id_$i"}));
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
f087c373 Jan Büren
push @processed_invoice_ids, $form->{"invoice_id_$i"};
532b0d4c Moritz Bunkus
98452aaa Moritz Bunkus
CVar->save_custom_variables(module => 'IC',
sub_module => 'invoice',
f087c373 Jan Büren
trans_id => $form->{"invoice_id_$i"},
98452aaa Moritz Bunkus
configs => $ic_cvar_configs,
variables => $form,
name_prefix => 'ic_',
name_postfix => "_$i",
dbh => $dbh);
d319704a Moritz Bunkus
}
991d16bb Jan Büren
# link previous items with invoice items
748ce36f Tamino Steinert
foreach (qw(delivery_order_items orderitems invoice reclamation_items)) {
b8125c17 Bernd Bleßmann
if (!$form->{useasnew} && $form->{"converted_from_${_}_id_$i"}) {
991d16bb Jan Büren
RecordLinks->create_links('dbh' => $dbh,
'mode' => 'ids',
'from_table' => $_,
'from_ids' => $form->{"converted_from_${_}_id_$i"},
'to_table' => 'invoice',
'to_id' => $form->{"invoice_id_$i"},
);
}
b8125c17 Bernd Bleßmann
delete $form->{"converted_from_${_}_id_$i"};
f0ad2143 Jan Büren
}
d319704a Moritz Bunkus
}

# total payments, don't move we need it here
for my $i (1 .. $form->{paidaccounts}) {
54e4131e Moritz Bunkus
if ($form->{type} eq "credit_note") {
$form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}) * -1;
} else {
$form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"});
}
d319704a Moritz Bunkus
$form->{paid} += $form->{"paid_$i"};
$form->{datepaid} = $form->{"datepaid_$i"} if ($form->{"datepaid_$i"});
}

my ($tax, $diff) = (0, 0);

$netamount = $form->round_amount($netamount, 2);

# figure out rounding errors for total amount vs netamount + taxes
if ($form->{taxincluded}) {

$amount = $form->round_amount($netamount * $form->{exchangerate}, 2);
$diff += $amount - $netamount * $form->{exchangerate};
$netamount = $amount;

532b0d4c Moritz Bunkus
foreach my $item (split(/ /, $form->{taxaccounts})) {
d319704a Moritz Bunkus
$amount = $form->{amount}{ $form->{id} }{$item} * $form->{exchangerate};
$form->{amount}{ $form->{id} }{$item} = $form->round_amount($amount, 2);
$tax += $form->{amount}{ $form->{id} }{$item};
$netamount -= $form->{amount}{ $form->{id} }{$item};
}

$invoicediff += $diff;
######## this only applies to tax included
if ($lastincomeaccno) {
$form->{amount}{ $form->{id} }{$lastincomeaccno} += $invoicediff;
}

} else {
$amount = $form->round_amount($netamount * $form->{exchangerate}, 2);
$diff = $amount - $netamount * $form->{exchangerate};
$netamount = $amount;
532b0d4c Moritz Bunkus
foreach my $item (split(/ /, $form->{taxaccounts})) {
d319704a Moritz Bunkus
$form->{amount}{ $form->{id} }{$item} =
$form->round_amount($form->{amount}{ $form->{id} }{$item}, 2);
$amount =
$form->round_amount(
$form->{amount}{ $form->{id} }{$item} * $form->{exchangerate},
2);
$diff +=
$amount - $form->{amount}{ $form->{id} }{$item} *
$form->{exchangerate};
$form->{amount}{ $form->{id} }{$item} = $form->round_amount($amount, 2);
$tax += $form->{amount}{ $form->{id} }{$item};
}
}

030c2086 Rolf Fluehmann
# Invoice Summary includes Rounding
my $grossamount = $netamount + $tax;
my $rounding = $form->round_amount(
$form->round_amount($grossamount, 2, 1) - $form->round_amount($grossamount, 2),
2
);
my $rnd_accno = $rounding == 0 ? 0
: $rounding > 0 ? $form->{rndgain_accno}
: $form->{rndloss_accno}
;
$form->{amount}{ $form->{id} }{ $form->{AR} } = $form->round_amount($grossamount, 2, 1);
$form->{paid} = $form->round_amount(
$form->{paid} * $form->{exchangerate} + $diff,
2
);
d319704a Moritz Bunkus
# reverse AR
$form->{amount}{ $form->{id} }{ $form->{AR} } *= -1;

d4651135 Moritz Bunkus
$project_id = conv_i($form->{"globalproject_id"});
2f6e7625 Jan Büren
# entsprechend auch beim Bestimmen des Steuerschlüssels in Taxkey.pm berücksichtigen
0b36b225 Moritz Bunkus
my $taxdate = $form->{tax_point} ||$form->{deliverydate} || $form->{invdate};
03ff37cb Niclas Zimmermann
b73ca44e Bernd Bleßmann
# Sanity checks for invoices for advance payment and final invoices
my $advance_payment_clearing_chart;
if (any { $_ eq $form->{type} } qw(invoice_for_advance_payment final_invoice)) {
$advance_payment_clearing_chart = SL::DB::Chart->new(id => $::instance_conf->get_advance_payment_clearing_chart_id)->load;
die "No Clearing Chart for Advance Payment" unless ref $advance_payment_clearing_chart eq 'SL::DB::Chart';

my @current_taxaccounts = (split(/ /, $form->{taxaccounts}));
die 'Wrong call: Cannot post invoice for advance payment or final invoice with more than one tax' if (scalar @current_taxaccounts > 1);

my @trans_ids = keys %{ $form->{amount} };
if (scalar @trans_ids > 1) {
require Data::Dumper;
die "Invalid state for advance payment more than one trans_id " . Dumper($form->{amount});
}
}

688a2aef Bernd Bleßmann
my $iap_amounts;
93de7a97 Bernd Bleßmann
if ($form->{type} eq 'final_invoice') {
72e545d6 Bernd Bleßmann
my $id_for_iap = $form->{convert_from_oe_ids} || $form->{convert_from_ar_ids} || $form->{id};
my $from_order = !!$form->{convert_from_oe_ids};
my $invoices_for_advance_payment = $self->_get_invoices_for_advance_payment($id_for_iap, $from_order);
59f6b67c Jan Büren
if (scalar @$invoices_for_advance_payment > 0) {
# reverse booking for invoices for advance payment
foreach my $invoice_for_advance_payment (@$invoices_for_advance_payment) {
7b5fd5ed Bernd Bleßmann
# delete ?
# --> is implemented below (bookings are marked in memo field)
#
59f6b67c Jan Büren
# TODO: helper table acc_trans_advance_payment
# trans_id for final invoice connects to acc_trans_id here
# my $booking = SL::DB::AccTrans->new( ...)
7b5fd5ed Bernd Bleßmann
# --> helper table not nessessary because of mark in memo field
#
59f6b67c Jan Büren
# TODO: If final_invoice change (delete storno) delete all connectin acc_trans entries, if
# period is not closed
7b5fd5ed Bernd Bleßmann
# --> no problem because gldate of reverse booking is date of final invoice
# if deletion of final invoice is allowed, reverting bookings in invoices
# for advance payment are allowed, too.
59f6b67c Jan Büren
# $booking->id, $self->id in helper table
93de7a97 Bernd Bleßmann
if (!$already_booked) {
e7c0d9ce Jan Büren
# move all netamount to correct transfer chart (19% or 7%)
my %inv_calc = $invoice_for_advance_payment->calculate_prices_and_taxes();
my @trans_ids = keys %{ $inv_calc{amounts} };
die "Invalid state for advance payment invoice,more than one trans_id" if (scalar @trans_ids > 1);
my $entry = delete $inv_calc{amounts}{$trans_ids[0]};
my $tax;
if ($entry->{tax_id}) {
$tax = SL::DB::Manager::Tax->find_by(id => $entry->{tax_id}); # || die "Can't find tax with id " . $entry->{tax_id};
}
# no tax, no prob
if ($tax and $tax->rate != 0) {
my $transfer_chart = $tax->taxkey == 2 ? SL::DB::Chart->new(id => $::instance_conf->get_advance_payment_taxable_7_id)->load
: $tax->taxkey == 3 ? SL::DB::Chart->new(id => $::instance_conf->get_advance_payment_taxable_19_id)->load
: undef;
die "No Transfer Chart for Advance Payment" unless ref $transfer_chart eq 'SL::DB::Chart';
$form->{amount}->{$invoice_for_advance_payment->id}->{$transfer_chart->accno} = -1 * $invoice_for_advance_payment->netamount;
$form->{memo} ->{$invoice_for_advance_payment->id}->{$transfer_chart->accno} = 'reverse booking by final invoice';
# AR
$form->{amount}->{$invoice_for_advance_payment->id}->{$form->{AR}} = $invoice_for_advance_payment->netamount;
$form->{memo} ->{$invoice_for_advance_payment->id}->{$form->{AR}} = 'reverse booking by final invoice';
}
93de7a97 Bernd Bleßmann
}

# VAT for invoices for advance payment is booked on payment of these. So do not book this VAT for final invoice.
688a2aef Bernd Bleßmann
# And book the amount of the invoices for advance payment with taxkey 0 (see below).
# Collect amounts and VAT of invoices for advance payment.

93de7a97 Bernd Bleßmann
# Set sellprices to fxsellprices for items, because
# the PriceTaxCalculator sets fxsellprice from sellprice before calculating.
$_->sellprice($_->fxsellprice) for @{$invoice_for_advance_payment->items};
my %pat = $invoice_for_advance_payment->calculate_prices_and_taxes;

foreach my $tax_chart_id (keys %{ $pat{taxes_by_chart_id} }) {
688a2aef Bernd Bleßmann
my $tax_accno = SL::DB::Chart->load_cached($tax_chart_id)->accno;
$form->{amount}{ $form->{id} }{$tax_accno} -= $pat{taxes_by_chart_id}->{$tax_chart_id};
$form->{amount}{ $form->{id} }{$form->{AR}} += $pat{taxes_by_chart_id}->{$tax_chart_id};
}

foreach my $amount_chart_id (keys %{ $pat{amounts} }) {
my $amount_accno = SL::DB::Chart->load_cached($amount_chart_id)->accno;
$iap_amounts->{$amount_accno} += $pat{amounts}->{$amount_chart_id}->{amount};
$form->{amount}{ $form->{id} }{$amount_accno} -= $pat{amounts}->{$amount_chart_id}->{amount};
93de7a97 Bernd Bleßmann
}
59f6b67c Jan Büren
}
}
}

b73ca44e Bernd Bleßmann
if ($form->{type} eq 'invoice_for_advance_payment') {
59f6b67c Jan Büren
# get gross and move to clearing chart - delete everything else
# 1. gross
b73ca44e Bernd Bleßmann
my $gross = $form->{amount}{ $form->{id} }{$form->{AR}};
59f6b67c Jan Büren
# 2. destroy
b73ca44e Bernd Bleßmann
undef $form->{amount}{ $form->{id} };
59f6b67c Jan Büren
# 3. rebuild
b73ca44e Bernd Bleßmann
$form->{amount}{ $form->{id} }{$form->{AR}} = $gross;
$form->{amount}{ $form->{id} }{$advance_payment_clearing_chart->accno} = $gross * -1;
59f6b67c Jan Büren
# 4. no cogs, hopefully not commonly used at all
undef $form->{amount_cogs};
58186225 Bernd Bleßmann
}

3b1eaa1a Moritz Bunkus
foreach my $trans_id (keys %{ $form->{amount_cogs} }) {
foreach my $accno (keys %{ $form->{amount_cogs}{$trans_id} }) {
next unless ($form->{expense_inventory} =~ /\Q$accno\E/);

$form->{amount_cogs}{$trans_id}{$accno} = $form->round_amount($form->{amount_cogs}{$trans_id}{$accno}, 2);

if (!$payments_only && ($form->{amount_cogs}{$trans_id}{$accno} != 0)) {
$query =
d1408ca1 Niclas Zimmermann
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, chart_link)
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, (SELECT id FROM tax WHERE taxkey=0), 0, ?, (SELECT link FROM chart WHERE accno = ?))|;
@values = (conv_i($trans_id), $accno, $form->{amount_cogs}{$trans_id}{$accno}, conv_date($form->{invdate}), conv_i($project_id), $accno);
3b1eaa1a Moritz Bunkus
do_query($form, $dbh, $query, @values);
$form->{amount_cogs}{$trans_id}{$accno} = 0;
}
}

foreach my $accno (keys %{ $form->{amount_cogs}{$trans_id} }) {
$form->{amount_cogs}{$trans_id}{$accno} = $form->round_amount($form->{amount_cogs}{$trans_id}{$accno}, 2);

if (!$payments_only && ($form->{amount_cogs}{$trans_id}{$accno} != 0)) {
$query =
d1408ca1 Niclas Zimmermann
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, chart_link)
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, (SELECT id FROM tax WHERE taxkey=0), 0, ?, (SELECT link FROM chart WHERE accno = ?))|;
@values = (conv_i($trans_id), $accno, $form->{amount_cogs}{$trans_id}{$accno}, conv_date($form->{invdate}), conv_i($project_id), $accno);
3b1eaa1a Moritz Bunkus
do_query($form, $dbh, $query, @values);
}
}
}

d319704a Moritz Bunkus
foreach my $trans_id (keys %{ $form->{amount} }) {
foreach my $accno (keys %{ $form->{amount}{$trans_id} }) {
5cf977e5 Moritz Bunkus
next unless ($form->{expense_inventory} =~ /\Q$accno\E/);
5fdc44cb Moritz Bunkus
$form->{amount}{$trans_id}{$accno} = $form->round_amount($form->{amount}{$trans_id}{$accno}, 2);

if (!$payments_only && ($form->{amount}{$trans_id}{$accno} != 0)) {
532b0d4c Moritz Bunkus
$query =
700cdcc0 Bernd Bleßmann
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, chart_link, memo)
532b0d4c Moritz Bunkus
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?,
9f07753b Moritz Bunkus
(SELECT tax_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
2a4516c1 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
dceb9f20 Niclas Zimmermann
(SELECT taxkey_id
9f07753b Moritz Bunkus
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
dceb9f20 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
?,
700cdcc0 Bernd Bleßmann
(SELECT link FROM chart WHERE accno = ?),
?)|;
@values = (conv_i($trans_id), $accno, $form->{amount}{$trans_id}{$accno}, conv_date($form->{invdate}), $accno, conv_date($taxdate), $accno, conv_date($taxdate), conv_i($project_id), $accno, $form->{memo}{$trans_id}{$accno});
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
$form->{amount}{$trans_id}{$accno} = 0;
}
}

foreach my $accno (keys %{ $form->{amount}{$trans_id} }) {
5fdc44cb Moritz Bunkus
$form->{amount}{$trans_id}{$accno} = $form->round_amount($form->{amount}{$trans_id}{$accno}, 2);

if (!$payments_only && ($form->{amount}{$trans_id}{$accno} != 0)) {
532b0d4c Moritz Bunkus
$query =
700cdcc0 Bernd Bleßmann
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, chart_link, memo)
532b0d4c Moritz Bunkus
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?,
9f07753b Moritz Bunkus
(SELECT tax_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
2a4516c1 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
9f07753b Moritz Bunkus
(SELECT taxkey_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
dceb9f20 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
?,
700cdcc0 Bernd Bleßmann
(SELECT link FROM chart WHERE accno = ?),
?)|;
@values = (conv_i($trans_id), $accno, $form->{amount}{$trans_id}{$accno}, conv_date($form->{invdate}), $accno, conv_date($taxdate), $accno, conv_date($taxdate), conv_i($project_id), $accno,$form->{memo}{$trans_id}{$accno});
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
}
}
030c2086 Rolf Fluehmann
if (!$payments_only && ($rnd_accno != 0)) {
$query =
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, chart_link)
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, (SELECT id FROM tax WHERE taxkey=0), 0, ?, (SELECT link FROM chart WHERE accno = ?))|;
@values = (conv_i($trans_id), $rnd_accno, $rounding, conv_date($form->{invdate}), conv_i($project_id), $rnd_accno);
do_query($form, $dbh, $query, @values);
$rnd_accno = 0;
}
d319704a Moritz Bunkus
}

688a2aef Bernd Bleßmann
# Book the amount of the invoices for advance payment with taxkey 0 (see below).
if ($form->{type} eq 'final_invoice' && $iap_amounts) {
foreach my $accno (keys %$iap_amounts) {
$query =
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, chart_link)
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, (SELECT id FROM tax WHERE taxkey=0), 0, ?, (SELECT link FROM chart WHERE accno = ?))|;
@values = (conv_i($form->{id}), $accno, $iap_amounts->{$accno}, conv_date($form->{invdate}), conv_i($project_id), $accno);
do_query($form, $dbh, $query, @values);
}
}

d319704a Moritz Bunkus
# deduct payment differences from diff
for my $i (1 .. $form->{paidaccounts}) {
if ($form->{"paid_$i"} != 0) {
$amount =
$form->round_amount($form->{"paid_$i"} * $form->{exchangerate}, 2);
$diff -= $amount - $form->{"paid_$i"} * $form->{exchangerate};
}
}

1de19311 Moritz Bunkus
my %already_cleared = %{ $params{already_cleared} // {} };

d319704a Moritz Bunkus
# record payments and offsetting AR
54e4131e Moritz Bunkus
if (!$form->{storno}) {
for my $i (1 .. $form->{paidaccounts}) {
d729e328 Sven Schöling
f45b296f Bernd Bleßmann
if ($form->{"acc_trans_id_$i"}
&& $payments_only
97954312 Bernd Bleßmann
&& (SL::DB::Default->get->payments_changeable == 0)) {
f45b296f Bernd Bleßmann
next;
}
532b0d4c Moritz Bunkus
next if ($form->{"paid_$i"} == 0);

my ($accno) = split(/--/, $form->{"AR_paid_$i"});
$form->{"datepaid_$i"} = $form->{invdate}
unless ($form->{"datepaid_$i"});
$form->{datepaid} = $form->{"datepaid_$i"};

$exchangerate = 0;

5fdc44cb Moritz Bunkus
if ($form->{currency} eq $defaultcurrency) {
532b0d4c Moritz Bunkus
$form->{"exchangerate_$i"} = 1;
} else {
a53233e5 Sven Schöling
$exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{"datepaid_$i"}, 'buy');
$form->{"exchangerate_$i"} = $exchangerate || $form->parse_amount($myconfig, $form->{"exchangerate_$i"});
532b0d4c Moritz Bunkus
}

# record AR
$amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} + $diff, 2);

1de19311 Moritz Bunkus
my $new_cleared = !$form->{"acc_trans_id_$i"} ? 'f'
: !$already_cleared{$form->{"acc_trans_id_$i"}} ? 'f'
: $already_cleared{$form->{"acc_trans_id_$i"}}->{amount} != $form->{"paid_$i"} * -1 ? 'f'
: $already_cleared{$form->{"acc_trans_id_$i"}}->{accno} != $accno ? 'f'
: $already_cleared{$form->{"acc_trans_id_$i"}}->{cleared} ? 't'
: 'f';

532b0d4c Moritz Bunkus
if ($form->{amount}{ $form->{id} }{ $form->{AR} } != 0) {
$query =
1de19311 Moritz Bunkus
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, tax_id, taxkey, project_id, cleared, chart_link)
532b0d4c Moritz Bunkus
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?,
9f07753b Moritz Bunkus
(SELECT tax_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
2a4516c1 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
9f07753b Moritz Bunkus
(SELECT taxkey_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
dceb9f20 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
1de19311 Moritz Bunkus
?, ?,
d1408ca1 Niclas Zimmermann
(SELECT link FROM chart WHERE accno = ?))|;
1de19311 Moritz Bunkus
@values = (conv_i($form->{"id"}), $form->{AR}, $amount, $form->{"datepaid_$i"}, $form->{AR}, conv_date($taxdate), $form->{AR}, conv_date($taxdate), $project_id, $new_cleared, $form->{AR});
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
}

# record payment
$form->{"paid_$i"} *= -1;
f45b296f Bernd Bleßmann
my $gldate = (conv_date($form->{"gldate_$i"}))? conv_date($form->{"gldate_$i"}) : conv_date($form->current_date($myconfig));
532b0d4c Moritz Bunkus
$query =
1de19311 Moritz Bunkus
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, gldate, source, memo, tax_id, taxkey, project_id, cleared, chart_link)
f45b296f Bernd Bleßmann
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, ?, ?, ?,
9f07753b Moritz Bunkus
(SELECT tax_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
2a4516c1 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
9f07753b Moritz Bunkus
(SELECT taxkey_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
dceb9f20 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
1de19311 Moritz Bunkus
?, ?,
d1408ca1 Niclas Zimmermann
(SELECT link FROM chart WHERE accno = ?))|;
532b0d4c Moritz Bunkus
@values = (conv_i($form->{"id"}), $accno, $form->{"paid_$i"}, $form->{"datepaid_$i"},
1de19311 Moritz Bunkus
$gldate, $form->{"source_$i"}, $form->{"memo_$i"}, $accno, conv_date($taxdate), $accno, conv_date($taxdate), $project_id, $new_cleared, $accno);
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);

# exchangerate difference
$form->{fx}{$accno}{ $form->{"datepaid_$i"} } +=
3ff5da55 Niclas Zimmermann
$form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1) + $diff;
532b0d4c Moritz Bunkus
# gain/loss
$amount =
3ff5da55 Niclas Zimmermann
$form->{"paid_$i"} * $form->{exchangerate} - $form->{"paid_$i"} *
$form->{"exchangerate_$i"};
532b0d4c Moritz Bunkus
if ($amount > 0) {
3ff5da55 Niclas Zimmermann
$form->{fx}{ $form->{fxgain_accno} }{ $form->{"datepaid_$i"} } += $amount;
532b0d4c Moritz Bunkus
} else {
3ff5da55 Niclas Zimmermann
$form->{fx}{ $form->{fxloss_accno} }{ $form->{"datepaid_$i"} } += $amount;
532b0d4c Moritz Bunkus
}

$diff = 0;

b8330aee Jan Büren
# update exchange rate for PAYMENTS
# exchangerate contains a new exchangerate of the payment date
5fdc44cb Moritz Bunkus
if (($form->{currency} ne $defaultcurrency) && !$exchangerate) {
e9b48f2e Jan Büren
$form->{script} = 'is.pl';
532b0d4c Moritz Bunkus
$form->update_exchangerate($dbh, $form->{currency},
$form->{"datepaid_$i"},
$form->{"exchangerate_$i"}, 0);
d319704a Moritz Bunkus
}
}
8ca54430 Moritz Bunkus
} else { # if (!$form->{storno})
$form->{marge_total} *= -1;
d319704a Moritz Bunkus
}

40c2c37c Moritz Bunkus
IO->set_datepaid(table => 'ar', id => $form->{id}, dbh => $dbh);

d319704a Moritz Bunkus
# record exchange rate differences and gains/losses
foreach my $accno (keys %{ $form->{fx} }) {
foreach my $transdate (keys %{ $form->{fx}{$accno} }) {
3ff5da55 Niclas Zimmermann
$form->{fx}{$accno}{$transdate} = $form->round_amount($form->{fx}{$accno}{$transdate}, 2);
if ( $form->{fx}{$accno}{$transdate} != 0 ) {
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
$query =
d1408ca1 Niclas Zimmermann
qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, cleared, fx_transaction, tax_id, taxkey, project_id, chart_link)
532b0d4c Moritz Bunkus
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, '0', '1',
9f07753b Moritz Bunkus
(SELECT tax_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
2a4516c1 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
9f07753b Moritz Bunkus
(SELECT taxkey_id
FROM taxkeys
WHERE chart_id= (SELECT id
FROM chart
WHERE accno = ?)
AND startdate <= ?
dceb9f20 Niclas Zimmermann
ORDER BY startdate DESC LIMIT 1),
?,
d1408ca1 Niclas Zimmermann
(SELECT link FROM chart WHERE accno = ?))|;
dceb9f20 Niclas Zimmermann
@values = (conv_i($form->{"id"}), $accno, $form->{fx}{$accno}{$transdate}, conv_date($transdate), $accno, conv_date($taxdate), $accno, conv_date($taxdate), conv_i($project_id), $accno);
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
}
}
}

3ff5da55 Niclas Zimmermann
if ($payments_only) {
$query = qq|UPDATE ar SET paid = ? WHERE id = ?|;
do_query($form, $dbh, $query, $form->{paid}, conv_i($form->{id}));

8c1d5d75 Martin Helmling
$form->new_lastmtime('ar');

3ff5da55 Niclas Zimmermann
return;
}

030c2086 Rolf Fluehmann
$amount = $form->round_amount( $netamount + $tax, 2, 1);
d319704a Moritz Bunkus
db101cc6 Cem Aydin
# qr reference
my $qr_reference;
if ($form->{has_qr_reference}) {
# (re-)generate reference number

# get qr-account data
my ($qr_account, $error) = get_qrbill_account();
die $error if !$qr_account;

# get customer object
my $customer_obj = SL::DB::Customer->load_cached(conv_i($form->{customer_id}));

# assemble reference number with check digit
($qr_reference, $error) = assemble_ref_number($qr_account->{bank_account_id},
$customer_obj->{customernumber},
$form->{invnumber});
die $error if !$qr_reference;
} else {
# if the reference number has been previously defined keep it
if (defined $form->{qr_reference}) {
$qr_reference = $form->{qr_reference};
} else {
$qr_reference = undef;
}
}
6c7b457f Bernd Bleßmann
# add invoice number to unstructured message if feature enabled in client config
47b0ef6f Cem Aydin
my $qr_unstructured_message = $form->{"qr_unstructured_message"};
if ($::instance_conf->get_qrbill_copy_invnumber && $form->{formname} eq 'invoice') {
my $invnumber = $form->{"invnumber"};
if ($qr_unstructured_message eq '') {
$qr_unstructured_message = $invnumber;
} elsif (rindex($qr_unstructured_message, $invnumber) == -1) {
$qr_unstructured_message .= '; ' . $invnumber;
}
}
db101cc6 Cem Aydin
d319704a Moritz Bunkus
# save AR record
d4bddbd1 Geoffrey Richardson
#erweiterung fuer lieferscheinnummer (donumber) 12.02.09 jb

d319704a Moritz Bunkus
$query = qq|UPDATE ar set
a05eead3 Sven Schöling
invnumber = ?, ordnumber = ?, quonumber = ?, cusordnumber = ?,
0b36b225 Moritz Bunkus
transdate = ?, orddate = ?, quodate = ?, tax_point = ?, customer_id = ?,
40c2c37c Moritz Bunkus
amount = ?, netamount = ?, paid = ?,
a05eead3 Sven Schöling
duedate = ?, deliverydate = ?, invoice = ?, shippingpoint = ?,
464f44ac Moritz Bunkus
shipvia = ?, notes = ?, intnotes = ?,
a4d74009 Niclas Zimmermann
currency_id = (SELECT id FROM currencies WHERE name = ?),
d331a3d7 Niclas Zimmermann
department_id = ?, payment_id = ?, taxincluded = ?,
844a541e Moritz Bunkus
type = ?, language_id = ?, taxzone_id = ?, shipto_id = ?, billing_address_id = ?,
a05eead3 Sven Schöling
employee_id = ?, salesman_id = ?, storno_id = ?, storno = ?,
8fa48153 Sven Schöling
cp_id = ?, marge_total = ?, marge_percent = ?,
a05eead3 Sven Schöling
globalproject_id = ?, delivery_customer_id = ?,
d4bddbd1 Geoffrey Richardson
transaction_description = ?, delivery_vendor_id = ?,
94976940 Cem Aydin
donumber = ?, invnumber_for_credit_note = ?, direct_debit = ?, qrbill_without_amount = ?,
bfeee737 Cem Aydin
qr_reference = ?, qr_unstructured_message = ?, delivery_term_id = ?
532b0d4c Moritz Bunkus
WHERE id = ?|;
a05eead3 Sven Schöling
@values = ( $form->{"invnumber"}, $form->{"ordnumber"}, $form->{"quonumber"}, $form->{"cusordnumber"},
0b36b225 Moritz Bunkus
conv_date($form->{"invdate"}), conv_date($form->{"orddate"}), conv_date($form->{"quodate"}), conv_date($form->{tax_point}), conv_i($form->{"customer_id"}),
bf042408 Sven Schöling
$amount, $netamount, $form->{"paid"},
a05eead3 Sven Schöling
conv_date($form->{"duedate"}), conv_date($form->{"deliverydate"}), '1', $form->{"shippingpoint"},
464f44ac Moritz Bunkus
$form->{"shipvia"}, $restricter->process($form->{"notes"}), $form->{"intnotes"},
a05eead3 Sven Schöling
$form->{"currency"}, conv_i($form->{"department_id"}), conv_i($form->{"payment_id"}), $form->{"taxincluded"} ? 't' : 'f',
844a541e Moritz Bunkus
$form->{"type"}, conv_i($form->{"language_id"}), conv_i($form->{"taxzone_id"}), conv_i($form->{"shipto_id"}), conv_i($form->{billing_address_id}),
8fa48153 Sven Schöling
conv_i($form->{"employee_id"}), conv_i($form->{"salesman_id"}), conv_i($form->{storno_id}), $form->{"storno"} ? 't' : 'f',
a05eead3 Sven Schöling
conv_i($form->{"cp_id"}), 1 * $form->{marge_total} , 1 * $form->{marge_percent},
8fa48153 Sven Schöling
conv_i($form->{"globalproject_id"}), conv_i($form->{"delivery_customer_id"}),
a05eead3 Sven Schöling
$form->{transaction_description}, conv_i($form->{"delivery_vendor_id"}),
94976940 Cem Aydin
$form->{"donumber"}, $form->{"invnumber_for_credit_note"}, $form->{direct_debit} ? 't' : 'f', $form->{qrbill_without_amount} ? 't' : 'f',
47b0ef6f Cem Aydin
$qr_reference, $qr_unstructured_message, conv_i($form->{delivery_term_id}),
a05eead3 Sven Schöling
conv_i($form->{"id"}));
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
8fa48153 Sven Schöling

54e4131e Moritz Bunkus
if ($form->{storno}) {
532b0d4c Moritz Bunkus
$query =
qq!UPDATE ar SET
2517d840 Waldemar Toews
paid = amount,
532b0d4c Moritz Bunkus
storno = 't',
intnotes = ? || intnotes
WHERE id = ?!;
do_query($form, $dbh, $query, "Rechnung storniert am $form->{invdate} ", conv_i($form->{"storno_id"}));
do_query($form, $dbh, qq|UPDATE ar SET paid = amount WHERE id = ?|, conv_i($form->{"id"}));
2fc46f6a Moritz Bunkus
$query = <<SQL;
UPDATE orderitems
SET recurring_billing_invoice_id = NULL
WHERE recurring_billing_invoice_id = ?
SQL

do_query($form, $dbh, $query, conv_i($form->{"storno_id"}));
54e4131e Moritz Bunkus
}

f5b13074 Jan Büren
# maybe we are in a larger transaction and the current
# object is not yet persistent in the db, therefore we
# need the current dbh to get the not yet committed mtime
$form->new_lastmtime('ar', $provided_dbh);
8c1d5d75 Martin Helmling
b6213d35 Moritz Bunkus
# add shipto
54e4131e Moritz Bunkus
if (!$form->{shipto_id}) {
$form->add_shipto($dbh, $form->{id}, "AR");
}
d319704a Moritz Bunkus
# save printed, emailed and queued
$form->save_status($dbh);

be6f6cfd Moritz Bunkus
Common::webdav_folder($form);
d319704a Moritz Bunkus
94e11003 Moritz Bunkus
# Link this record to the records it was created from.
748ce36f Tamino Steinert
foreach (qw(oe ar reclamations)) {
if ($form->{"convert_from_${_}_ids"}) {
RecordLinks->create_links('dbh' => $dbh,
'mode' => 'ids',
'from_table' => $_,
'from_ids' => $form->{"convert_from_${_}_ids"},
'to_table' => 'ar',
'to_id' => $form->{id},
78912e55 Jan Büren
);
748ce36f Tamino Steinert
delete $form->{"convert_from_${_}_ids"};
}
78912e55 Jan Büren
}
94e11003 Moritz Bunkus
my @convert_from_do_ids = map { $_ * 1 } grep { $_ } split m/\s+/, $form->{convert_from_do_ids};

if (scalar @convert_from_do_ids) {
3c1ceacd Moritz Bunkus
DO->close_orders('dbh' => $dbh,
94e11003 Moritz Bunkus
'ids' => \@convert_from_do_ids);

RecordLinks->create_links('dbh' => $dbh,
'mode' => 'ids',
'from_table' => 'delivery_orders',
'from_ids' => \@convert_from_do_ids,
'to_table' => 'ar',
'to_id' => $form->{id},
);
3c1ceacd Moritz Bunkus
}
247a26dc Moritz Bunkus
delete $form->{convert_from_do_ids};

ARAP->close_orders_if_billed('dbh' => $dbh,
'arap_id' => $form->{id},
'table' => 'ar',);
3c1ceacd Moritz Bunkus
f087c373 Jan Büren
# search for orphaned invoice items
$query = sprintf 'SELECT id FROM invoice WHERE trans_id = ? AND NOT id IN (%s)', join ', ', ("?") x scalar @processed_invoice_ids;
@values = (conv_i($form->{id}), map { conv_i($_) } @processed_invoice_ids);
my @orphaned_ids = map { $_->{id} } selectall_hashref_query($form, $dbh, $query, @values);
if (scalar @orphaned_ids) {
# clean up invoice items
$query = sprintf 'DELETE FROM invoice WHERE id IN (%s)', join ', ', ("?") x scalar @orphaned_ids;
do_query($form, $dbh, $query, @orphaned_ids);
}

c954dea7 Moritz Bunkus
if ($form->{draft_id}) {
SL::DB::Manager::Draft->delete_all(where => [ id => delete($form->{draft_id}) ]);
}

7e7a1369 Sven Schöling
# safety check datev export
3424bf80 Bernd Bleßmann
if ($::instance_conf->get_datev_check_on_sales_invoice) {
7e7a1369 Sven Schöling
my $datev = SL::DATEV->new(
dbh => $dbh,
e04c32d3 Niclas Zimmermann
trans_id => $form->{id},
7e7a1369 Sven Schöling
);

0a64ac3d Geoffrey Richardson
$datev->generate_datev_data;
7e7a1369 Sven Schöling
if ($datev->errors) {
die join "\n", $::locale->text('DATEV check returned errors:'), $datev->errors;
}
}

f71e1c67 Tamino Steinert
# update shop status
my $invoice = SL::DB::Invoice->new( id => $form->{id} )->load;
my @linked_shop_orders = $invoice->linked_records(
from => 'ShopOrder',
6dc9c1d9 Werner Hahn
via => ['DeliveryOrder','Order',],
f71e1c67 Tamino Steinert
);
#do update
my $shop_order = $linked_shop_orders[0][0];
fa2cf4e6 Werner Hahn
if ( $shop_order ) {
6dc9c1d9 Werner Hahn
require SL::Shop;
f71e1c67 Tamino Steinert
my $shop_config = SL::DB::Manager::Shop->get_first( query => [ id => $shop_order->shop_id ] );
my $shop = SL::Shop->new( config => $shop_config );
$shop->connector->set_orderstatus($shop_order->shop_trans_id, "completed");
}

7e4a1765 Bernd Bleßmann
$validity_token->delete if $validity_token;
delete $form->{form_validity_token};

b9442827 Sven Schöling
return 1;
d319704a Moritz Bunkus
}

58186225 Bernd Bleßmann
sub _get_invoices_for_advance_payment {
72e545d6 Bernd Bleßmann
my ($self, $id, $id_is_from_order) = @_;
58186225 Bernd Bleßmann
return [] if !$id;

72e545d6 Bernd Bleßmann
# Search all related invoices for advance payment.
# Case 1:
# (order) -> invoice for adv. payment 1 -> invoice for adv. payment 2 -> invoice for adv. payment 3 -> final invoice
#
# Case 2:
# order -> invoice for adv. payment 1
# | |`-> invoice for adv. payment 2
# | `--> invoice for adv. payment 3
# `----> final invoice
#
# The id is currently that from the last invoice for adv. payment (3 in this example),
# that from the final invoice or that from the order.

my $invoice_obj;
my $order_obj;
my $links;

if (!$id_is_from_order) {
$invoice_obj = SL::DB::Invoice->load_cached($id*1);
$links = $invoice_obj->linked_records(direction => 'from', from => ['Order']);
$order_obj = $links->[0];
} else {
$order_obj = SL::DB::Order->load_cached($id*1);
}

if ($order_obj) {
$links = $order_obj ->linked_records(direction => 'to', to => ['Invoice']);
} else {
$links = $invoice_obj->linked_records(direction => 'from', from => ['Invoice'], recursive => 1);
}

58186225 Bernd Bleßmann
my @related_invoices = grep {'SL::DB::Invoice' eq ref $_ && "invoice_for_advance_payment" eq $_->type} @$links;

72e545d6 Bernd Bleßmann
push @related_invoices, $invoice_obj if !$order_obj && "invoice_for_advance_payment" eq $invoice_obj->type;
58186225 Bernd Bleßmann
return \@related_invoices;
}


9d07c34f Bernd Bleßmann
sub transfer_out {
$::lxdebug->enter_sub;

97ac8565 Jan Büren
my ($self, $form, $dbh) = @_;
9d07c34f Bernd Bleßmann
f4431e33 Bernd Bleßmann
my (@errors, @transfers);

918c39c0 Jan Büren
# do nothing, if transfer default is not requested at all
f4431e33 Bernd Bleßmann
if (!$::instance_conf->get_transfer_default) {
$::lxdebug->leave_sub;
return \@errors;
}

require SL::WH;
9d07c34f Bernd Bleßmann
foreach my $i (1 .. $form->{rowcount}) {
next if !$form->{"id_$i"};
f4431e33 Bernd Bleßmann
4b2e8d68 Jan Büren
my ($err, $qty, $wh_id, $bin_id, $chargenumber);
c9cace86 Jan Büren
c577d18a Jan Büren
if ($::instance_conf->get_sales_serial_eq_charge && $form->{"serialnumber_$i"}) {
f2463a51 Tamino Steinert
my @serials = split(" ", trim($form->{"serialnumber_$i"}));
c9cace86 Jan Büren
if (scalar @serials != $form->{"qty_$i"}) {
push @errors, $::locale->text("Cannot transfer #1 qty with #2 serial number(s)", $form->{"qty_$i"}, scalar @serials);
last;
}
foreach my $serial (@serials) {
4b2e8d68 Jan Büren
($qty, $wh_id, $bin_id, $chargenumber) = WH->get_wh_and_bin_for_charge(chargenumber => $serial);
if (!$qty) {
push @errors, $::locale->text("Not enough in stock for the serial number #1", $serial);
last;
}
c9cace86 Jan Büren
push @transfers, {
'parts_id' => $form->{"id_$i"},
'qty' => 1,
'unit' => $form->{"unit_$i"},
'transfer_type' => 'shipped',
'src_warehouse_id' => $wh_id,
'src_bin_id' => $bin_id,
'chargenumber' => $chargenumber,
'project_id' => $form->{"project_id_$i"},
'invoice_id' => $form->{"invoice_id_$i"},
'comment' => $::locale->text("Default transfer invoice with charge number"),
};
}
$err = []; # error handling uses @errors direct
} else {
($err, $wh_id, $bin_id) = _determine_wh_and_bin($dbh, $::instance_conf,
$form->{"id_$i"},
$form->{"qty_$i"},
$form->{"unit_$i"});
if (!@{ $err } && $wh_id && $bin_id) {
push @transfers, {
'parts_id' => $form->{"id_$i"},
'qty' => $form->{"qty_$i"},
'unit' => $form->{"unit_$i"},
'transfer_type' => 'shipped',
'src_warehouse_id' => $wh_id,
'src_bin_id' => $bin_id,
'project_id' => $form->{"project_id_$i"},
'invoice_id' => $form->{"invoice_id_$i"},
'comment' => $::locale->text("Default transfer invoice"),
};
}
}
f4431e33 Bernd Bleßmann
push @errors, @{ $err };
c9cace86 Jan Büren
} # end form rowcount
9d07c34f Bernd Bleßmann
f4431e33 Bernd Bleßmann
if (!@errors) {
WH->transfer(@transfers);
}
9d07c34f Bernd Bleßmann
$::lxdebug->leave_sub;
f4431e33 Bernd Bleßmann
return \@errors;
9d07c34f Bernd Bleßmann
}

sub _determine_wh_and_bin {
$::lxdebug->enter_sub(2);

f4431e33 Bernd Bleßmann
my ($dbh, $conf, $part_id, $qty, $unit) = @_;
my @errors;
9d07c34f Bernd Bleßmann
my $part = SL::DB::Part->new(id => $part_id)->load;

f4431e33 Bernd Bleßmann
# ignore service if they are not configured to be transfered
9d07c34f Bernd Bleßmann
if ($part->is_service && !$conf->get_transfer_default_services) {
$::lxdebug->leave_sub(2);
eabc3f08 Jan Büren
return (\@errors);
9d07c34f Bernd Bleßmann
}

f4431e33 Bernd Bleßmann
# test negative qty
if ($qty < 0) {
push @errors, $::locale->text("Cannot transfer negative quantities.");
return (\@errors);
}

# get/test default bin
my ($default_wh_id, $default_bin_id);
if ($conf->get_transfer_default_use_master_default_bin) {
$default_wh_id = $conf->get_warehouse_id if $conf->get_warehouse_id;
$default_bin_id = $conf->get_bin_id if $conf->get_bin_id;
}
my $wh_id = $part->warehouse_id || $default_wh_id;
my $bin_id = $part->bin_id || $default_bin_id;

# check qty and bin
if ($bin_id) {
my ($max_qty, $error) = WH->get_max_qty_parts_bin(dbh => $dbh,
parts_id => $part->id,
bin_id => $bin_id);
if ($error == 1) {
e1596b6b Geoffrey Richardson
push @errors, $::locale->text('Part "#1" has chargenumber or best before date set. So it cannot be transfered automatically.',
f4431e33 Bernd Bleßmann
$part->description);
}
my $form_unit_obj = SL::DB::Unit->new(name => $unit)->load;
my $part_unit_qty = $form_unit_obj->convert_to($qty, $part->unit_obj);
my $diff_qty = $max_qty - $part_unit_qty;
if (!@errors && $diff_qty < 0) {
090b94e9 Bernd Bleßmann
push @errors, $::locale->text('For part "#1" there are missing #2 #3 in the default warehouse/bin "#4/#5".',
97ac8565 Jan Büren
$part->description,
f4431e33 Bernd Bleßmann
$::form->format_amount(\%::myconfig, -1*$diff_qty),
$part->unit_obj->name,
SL::DB::Warehouse->new(id => $wh_id)->load->description,
SL::DB::Bin->new( id => $bin_id)->load->description);
}
} else {
090b94e9 Bernd Bleßmann
push @errors, $::locale->text('For part "#1" there is no default warehouse and bin defined.',
f4431e33 Bernd Bleßmann
$part->description);
}
9d07c34f Bernd Bleßmann
f4431e33 Bernd Bleßmann
# transfer to special "ignore onhand" bin if requested and default bin does not work
if (@errors && $conf->get_transfer_default_ignore_onhand && $conf->get_bin_id_ignore_onhand) {
9d07c34f Bernd Bleßmann
$wh_id = $conf->get_warehouse_id_ignore_onhand;
$bin_id = $conf->get_bin_id_ignore_onhand;
f4431e33 Bernd Bleßmann
if ($wh_id && $bin_id) {
@errors = ();
} else {
090b94e9 Bernd Bleßmann
push @errors, $::locale->text('For part "#1" there is no default warehouse and bin for ignoring onhand defined.',
f4431e33 Bernd Bleßmann
$part->description);
}
9d07c34f Bernd Bleßmann
}

$::lxdebug->leave_sub(2);
f4431e33 Bernd Bleßmann
return (\@errors, $wh_id, $bin_id);
9d07c34f Bernd Bleßmann
}

0560b39e Bernd Bleßmann
sub _delete_transfers {
$::lxdebug->enter_sub;

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

my $query = qq|DELETE FROM inventory WHERE invoice_id
IN (SELECT id FROM invoice WHERE trans_id = ?)|;

do_query($form, $dbh, $query, $id);

$::lxdebug->leave_sub;
}

5fdc44cb Moritz Bunkus
sub _delete_payments {
$main::lxdebug->enter_sub();
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
my ($self, $form, $dbh) = @_;
54e4131e Moritz Bunkus
6ff01fdb Moritz Bunkus
my @delete_acc_trans_ids;
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
# Delete old payment entries from acc_trans.
my $query =
6ff01fdb Moritz Bunkus
qq|SELECT acc_trans_id
5fdc44cb Moritz Bunkus
FROM acc_trans
WHERE (trans_id = ?) AND fx_transaction

UNION

6ff01fdb Moritz Bunkus
SELECT at.acc_trans_id
5fdc44cb Moritz Bunkus
FROM acc_trans at
LEFT JOIN chart c ON (at.chart_id = c.id)
WHERE (trans_id = ?) AND (c.link LIKE '%AR_paid%')|;
6ff01fdb Moritz Bunkus
push @delete_acc_trans_ids, selectall_array_query($form, $dbh, $query, conv_i($form->{id}), conv_i($form->{id}));
5fdc44cb Moritz Bunkus
$query =
6ff01fdb Moritz Bunkus
qq|SELECT at.acc_trans_id
5fdc44cb Moritz Bunkus
FROM acc_trans at
LEFT JOIN chart c ON (at.chart_id = c.id)
WHERE (trans_id = ?)
AND ((c.link = 'AR') OR (c.link LIKE '%:AR') OR (c.link LIKE 'AR:%'))
6ff01fdb Moritz Bunkus
ORDER BY at.acc_trans_id
5fdc44cb Moritz Bunkus
OFFSET 1|;
6ff01fdb Moritz Bunkus
push @delete_acc_trans_ids, selectall_array_query($form, $dbh, $query, conv_i($form->{id}));
5fdc44cb Moritz Bunkus
6ff01fdb Moritz Bunkus
if (@delete_acc_trans_ids) {
$query = qq|DELETE FROM acc_trans WHERE acc_trans_id IN (| . join(", ", @delete_acc_trans_ids) . qq|)|;
5fdc44cb Moritz Bunkus
do_query($form, $dbh, $query);
1c084510 Moritz Bunkus
}
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
$main::lxdebug->leave_sub();
}
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
sub post_payment {
b9442827 Sven Schöling
my ($self, $myconfig, $form, $locale) = @_;
5fdc44cb Moritz Bunkus
$main::lxdebug->enter_sub();
54e4131e Moritz Bunkus
b9442827 Sven Schöling
my $rc = SL::DB->client->with_transaction(\&_post_payment, $self, $myconfig, $form, $locale);

$::lxdebug->leave_sub;
return $rc;
}

sub _post_payment {
5fdc44cb Moritz Bunkus
my ($self, $myconfig, $form, $locale) = @_;
54e4131e Moritz Bunkus
b9442827 Sven Schöling
my $dbh = SL::DB->client->dbh;
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
my (%payments, $old_form, $row, $item, $query, %keep_vars);
532b0d4c Moritz Bunkus
5fdc44cb Moritz Bunkus
$old_form = save_form();
54e4131e Moritz Bunkus
1de19311 Moritz Bunkus
$query = <<SQL;
SELECT at.acc_trans_id, at.amount, at.cleared, c.accno
FROM acc_trans at
LEFT JOIN chart c ON (at.chart_id = c.id)
WHERE (at.trans_id = ?)
SQL

my %already_cleared = selectall_as_map($form, $dbh, $query, 'acc_trans_id', [ qw(amount cleared accno) ], $form->{id});

5fdc44cb Moritz Bunkus
# Delete all entries in acc_trans from prior payments.
97954312 Bernd Bleßmann
if (SL::DB::Default->get->payments_changeable != 0) {
f45b296f Bernd Bleßmann
$self->_delete_payments($form, $dbh);
}
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
# Save the new payments the user made before cleaning up $form.
f45b296f Bernd Bleßmann
map { $payments{$_} = $form->{$_} } grep m/^datepaid_\d+$|^gldate_\d+$|^acc_trans_id_\d+$|^memo_\d+$|^source_\d+$|^exchangerate_\d+$|^paid_\d+$|^AR_paid_\d+$|^paidaccounts$/, keys %{ $form };
529c6ea4 Sven Schöling
5fdc44cb Moritz Bunkus
# Clean up $form so that old content won't tamper the results.
%keep_vars = map { $_, 1 } qw(login password id);
map { delete $form->{$_} unless $keep_vars{$_} } keys %{ $form };
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
# Retrieve the invoice from the database.
$self->retrieve_invoice($myconfig, $form);
529c6ea4 Sven Schöling
9c5108ec Moritz Bunkus
# Set up the content of $form in the way that IS::post_invoice() expects.
5fdc44cb Moritz Bunkus
$form->{exchangerate} = $form->format_amount($myconfig, $form->{exchangerate});
529c6ea4 Sven Schöling
5fdc44cb Moritz Bunkus
for $row (1 .. scalar @{ $form->{invoice_details} }) {
$item = $form->{invoice_details}->[$row - 1];

map { $item->{$_} = $form->format_amount($myconfig, $item->{$_}) } qw(qty sellprice discount);

map { $form->{"${_}_${row}"} = $item->{$_} } keys %{ $item };
1c084510 Moritz Bunkus
}
548f4467 Moritz Bunkus
5fdc44cb Moritz Bunkus
$form->{rowcount} = scalar @{ $form->{invoice_details} };
548f4467 Moritz Bunkus
5fdc44cb Moritz Bunkus
delete @{$form}{qw(invoice_details paidaccounts storno paid)};
548f4467 Moritz Bunkus
5fdc44cb Moritz Bunkus
# Restore the payment options from the user input.
map { $form->{$_} = $payments{$_} } keys %payments;
54e4131e Moritz Bunkus
6bd1a382 Moritz Bunkus
# Get the AR accno (which is normally done by Form::create_links()).
5fdc44cb Moritz Bunkus
$query =
qq|SELECT c.accno
FROM acc_trans at
LEFT JOIN chart c ON (at.chart_id = c.id)
WHERE (trans_id = ?)
AND ((c.link = 'AR') OR (c.link LIKE '%:AR') OR (c.link LIKE 'AR:%'))
6ff01fdb Moritz Bunkus
ORDER BY at.acc_trans_id
5fdc44cb Moritz Bunkus
LIMIT 1|;
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
($form->{AR}) = selectfirst_array_query($form, $dbh, $query, conv_i($form->{id}));
54e4131e Moritz Bunkus
5fdc44cb Moritz Bunkus
# Post the new payments.
1de19311 Moritz Bunkus
$self->post_invoice($myconfig, $form, $dbh, payments_only => 1, already_cleared => \%already_cleared);
5fdc44cb Moritz Bunkus
restore_form($old_form);
54e4131e Moritz Bunkus
b9442827 Sven Schöling
return 1;
54e4131e Moritz Bunkus
}

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

93dc3778 Bernd Bleßmann
my ($dbh, $myconfig, $form, $position, $id, $totalqty) = @_;
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
my $query =
723a1158 Geoffrey Richardson
qq|SELECT a.parts_id, a.qty, p.part_type, p.partnumber, p.description, p.unit
532b0d4c Moritz Bunkus
FROM assembly a
JOIN parts p ON (a.parts_id = p.id)
WHERE (a.id = ?)|;
my $sth = prepare_execute_query($form, $dbh, $query, conv_i($id));
d319704a Moritz Bunkus
b8da8785 Sven Schöling
while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
my $allocated = 0;

$ref->{inventory_accno_id} *= 1;
$ref->{expense_accno_id} *= 1;

# multiply by number of assemblies
$ref->{qty} *= $totalqty;

if ($ref->{assembly}) {
93dc3778 Bernd Bleßmann
&process_assembly($dbh, $myconfig, $form, $position, $ref->{parts_id}, $ref->{qty});
d319704a Moritz Bunkus
next;
} else {
if ($ref->{inventory_accno_id}) {
306fad80 Geoffrey Richardson
$allocated = &cogs($dbh, $myconfig, $form, $ref->{parts_id}, $ref->{qty});
d319704a Moritz Bunkus
}
}

# save detail record for individual assembly item in invoice table
532b0d4c Moritz Bunkus
$query =
93dc3778 Bernd Bleßmann
qq|INSERT INTO invoice (trans_id, position, description, parts_id, qty, sellprice, fxsellprice, allocated, assemblyitem, unit)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
my @values = (conv_i($form->{id}), conv_i($position), $ref->{description},
conv_i($ref->{parts_id}), $ref->{qty}, 0, 0, $allocated, 't', $ref->{unit});
532b0d4c Moritz Bunkus
do_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
}

$sth->finish;

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

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

306fad80 Geoffrey Richardson
# adjust allocated in table invoice according to FIFO princicple
# for a certain part with part_id $id

my ($dbh, $myconfig, $form, $id, $totalqty, $basefactor, $row) = @_;
c2f2c60e Sven Schöling
$basefactor ||= 1;

fe3df360 Philip Reetz
$form->{taxzone_id} *=1;
532b0d4c Moritz Bunkus
my $transdate = $form->{invdate} ? $dbh->quote($form->{invdate}) : "current_date";
my $taxzone_id = $form->{"taxzone_id"} * 1;
my $query =
2952e413 Geoffrey Richardson
qq|SELECT i.id, i.trans_id, i.base_qty, i.allocated, i.sellprice, i.price_factor,
b3327c52 Sven Schöling
c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from AS inventory_valid,
c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from AS income_valid,
c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from AS expense_valid
532b0d4c Moritz Bunkus
FROM invoice i, parts p
LEFT JOIN chart c1 ON ((SELECT inventory_accno_id FROM buchungsgruppen WHERE id = p.buchungsgruppen_id) = c1.id)
b989d7cf Geoffrey Richardson
LEFT JOIN chart c2 ON ((SELECT tc.income_accno_id FROM taxzone_charts tc WHERE tc.taxzone_id = '$taxzone_id' and tc.buchungsgruppen_id = p.buchungsgruppen_id) = c2.id)
LEFT JOIN chart c3 ON ((SELECT tc.expense_accno_id FROM taxzone_charts tc WHERE tc.taxzone_id = '$taxzone_id' and tc.buchungsgruppen_id = p.buchungsgruppen_id) = c3.id)
532b0d4c Moritz Bunkus
WHERE (i.parts_id = p.id)
AND (i.parts_id = ?)
AND ((i.base_qty + i.allocated) < 0)
ORDER BY trans_id|;
my $sth = prepare_execute_query($form, $dbh, $query, conv_i($id));
d319704a Moritz Bunkus
my $allocated = 0;
my $qty;

43f9b1c5 Geoffrey Richardson
# all invoice entries of an example part:

5074cc50 Moritz Bunkus
# id | trans_id | base_qty | allocated | sellprice | inventory_accno | income_accno | expense_accno
43f9b1c5 Geoffrey Richardson
# ---+----------+----------+-----------+-----------+-----------------+--------------+---------------
# 4 | 4 | -5 | 5 | 20.00000 | 1140 | 4400 | 5400 bought 5 for 20
# 5 | 5 | 4 | -4 | 50.00000 | 1140 | 4400 | 5400 sold 4 for 50
# 6 | 6 | 1 | -1 | 50.00000 | 1140 | 4400 | 5400 sold 1 for 50
# 7 | 7 | -5 | 1 | 20.00000 | 1140 | 4400 | 5400 bought 5 for 20
# 8 | 8 | 1 | -1 | 50.00000 | 1140 | 4400 | 5400 sold 1 for 50

# AND ((i.base_qty + i.allocated) < 0) filters out all but line with id=7, elsewhere i.base_qty + i.allocated has already reached 0
# and all parts have been allocated

# so transaction 8 only sees transaction 7 with unallocated parts and adjusts allocated for that transaction, before allocated was 0
# 7 | 7 | -5 | 1 | 20.00000 | 1140 | 4400 | 5400 bought 5 for 20

# in this example there are still 4 unsold articles


# search all invoice entries for the part in question, adjusting "allocated"
# until the total number of sold parts has been reached

# ORDER BY trans_id ensures FIFO


b8da8785 Sven Schöling
while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
54e4131e Moritz Bunkus
if (($qty = (($ref->{base_qty} * -1) - $ref->{allocated})) > $totalqty) {
d319704a Moritz Bunkus
$qty = $totalqty;
}

43f9b1c5 Geoffrey Richardson
# update allocated in invoice
532b0d4c Moritz Bunkus
$form->update_balance($dbh, "invoice", "allocated", qq|id = $ref->{id}|, $qty);
d319704a Moritz Bunkus
# total expenses and inventory
# sellprice is the cost of the item
961adb71 Sven Schöling
my $linetotal = $form->round_amount(($ref->{sellprice} * $qty) / ( ($ref->{price_factor} || 1) * ( $basefactor || 1 )), 2);
d319704a Moritz Bunkus
43f9b1c5 Geoffrey Richardson
if ( $::instance_conf->get_inventory_system eq 'perpetual' ) {
# Bestandsmethode: when selling parts, deduct their purchase value from the inventory account
fe3df360 Philip Reetz
$ref->{expense_accno} = ($form->{"expense_accno_$row"}) ? $form->{"expense_accno_$row"} : $ref->{expense_accno};
d319704a Moritz Bunkus
# add to expense
3b1eaa1a Moritz Bunkus
$form->{amount_cogs}{ $form->{id} }{ $ref->{expense_accno} } += -$linetotal;
d319704a Moritz Bunkus
$form->{expense_inventory} .= " " . $ref->{expense_accno};
fe3df360 Philip Reetz
$ref->{inventory_accno} = ($form->{"inventory_accno_$row"}) ? $form->{"inventory_accno_$row"} : $ref->{inventory_accno};
d319704a Moritz Bunkus
# deduct inventory
3b1eaa1a Moritz Bunkus
$form->{amount_cogs}{ $form->{id} }{ $ref->{inventory_accno} } -= -$linetotal;
d319704a Moritz Bunkus
$form->{expense_inventory} .= " " . $ref->{inventory_accno};
}

# add allocated
532b0d4c Moritz Bunkus
$allocated -= $qty;
d319704a Moritz Bunkus
last if (($totalqty -= $qty) <= 0);
}

$sth->finish;

$main::lxdebug->leave_sub();

return $allocated;
}

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

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

# reverse inventory items
532b0d4c Moritz Bunkus
my $query =
723a1158 Geoffrey Richardson
qq|SELECT i.id, i.parts_id, i.qty, i.assemblyitem, p.part_type
532b0d4c Moritz Bunkus
FROM invoice i
JOIN parts p ON (i.parts_id = p.id)
WHERE i.trans_id = ?|;
my $sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{"id"}));
d319704a Moritz Bunkus
b8da8785 Sven Schöling
while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
83914eeb Moritz Bunkus
if ($ref->{inventory_accno_id}) {
d319704a Moritz Bunkus
# de-allocated purchases
532b0d4c Moritz Bunkus
$query =
qq|SELECT i.id, i.trans_id, i.allocated
FROM invoice i
WHERE (i.parts_id = ?) AND (i.allocated > 0)
ORDER BY i.trans_id DESC|;
my $sth2 = prepare_execute_query($form, $dbh, $query, conv_i($ref->{"parts_id"}));

b8da8785 Sven Schöling
while (my $inhref = $sth2->fetchrow_hashref('NAME_lc')) {
my $qty = $ref->{qty};
d319704a Moritz Bunkus
if (($ref->{qty} - $inhref->{allocated}) > 0) {
$qty = $inhref->{allocated};
}

# update invoice
532b0d4c Moritz Bunkus
$form->update_balance($dbh, "invoice", "allocated", qq|id = $inhref->{id}|, $qty * -1);
d319704a Moritz Bunkus
last if (($ref->{qty} -= $qty) <= 0);
}
532b0d4c Moritz Bunkus
$sth2->finish;
d319704a Moritz Bunkus
}
}

$sth->finish;

# delete acc_trans
b8da8785 Sven Schöling
my @values = (conv_i($form->{id}));
532b0d4c Moritz Bunkus
do_query($form, $dbh, qq|DELETE FROM acc_trans WHERE trans_id = ?|, @values);
4493d1eb Moritz Bunkus
$query = qq|DELETE FROM custom_variables
WHERE (config_id IN (SELECT id FROM custom_variable_configs WHERE (module = 'ShipTo')))
AND (trans_id IN (SELECT shipto_id FROM shipto WHERE (module = 'AR') AND (trans_id = ?)))|;
do_query($form, $dbh, $query, @values);
532b0d4c Moritz Bunkus
do_query($form, $dbh, qq|DELETE FROM shipto WHERE (trans_id = ?) AND (module = 'AR')|, @values);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub delete_invoice {
b9442827 Sven Schöling
my ($self, $myconfig, $form) = @_;
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();

b9442827 Sven Schöling
my $rc = SL::DB->client->with_transaction(\&_delete_invoice, $self, $myconfig, $form);

$::lxdebug->leave_sub;
return $rc;
}

sub _delete_invoice {
8cd05ad6 Moritz Bunkus
my ($self, $myconfig, $form) = @_;
d319704a Moritz Bunkus
b9442827 Sven Schöling
my $dbh = SL::DB->client->dbh;
d319704a Moritz Bunkus
&reverse_invoice($dbh, $form);
0560b39e Bernd Bleßmann
_delete_transfers($dbh, $form, $form->{id});
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
my @values = (conv_i($form->{id}));

dd27c969 Jan Büren
# Falls wir ein Storno haben, müssen zwei Felder in der stornierten Rechnung wieder
# zurückgesetzt werden. Vgl:
864a3244 Moritz Bunkus
# id | storno | storno_id | paid | amount
dd27c969 Jan Büren
#----+--------+-----------+---------+-----------
# 18 | f | | 0.00000 | 119.00000
# ZU:
# 18 | t | | 119.00000 | 119.00000
#
if($form->{storno}){
# storno_id auslesen und korrigieren
my ($invoice_id) = selectfirst_array_query($form, $dbh, qq|SELECT storno_id FROM ar WHERE id = ?|,@values);
do_query($form, $dbh, qq|UPDATE ar SET storno = 'f', paid = 0 WHERE id = ?|, $invoice_id);
}

700cdcc0 Bernd Bleßmann
# if we delete a final invoice, the reverse bookings for the clearing account in the invoice for advance payment
# must be deleted as well
72e545d6 Bernd Bleßmann
my $invoices_for_advance_payment = $self->_get_invoices_for_advance_payment($form->{id});
7b5fd5ed Bernd Bleßmann
# Todo: allow only if invoice for advance payment is not paid.
# die if any { $_->paid } for @$invoices_for_advance_payment;
700cdcc0 Bernd Bleßmann
my @trans_ids_to_consider = map { $_->id } @$invoices_for_advance_payment;
if (scalar @trans_ids_to_consider) {
my $query = sprintf 'DELETE FROM acc_trans WHERE memo LIKE ? AND trans_id IN (%s)', join ', ', ("?") x scalar @trans_ids_to_consider;
do_query($form, $dbh, $query, 'reverse booking by final invoice', @trans_ids_to_consider);
}

d319704a Moritz Bunkus
# delete spool files
532b0d4c Moritz Bunkus
my @spoolfiles = selectall_array_query($form, $dbh, qq|SELECT spoolfile FROM status WHERE trans_id = ?|, @values);
d319704a Moritz Bunkus
bc88a0d1 Moritz Bunkus
my @queries = (
qq|DELETE FROM status WHERE trans_id = ?|,
qq|DELETE FROM periodic_invoices WHERE ar_id = ?|,
f087c373 Jan Büren
qq|DELETE FROM invoice WHERE trans_id = ?|,
bc88a0d1 Moritz Bunkus
qq|DELETE FROM ar WHERE id = ?|,
);

map { do_query($form, $dbh, $_, @values) } @queries;
d319704a Moritz Bunkus
b9442827 Sven Schöling
my $spool = $::lx_office_conf{paths}->{spool};
map { unlink "$spool/$_" if -f "$spool/$_"; } @spoolfiles;
d319704a Moritz Bunkus
b9442827 Sven Schöling
return 1;
d319704a Moritz Bunkus
}

sub retrieve_invoice {
b9442827 Sven Schöling
my ($self, $myconfig, $form) = @_;
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();
0bb0eb67 Stephan Köhler
b9442827 Sven Schöling
my $rc = SL::DB->client->with_transaction(\&_retrieve_invoice, $self, $myconfig, $form);

$::lxdebug->leave_sub;
return $rc;
}

sub _retrieve_invoice {
d319704a Moritz Bunkus
my ($self, $myconfig, $form) = @_;

b9442827 Sven Schöling
my $dbh = SL::DB->client->dbh;
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
my ($sth, $ref, $query);

74fca575 Sven Schöling
my $query_transdate = !$form->{id} ? ", current_date AS invdate" : '';
532b0d4c Moritz Bunkus
$query =
qq|SELECT
7eae8fac Moritz Bunkus
(SELECT c.accno FROM chart c WHERE d.inventory_accno_id = c.id) AS inventory_accno,
(SELECT c.accno FROM chart c WHERE d.income_accno_id = c.id) AS income_accno,
(SELECT c.accno FROM chart c WHERE d.expense_accno_id = c.id) AS expense_accno,
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
030c2086 Rolf Fluehmann
(SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno,
(SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno,
(SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno
532b0d4c Moritz Bunkus
${query_transdate}
FROM defaults d|;

$ref = selectfirst_hashref_query($form, $dbh, $query);
map { $form->{$_} = $ref->{$_} } keys %{ $ref };
d319704a Moritz Bunkus
if ($form->{id}) {
532b0d4c Moritz Bunkus
my $id = conv_i($form->{id});
d319704a Moritz Bunkus
# retrieve invoice
d4bddbd1 Geoffrey Richardson
#erweiterung um das entsprechende feld lieferscheinnummer (a.donumber) in der html-maske anzuzeigen 12.02.2009 jb

532b0d4c Moritz Bunkus
$query =
qq|SELECT
a.invnumber, a.ordnumber, a.quonumber, a.cusordnumber,
a.orddate, a.quodate, a.globalproject_id,
0b36b225 Moritz Bunkus
a.transdate AS invdate, a.deliverydate, a.tax_point, a.paid, a.storno, a.storno_id, a.gldate,
464f44ac Moritz Bunkus
a.shippingpoint, a.shipvia, a.notes, a.intnotes, a.taxzone_id,
a4d74009 Niclas Zimmermann
a.duedate, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.shipto_id, a.cp_id,
844a541e Moritz Bunkus
a.billing_address_id,
532b0d4c Moritz Bunkus
a.employee_id, a.salesman_id, a.payment_id,
d735aab3 Martin Helmling
a.mtime, a.itime,
532b0d4c Moritz Bunkus
a.language_id, a.delivery_customer_id, a.delivery_vendor_id, a.type,
2c447b2f Jan Büren
a.transaction_description, a.donumber, a.invnumber_for_credit_note,
bfeee737 Cem Aydin
a.marge_total, a.marge_percent, a.direct_debit, a.qrbill_without_amount, a.qr_reference, a.qr_unstructured_message, a.delivery_term_id,
4bcc6d52 Moritz Bunkus
dc.dunning_description,
2c447b2f Jan Büren
e.name AS employee
532b0d4c Moritz Bunkus
FROM ar a
LEFT JOIN employee e ON (e.id = a.employee_id)
4bcc6d52 Moritz Bunkus
LEFT JOIN dunning_config dc ON (a.dunning_config_id = dc.id)
532b0d4c Moritz Bunkus
WHERE a.id = ?|;
$ref = selectfirst_hashref_query($form, $dbh, $query, $id);
map { $form->{$_} = $ref->{$_} } keys %{ $ref };
d735aab3 Martin Helmling
$form->{mtime} = $form->{itime} if !$form->{mtime};
$form->{lastmtime} = $form->{mtime};
d319704a Moritz Bunkus
40a94352 Jan Büren
($form->{exchangerate}, $form->{record_forex}) = $form->check_exchangerate($myconfig, $form->{currency}, $form->{invdate}, "buy", $id, 'ar');
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
foreach my $vc (qw(customer vendor)) {
next if !$form->{"delivery_${vc}_id"};
208de6f2 Jan Büren
($form->{"delivery_${vc}_string"}) = selectrow_query($form, $dbh, qq|SELECT name FROM customer WHERE id = ?|,
$form->{"delivery_${vc}_id"});
54e4131e Moritz Bunkus
}

5902705e Bernd Bleßmann
# get shipto
$query = qq|SELECT * FROM shipto WHERE (trans_id = ?) AND (module = 'AR')|;
$ref = selectfirst_hashref_query($form, $dbh, $query, $id);
a8cba95a Moritz Bunkus
$form->{$_} = $ref->{$_} for grep { m{^shipto(?!_id$)} } keys %$ref;
5902705e Bernd Bleßmann
d319704a Moritz Bunkus
# get printed, emailed
52983c08 Sven Schöling
$query = qq|SELECT printed, emailed, spoolfile, formname FROM status WHERE trans_id = ?|;
532b0d4c Moritz Bunkus
$sth = prepare_execute_query($form, $dbh, $query, $id);
d319704a Moritz Bunkus
b8da8785 Sven Schöling
while ($ref = $sth->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
$form->{printed} .= "$ref->{formname} " if $ref->{printed};
$form->{emailed} .= "$ref->{formname} " if $ref->{emailed};
52983c08 Sven Schöling
$form->{queued} .= "$ref->{formname} $ref->{spoolfile} " if $ref->{spoolfile};
d319704a Moritz Bunkus
}
$sth->finish;
map { $form->{$_} =~ s/ +$//g } qw(printed emailed queued);

0b36b225 Moritz Bunkus
my $transdate = $form->{tax_point} ? $dbh->quote($form->{tax_point})
: $form->{deliverydate} ? $dbh->quote($form->{deliverydate})
52983c08 Sven Schöling
: $form->{invdate} ? $dbh->quote($form->{invdate})
: "current_date";
8fa48153 Sven Schöling
532b0d4c Moritz Bunkus
my $taxzone_id = $form->{taxzone_id} *= 1;
1c62d23e Geoffrey Richardson
$taxzone_id = SL::DB::Manager::TaxZone->get_default->id unless SL::DB::Manager::TaxZone->find_by(id => $taxzone_id);
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
# retrieve individual items
532b0d4c Moritz Bunkus
$query =
qq|SELECT
52983c08 Sven Schöling
c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from AS inventory_valid,
c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from as income_valid,
c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from AS expense_valid,
532b0d4c Moritz Bunkus
98452aaa Moritz Bunkus
i.id AS invoice_id,
ca57b730 Philip Reetz
i.description, i.longdescription, i.qty, i.fxsellprice AS sellprice, i.discount, i.parts_id AS id, i.unit, i.deliverydate AS reqdate,
f087c373 Jan Büren
i.project_id, i.serialnumber, i.pricegroup_id, i.ordnumber, i.donumber, i.transdate, i.cusordnumber, i.subtotal, i.lastcost,
89b26688 Sven Schöling
i.price_factor_id, i.price_factor, i.marge_price_factor, i.active_price_source, i.active_discount_source,
723a1158 Geoffrey Richardson
p.partnumber, p.part_type, p.notes AS partnotes, p.formel, p.listprice,
65d2537d Martin Helmling
p.classification_id,
52983c08 Sven Schöling
pr.projectnumber, pg.partsgroup, prg.pricegroup
532b0d4c Moritz Bunkus
FROM invoice i
LEFT JOIN parts p ON (i.parts_id = p.id)
LEFT JOIN project pr ON (i.project_id = pr.id)
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
LEFT JOIN pricegroup prg ON (i.pricegroup_id = prg.id)

52983c08 Sven Schöling
LEFT JOIN chart c1 ON ((SELECT inventory_accno_id FROM buchungsgruppen WHERE id = p.buchungsgruppen_id) = c1.id)
b989d7cf Geoffrey Richardson
LEFT JOIN chart c2 ON ((SELECT tc.income_accno_id FROM taxzone_charts tc WHERE tc.taxzone_id = '$taxzone_id' and tc.buchungsgruppen_id = p.buchungsgruppen_id) = c2.id)
LEFT JOIN chart c3 ON ((SELECT tc.expense_accno_id FROM taxzone_charts tc WHERE tc.taxzone_id = '$taxzone_id' and tc.buchungsgruppen_id = p.buchungsgruppen_id) = c3.id)
52983c08 Sven Schöling
93dc3778 Bernd Bleßmann
WHERE (i.trans_id = ?) AND NOT (i.assemblyitem = '1') ORDER BY i.position|;
532b0d4c Moritz Bunkus
$sth = prepare_execute_query($form, $dbh, $query, $id);
54e4131e Moritz Bunkus
b8da8785 Sven Schöling
while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
98452aaa Moritz Bunkus
# Retrieve custom variables.
my $cvars = CVar->get_custom_variables(dbh => $dbh,
module => 'IC',
sub_module => 'invoice',
trans_id => $ref->{invoice_id},
);
map { $ref->{"ic_cvar_$_->{name}"} = $_->{value} } @{ $cvars };

52983c08 Sven Schöling
map({ delete($ref->{$_}); } qw(inventory_accno inventory_new_chart inventory_valid)) if !$ref->{"part_inventory_accno_id"};
54e4131e Moritz Bunkus
delete($ref->{"part_inventory_accno_id"});
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
foreach my $type (qw(inventory income expense)) {
while ($ref->{"${type}_new_chart"} && ($ref->{"${type}_valid"} >=0)) {
52983c08 Sven Schöling
my $query = qq|SELECT accno, new_chart_id, date($transdate) - valid_from FROM chart WHERE id = ?|;
@$ref{ map $type.$_, qw(_accno _new_chart _valid) } = selectrow_query($form, $dbh, $query, $ref->{"${type}_new_chart"});
532b0d4c Moritz Bunkus
}
}
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
# get tax rates and description
52983c08 Sven Schöling
my $accno_id = ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno};
532b0d4c Moritz Bunkus
$query =
4e8e33e9 Geoffrey Richardson
qq|SELECT c.accno, t.taxdescription, t.rate, t.id as tax_id, c.accno as taxnumber
543d7822 Geoffrey Richardson
FROM tax t
532b0d4c Moritz Bunkus
LEFT JOIN chart c ON (c.id = t.chart_id)
WHERE t.id IN
52983c08 Sven Schöling
(SELECT tk.tax_id FROM taxkeys tk
8fa48153 Sven Schöling
WHERE tk.chart_id = (SELECT id FROM chart WHERE accno = ?)
6eea36b2 Thomas Kasulke
AND startdate <= date($transdate)
52983c08 Sven Schöling
ORDER BY startdate DESC LIMIT 1)
532b0d4c Moritz Bunkus
ORDER BY c.accno|;
my $stw = prepare_execute_query($form, $dbh, $query, $accno_id);
d319704a Moritz Bunkus
$ref->{taxaccounts} = "";
54e4131e Moritz Bunkus
my $i=0;
b8da8785 Sven Schöling
while (my $ptr = $stw->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
54e4131e Moritz Bunkus
if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) {
$i++;
$ptr->{accno} = $i;
}
d319704a Moritz Bunkus
$ref->{taxaccounts} .= "$ptr->{accno} ";
54e4131e Moritz Bunkus
5cf977e5 Moritz Bunkus
if (!($form->{taxaccounts} =~ /\Q$ptr->{accno}\E/)) {
d319704a Moritz Bunkus
$form->{"$ptr->{accno}_rate"} = $ptr->{rate};
54e4131e Moritz Bunkus
$form->{"$ptr->{accno}_description"} = $ptr->{taxdescription};
4e8e33e9 Geoffrey Richardson
$form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber}; # don't use this anymore
$form->{"$ptr->{accno}_tax_id"} = $ptr->{tax_id};
d319704a Moritz Bunkus
$form->{taxaccounts} .= "$ptr->{accno} ";
}

}

532b0d4c Moritz Bunkus
$ref->{qty} *= -1 if $form->{type} eq "credit_note";

d319704a Moritz Bunkus
chop $ref->{taxaccounts};
push @{ $form->{invoice_details} }, $ref;
$stw->finish;
}
$sth->finish;

4493d1eb Moritz Bunkus
# Fetch shipping address.
$query = qq|SELECT s.* FROM shipto s WHERE s.trans_id = ? AND s.module = 'AR'|;
$ref = selectfirst_hashref_query($form, $dbh, $query, $form->{id});

$form->{$_} = $ref->{$_} for grep { $_ ne 'id' } keys %$ref;

if ($form->{shipto_id}) {
my $cvars = CVar->get_custom_variables(
dbh => $dbh,
module => 'ShipTo',
trans_id => $form->{shipto_id},
);
$form->{"shiptocvar_$_->{name}"} = $_->{value} for @{ $cvars };
}

be6f6cfd Moritz Bunkus
Common::webdav_folder($form);
d319704a Moritz Bunkus
}

b9442827 Sven Schöling
return 1;
d319704a Moritz Bunkus
}

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

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

# connect to database
9c7c96a8 Sven Schöling
my $dbh = $form->get_standard_dbh;
d319704a Moritz Bunkus
my $dateformat = $myconfig->{dateformat};
$dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;

5bc87ade Moritz Bunkus
my (@values, $ref, $query);
d319704a Moritz Bunkus
532b0d4c Moritz Bunkus
my $cid = conv_i($form->{customer_id});
cdfebb50 Moritz Bunkus
my $payment_id;

d319704a Moritz Bunkus
# get customer
c878cea9 Bernd Bleßmann
my $where = '';
if ($cid) {
$where .= 'AND c.id = ?';
push @values, $cid;
}
532b0d4c Moritz Bunkus
$query =
qq|SELECT
464f44ac Moritz Bunkus
c.id AS customer_id, c.name AS customer, c.discount as customer_discount, c.creditlimit,
03d3d025 Bernd Bleßmann
c.email, c.cc, c.bcc, c.language_id, c.payment_id, c.delivery_term_id,
532b0d4c Moritz Bunkus
c.street, c.zipcode, c.city, c.country,
7349649b Geoffrey Richardson
c.notes AS intnotes, c.pricegroup_id as customer_pricegroup_id, c.taxzone_id, c.salesman_id, cu.name AS curr,
a523371d Moritz Bunkus
c.taxincluded_checked, c.direct_debit,
844a541e Moritz Bunkus
(SELECT aba.id
FROM additional_billing_addresses aba
WHERE aba.default_address
LIMIT 1) AS default_billing_address_id,
532b0d4c Moritz Bunkus
b.discount AS tradediscount, b.description AS business
FROM customer c
LEFT JOIN business b ON (b.id = c.business_id)
ba6a1366 Niclas Zimmermann
LEFT JOIN currencies cu ON (c.currency_id=cu.id)
c878cea9 Bernd Bleßmann
WHERE 1 = 1 $where|;
532b0d4c Moritz Bunkus
$ref = selectfirst_hashref_query($form, $dbh, $query, @values);
1a83013a Jan Büren
die t8("Cannot find a single customer. Maybe there is no customer yet?") unless $ref;
dc9d8764 Moritz Bunkus
delete $ref->{salesman_id} if !$ref->{salesman_id};
ce36e8eb Moritz Bunkus
delete $ref->{payment_id} if !$ref->{payment_id};
dc9d8764 Moritz Bunkus
d319704a Moritz Bunkus
map { $form->{$_} = $ref->{$_} } keys %$ref;
54e4131e Moritz Bunkus
5bc87ade Moritz Bunkus
if ($form->{payment_id}) {
my $reference_date = $form->{invdate} ? DateTime->from_kivitendo($form->{invdate}) : undef;
$form->{duedate} = SL::DB::PaymentTerm->new(id => $form->{payment_id})->load->calc_date(reference_date => $reference_date)->to_kivitendo;
} else {
$form->{duedate} = DateTime->today_local->to_kivitendo;
}

d331a3d7 Niclas Zimmermann
# use customer currency
$form->{currency} = $form->{curr};
94802c79 Bernd Bleßmann
532b0d4c Moritz Bunkus
$query =
qq|SELECT sum(amount - paid) AS dunning_amount
FROM ar
WHERE (paid < amount)
AND (customer_id = ?)
AND (dunning_config_id IS NOT NULL)|;
$ref = selectfirst_hashref_query($form, $dbh, $query, $cid);
54e4131e Moritz Bunkus
map { $form->{$_} = $ref->{$_} } keys %$ref;

532b0d4c Moritz Bunkus
$query =
qq|SELECT dnn.dunning_description AS max_dunning_level
FROM dunning_config dnn
WHERE id IN (SELECT dunning_config_id
FROM ar
WHERE (paid < amount) AND (customer_id = ?) AND (dunning_config_id IS NOT NULL))
ORDER BY dunning_level DESC LIMIT 1|;
$ref = selectfirst_hashref_query($form, $dbh, $query, $cid);
54e4131e Moritz Bunkus
map { $form->{$_} = $ref->{$_} } keys %$ref;

d319704a Moritz Bunkus
$form->{creditremaining} = $form->{creditlimit};
532b0d4c Moritz Bunkus
$query = qq|SELECT SUM(amount - paid) FROM ar WHERE customer_id = ?|;
my ($value) = selectrow_query($form, $dbh, $query, $cid);
$form->{creditremaining} -= $value;

$query =
qq|SELECT o.amount,
(SELECT e.buy FROM exchangerate e
a4d74009 Niclas Zimmermann
WHERE e.currency_id = o.currency_id
532b0d4c Moritz Bunkus
AND e.transdate = o.transdate)
FROM oe o
WHERE o.customer_id = ?
6c8eb668 Tamino Steinert
AND o.record_type = 'sales_order'
532b0d4c Moritz Bunkus
AND o.closed = '0'|;
b8da8785 Sven Schöling
my $sth = prepare_execute_query($form, $dbh, $query, $cid);
d319704a Moritz Bunkus
while (my ($amount, $exch) = $sth->fetchrow_array) {
$exch = 1 unless $exch;
$form->{creditremaining} -= $amount * $exch;
}
$sth->finish;

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

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

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

2e5a8be3 Moritz Bunkus
# connect to database
74b9dd67 Sven Schöling
my $dbh = $form->get_standard_dbh;
2e5a8be3 Moritz Bunkus
d319704a Moritz Bunkus
my $i = $form->{rowcount};

532b0d4c Moritz Bunkus
my $where = qq|NOT p.obsolete = '1'|;
my @values;
d319704a Moritz Bunkus
4b47dbd9 Holger Lindemann
foreach my $column (qw(p.partnumber p.description pgpartsgroup )) {
532b0d4c Moritz Bunkus
my ($table, $field) = split m/\./, $column;
next if !$form->{"${field}_${i}"};
$where .= qq| AND lower(${column}) ILIKE ?|;
bc40bcab Moritz Bunkus
push @values, like($form->{"${field}_${i}"});
d319704a Moritz Bunkus
}

6f1b36cf Sven Schöling
my (%mm_by_id);
4b47dbd9 Holger Lindemann
if ($form->{"partnumber_$i"} && !$form->{"description_$i"}) {
c09536f4 Sven Schöling
$where .= qq| OR (NOT p.obsolete = '1' AND p.ean = ? )|;
push @values, $form->{"partnumber_$i"};
6f1b36cf Sven Schöling
# also search hits in makemodels, but only cache the results by id and merge later
my $mm_query = qq|
SELECT parts_id, model FROM makemodel LEFT JOIN parts ON parts.id = parts_id WHERE NOT parts.obsolete AND model ILIKE ?;
|;
bc40bcab Moritz Bunkus
my $mm_results = selectall_hashref_query($::form, $dbh, $mm_query, like($form->{"partnumber_$i"}));
6f1b36cf Sven Schöling
my @mm_ids = map { $_->{parts_id} } @$mm_results;
push @{$mm_by_id{ $_->{parts_id} } ||= []}, $_ for @$mm_results;

if (@mm_ids) {
$where .= qq| OR p.id IN (| . join(',', ('?') x @mm_ids) . qq|)|;
push @values, @mm_ids;
}
4b47dbd9 Holger Lindemann
}

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

d319704a Moritz Bunkus
if ($form->{"description_$i"}) {
532b0d4c Moritz Bunkus
$where .= qq| ORDER BY p.description|;
d319704a Moritz Bunkus
} else {
532b0d4c Moritz Bunkus
$where .= qq| ORDER BY p.partnumber|;
d319704a Moritz Bunkus
}

2e5a8be3 Moritz Bunkus
my $transdate;
54e4131e Moritz Bunkus
if ($form->{type} eq "invoice") {
2e5a8be3 Moritz Bunkus
$transdate =
$form->{deliverydate} ? $dbh->quote($form->{deliverydate}) :
532b0d4c Moritz Bunkus
$form->{invdate} ? $dbh->quote($form->{invdate}) :
"current_date";
2e5a8be3 Moritz Bunkus
} else {
$transdate =
532b0d4c Moritz Bunkus
$form->{transdate} ? $dbh->quote($form->{transdate}) :
"current_date";
54e4131e Moritz Bunkus
}

532b0d4c Moritz Bunkus
my $taxzone_id = $form->{taxzone_id} * 1;
$taxzone_id = 0 if (0 > $taxzone_id) || (3 < $taxzone_id);

my $query =
qq|SELECT
p.id, p.partnumber, p.description, p.sellprice,
351de256 Geoffrey Richardson
p.listprice, p.part_type, p.lastcost,
4ddcd461 Jan Büren
p.ean, p.notes,
65d2537d Martin Helmling
p.classification_id,
532b0d4c Moritz Bunkus
c1.accno AS inventory_accno,
c1.new_chart_id AS inventory_new_chart,
date($transdate) - c1.valid_from AS inventory_valid,

c2.accno AS income_accno,
c2.new_chart_id AS income_new_chart,
date($transdate) - c2.valid_from AS income_valid,

c3.accno AS expense_accno,
c3.new_chart_id AS expense_new_chart,
date($transdate) - c3.valid_from AS expense_valid,

98b64fe1 Geoffrey Richardson
p.unit, p.part_type, p.onhand,
532b0d4c Moritz Bunkus
p.notes AS partnotes, p.notes AS longdescription,
p.not_discountable, p.formel, p.payment_id AS part_payment_id,
a7ecfa38 Niclas Zimmermann
p.price_factor_id, p.weight,
1e251313 Moritz Bunkus
pfac.factor AS price_factor,
65d2537d Martin Helmling
pt.used_for_sale AS used_for_sale,
532b0d4c Moritz Bunkus
pg.partsgroup

FROM parts p
LEFT JOIN chart c1 ON
((SELECT inventory_accno_id
FROM buchungsgruppen
WHERE id = p.buchungsgruppen_id) = c1.id)
LEFT JOIN chart c2 ON
b989d7cf Geoffrey Richardson
((SELECT tc.income_accno_id
FROM taxzone_charts tc
WHERE tc.buchungsgruppen_id = p.buchungsgruppen_id and tc.taxzone_id = ${taxzone_id}) = c2.id)
532b0d4c Moritz Bunkus
LEFT JOIN chart c3 ON
b989d7cf Geoffrey Richardson
((SELECT tc.expense_accno_id
FROM taxzone_charts tc
WHERE tc.buchungsgruppen_id = p.buchungsgruppen_id and tc.taxzone_id = ${taxzone_id}) = c3.id)
532b0d4c Moritz Bunkus
LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id)
65d2537d Martin Helmling
LEFT JOIN part_classifications pt ON (pt.id = p.classification_id)
1e251313 Moritz Bunkus
LEFT JOIN price_factors pfac ON (pfac.id = p.price_factor_id)
532b0d4c Moritz Bunkus
WHERE $where|;
my $sth = prepare_execute_query($form, $dbh, $query, @values);
d319704a Moritz Bunkus
165a97b3 Moritz Bunkus
my @translation_queries = ( [ qq|SELECT tr.translation, tr.longdescription
FROM translation tr
WHERE tr.language_id = ? AND tr.parts_id = ?| ],
[ qq|SELECT tr.translation, tr.longdescription
FROM translation tr
WHERE tr.language_id IN
(SELECT id
FROM language
WHERE article_code = (SELECT article_code FROM language WHERE id = ?))
AND tr.parts_id = ?
LIMIT 1| ] );
map { push @{ $_ }, prepare_query($form, $dbh, $_->[0]) } @translation_queries;

65d2537d Martin Helmling
my $has_wrong_pclass = PCLASS_OK;
b8da8785 Sven Schöling
while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
6f1b36cf Sven Schöling
if ($mm_by_id{$ref->{id}}) {
$ref->{makemodels} = $mm_by_id{$ref->{id}};
push @{ $ref->{matches} ||= [] }, $::locale->text('Model') . ': ' . join ', ', map { $_->{model} } @{ $mm_by_id{$ref->{id}} };
}

9b4e6a46 Moritz Bunkus
if (($::form->{"partnumber_$i"} ne '') && ($ref->{ean} eq $::form->{"partnumber_$i"})) {
6f1b36cf Sven Schöling
push @{ $ref->{matches} ||= [] }, $::locale->text('EAN') . ': ' . $ref->{ean};
}

0aa885f4 Sven Schöling
$ref->{type_and_classific} = type_abbreviation($ref->{part_type}) .
classification_abbreviation($ref->{classification_id});
65d2537d Martin Helmling
if (! $ref->{used_for_sale} ) {
$has_wrong_pclass = PCLASS_NOTFORSALE ;
next;
}
54e4131e Moritz Bunkus
# In der Buchungsgruppe ist immer ein Bestandskonto verknuepft, auch wenn
# es sich um eine Dienstleistung handelt. Bei Dienstleistungen muss das
# Buchungskonto also aus dem Ergebnis rausgenommen werden.
if (!$ref->{inventory_accno_id}) {
map({ delete($ref->{"inventory_${_}"}); } qw(accno new_chart valid));
}
delete($ref->{inventory_accno_id});

532b0d4c Moritz Bunkus
foreach my $type (qw(inventory income expense)) {
while ($ref->{"${type}_new_chart"} && ($ref->{"${type}_valid"} >=0)) {
my $query =
qq|SELECT accno, new_chart_id, date($transdate) - valid_from
FROM chart
WHERE id = ?|;
($ref->{"${type}_accno"},
$ref->{"${type}_new_chart"},
$ref->{"${type}_valid"})
= selectrow_query($form, $dbh, $query, $ref->{"${type}_new_chart"});
}
54e4131e Moritz Bunkus
}

532b0d4c Moritz Bunkus
if ($form->{payment_id} eq "") {
$form->{payment_id} = $form->{part_payment_id};
}

d319704a Moritz Bunkus
# get tax rates and description
b8da8785 Sven Schöling
my $accno_id = ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno};
532b0d4c Moritz Bunkus
$query =
4e8e33e9 Geoffrey Richardson
qq|SELECT c.accno, t.taxdescription, t.id as tax_id, t.rate, c.accno as taxnumber
532b0d4c Moritz Bunkus
FROM tax t
LEFT JOIN chart c ON (c.id = t.chart_id)
WHERE t.id in
(SELECT tk.tax_id
FROM taxkeys tk
WHERE tk.chart_id = (SELECT id from chart WHERE accno = ?)
AND startdate <= ?
ORDER BY startdate DESC
LIMIT 1)
ORDER BY c.accno|;
6eea36b2 Thomas Kasulke
@values = ($accno_id, $transdate eq "current_date" ? "now" : $transdate);
b8da8785 Sven Schöling
my $stw = $dbh->prepare($query);
532b0d4c Moritz Bunkus
$stw->execute(@values) || $form->dberror($query);
d319704a Moritz Bunkus
$ref->{taxaccounts} = "";
54e4131e Moritz Bunkus
my $i = 0;
b8da8785 Sven Schöling
while (my $ptr = $stw->fetchrow_hashref('NAME_lc')) {
d319704a Moritz Bunkus
54e4131e Moritz Bunkus
if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) {
$i++;
$ptr->{accno} = $i;
}
d319704a Moritz Bunkus
$ref->{taxaccounts} .= "$ptr->{accno} ";
54e4131e Moritz Bunkus
5cf977e5 Moritz Bunkus
if (!($form->{taxaccounts} =~ /\Q$ptr->{accno}\E/)) {
d319704a Moritz Bunkus
$form->{"$ptr->{accno}_rate"} = $ptr->{rate};
54e4131e Moritz Bunkus
$form->{"$ptr->{accno}_description"} = $ptr->{taxdescription};
d319704a Moritz Bunkus
$form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber};
4e8e33e9 Geoffrey Richardson
$form->{"$ptr->{accno}_tax_id"} = $ptr->{tax_id};
d319704a Moritz Bunkus
$form->{taxaccounts} .= "$ptr->{accno} ";
}

}

$stw->finish;
chop $ref->{taxaccounts};
165a97b3 Moritz Bunkus
54e4131e Moritz Bunkus
if ($form->{language_id}) {
165a97b3 Moritz Bunkus
for my $spec (@translation_queries) {
do_statement($form, $spec->[1], $spec->[0], conv_i($form->{language_id}), conv_i($ref->{id}));
my ($translation, $longdescription) = $spec->[1]->fetchrow_array;
next unless $translation;
54e4131e Moritz Bunkus
$ref->{description} = $translation;
$ref->{longdescription} = $longdescription;
165a97b3 Moritz Bunkus
last;
54e4131e Moritz Bunkus
}
}
d319704a Moritz Bunkus
83914eeb Moritz Bunkus
$ref->{onhand} *= 1;
d319704a Moritz Bunkus
push @{ $form->{item_list} }, $ref;
}
$sth->finish;
165a97b3 Moritz Bunkus
$_->[1]->finish for @translation_queries;
ef220490 Moritz Bunkus
65d2537d Martin Helmling
$form->{is_wrong_pclass} = $has_wrong_pclass;
$form->{NOTFORSALE} = PCLASS_NOTFORSALE;
$form->{NOTFORPURCHASE} = PCLASS_NOTFORPURCHASE;
ef220490 Moritz Bunkus
foreach my $item (@{ $form->{item_list} }) {
my $custom_variables = CVar->get_custom_variables(module => 'IC',
trans_id => $item->{id},
dbh => $dbh,
);
65d2537d Martin Helmling
$form->{is_wrong_pclass} = PCLASS_OK; # one correct type
ef220490 Moritz Bunkus
map { $item->{"ic_cvar_" . $_->{name} } = $_->{value} } @{ $custom_variables };
}
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

95155b0d Moritz Bunkus
sub has_storno {
$main::lxdebug->enter_sub();

a1a3bfd8 Moritz Bunkus
my ($self, $myconfig, $form, $table) = @_;
95155b0d Moritz Bunkus
$main::lxdebug->leave_sub() and return 0 unless ($form->{id});

1fa91538 Sven Schöling
# make sure there's no funny stuff in $table
# ToDO: die when this happens and throw an error
$main::lxdebug->leave_sub() and return 0 if ($table =~ /\W/);

74b9dd67 Sven Schöling
my $dbh = $form->get_standard_dbh;
95155b0d Moritz Bunkus
805e8da4 Sven Schöling
my $query = qq|SELECT storno FROM $table WHERE storno_id = ?|;
my ($result) = selectrow_query($form, $dbh, $query, $form->{id});

$main::lxdebug->leave_sub();

return $result;
}

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

077ebb6c Moritz Bunkus
my ($self, $myconfig, $form, $table, $id) = @_;
805e8da4 Sven Schöling
077ebb6c Moritz Bunkus
$main::lxdebug->leave_sub() and return 0 unless ($id);
805e8da4 Sven Schöling
# make sure there's no funny stuff in $table
# ToDO: die when this happens and throw an error
$main::lxdebug->leave_sub() and return 0 if ($table =~ /\W/);

74b9dd67 Sven Schöling
my $dbh = $form->get_standard_dbh;
805e8da4 Sven Schöling
a1a3bfd8 Moritz Bunkus
my $query = qq|SELECT storno FROM $table WHERE id = ?|;
077ebb6c Moritz Bunkus
my ($result) = selectrow_query($form, $dbh, $query, $id);
95155b0d Moritz Bunkus
$main::lxdebug->leave_sub();

return $result;
}

0e0ff150 Jan Büren
sub get_standard_accno_current_assets {
$main::lxdebug->enter_sub();

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

74b9dd67 Sven Schöling
my $dbh = $form->get_standard_dbh;
0e0ff150 Jan Büren
my $query = qq| SELECT accno FROM chart WHERE id = (SELECT ar_paid_accno_id FROM defaults)|;
my ($result) = selectrow_query($form, $dbh, $query);

$main::lxdebug->leave_sub();

return $result;
}

d319704a Moritz Bunkus
1;