"../../../../../../search%3Fscope=subprojects.html">Suche:
projekt kivitendo
Alle Projekte

projekt kivitendo

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

kivitendo/SL/Form.pm @ 166099c6

#=====================================================================
# 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: Thomas Bayen <bayen@gmx.de>
# Antti Kaihola <akaihola@siba.fi>
# Moritz Bunkus (tex code)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1335, USA.
#======================================================================
# Utilities for parsing forms
# and supporting routines for linking account numbers
# used in AR, AP and IS, IR modules
#
#======================================================================

package Form;

use Carp;
use Data::Dumper;

use Carp;
use CGI;
use Cwd;
use Encode;
use File::Copy;
use File::Temp ();
use IO::File;
use Math::BigInt;
use Params::Validate qw(:all);
use POSIX qw(strftime);
use SL::Auth;
use SL::Auth::DB;
use SL::Auth::LDAP;
use SL::AM;
use SL::Common;
use SL::CVar;
use SL::DB;
use SL::DBConnect;
use SL::DBUtils;
use SL::DB::AdditionalBillingAddress;
use SL::DB::Customer;
use SL::DB::CustomVariableConfig;
use SL::DB::Default;
use SL::DB::PaymentTerm;
use SL::DB::Vendor;
use SL::DO;
use SL::Helper::Flash qw();
use SL::IC;
use SL::IS;
use SL::Layout::Dispatcher;
use SL::Locale;
use SL::Locale::String;
use SL::Mailer;
use SL::Menu;
use SL::MoreCommon qw(uri_encode uri_decode);
use SL::OE;
use SL::PrefixedNumber;
use SL::Request;
use SL::Template;
use SL::
my $prefix = $self->get_number_prefix_for_type();

if ($subject && $self->{"${prefix}number"}) {
$subject .= " " . $self->{"${prefix}number"}
}

if ($self->{cusordnumber}) {
$subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject;
}

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

sub generate_email_body {
$main::lxdebug->enter_sub();
my ($self, %params) = @_;
# simple german and english will work grammatically (most european languages as well)
# Dear Mr Alan Greenspan:
# Sehr geehrte Frau Meyer,
# A l’attention de Mme Villeroy,
# Gentile Signora Ferrari,
my $body = '';

if ($self->{cp_id} && !$params{record_email}) {
my $givenname = SL::DB::Contact->load_cached($self->{cp_id})->cp_givenname; # for qw(gender givename name);
my $name = SL::DB::Contact->load_cached($self->{cp_id})->cp_name; # for qw(gender givename name);
my $gender = SL::DB::Contact->load_cached($self->{cp_id})->cp_gender; # for qw(gender givename name);
my $mf = $gender eq 'f' ? 'female' : 'male';
$body = GenericTranslations->get(translation_type => "salutation_$mf", language_id => $self->{language_id});
$body .= ' ' . $givenname . ' ' . $name if $body;
} else {
$body = GenericTranslations->get(translation_type => "salutation_general", language_id => $self->{language_id});
}

return undef unless $body;

$body .= GenericTranslations->get(translation_type => "salutation_punctuation_mark", language_id => $self->{language_id});
$body = '<p>' . $::locale->quote_special_chars('HTML', $body) . '</p>';

my $translation_type = $params{translation_type} // "preset_text_$self->{formname}";
my $main_body = GenericTranslations->get(translation_type => $translation_type, language_id => $self->{language_id});
$main_body = GenericTranslations->get(translation_type => $params{fallback_translation_type}, language_id => $self->{language_id}) if !$main_body && $params{fallback_translation_type};
$body .= $main_body;

$body = $main::locale->unquote_special_chars('HTML', $body);

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

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

my ($self, $application) = @_;

my $error_code = $?;

chdir("$self->{tmpdir}");

my @err = ();
if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');

} elsif (-f "$self->{tmpfile}.err") {
open(FH, "<:encoding(UTF-8)", "$self->{tmpfile}.err");
@err = <FH>;
close(FH);
}

if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
$self->{tmpfile} =~ s|.*/||g;
# strip extension
$self->{tmpfile} =~ s/\.\w+$//g;
my $tmpfile = $self->{tmpfile};
unlink(<$tmpfile.*>);
}

chdir("$self->{cwd}");

$main::lxdebug->leave_sub();

return "@err";
}

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

my ($self, $date, $myconfig) = @_;
my ($yy, $mm, $dd);

if ($date && $date =~ /\D/) {

if ($myconfig->{dateformat} =~ /^yy/) {
($yy, $mm, $dd) = split /\D/, $date;
}
if ($myconfig->{dateformat} =~ /^mm/) {
($mm, $dd, $yy) = split /\D/, $date;
}
if ($myconfig->{dateformat} =~ /^dd/) {
($dd, $mm, $yy) = split /\D/, $date;
}

$dd *= 1;
$mm *= 1;
$yy = ($yy < 70) ? $yy + 2000 : $yy;
$yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;

$dd = "0$dd" if ($dd < 10);
$mm = "0$mm" if ($mm < 10);

$date = "$yy$mm$dd";
}

$main::lxdebug->leave_sub();

return $date;
}

# Database routines used throughout
# DB Handling got moved to SL::DB, these are only shims for compatibility

sub dbconnect {
SL::DB->client->dbh;
}

sub get_standard_dbh {
my $dbh = SL::DB->client->dbh;

if ($dbh && !$dbh->{Active}) {
$main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$dbh is defined but not Active anymore");
SL::DB->client->dbh(undef);
}

SL::DB->client->dbh;
}

sub disconnect_standard_dbh {
SL::DB->client->dbh->rollback;
}

# /database

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

my ($self, $date, $myconfig) = @_;
my $dbh = $self->get_standard_dbh;

my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));

# Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
# es ist sicher ein conv_date vorher IMMER auszuführen.
# Testfälle ohne definiertes closedto:
# Leere Datumseingabe i.O.
# SELECT 1 FROM defaults WHERE '' < closedto
# normale Zahlungsbuchung über Rechnungsmaske i.O.
# SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
# Testfälle mit definiertem closedto (30.04.2011):
# Leere Datumseingabe i.O.
# SELECT 1 FROM defaults WHERE '' < closedto
# normale Buchung im geschloßenem Zeitraum i.O.
# SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
# Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
# normale Buchung in aktiver Buchungsperiode i.O.
# SELECT 1 FROM defaults WHERE '01.05.2011' < closedto

my ($closed) = $sth->fetchrow_array;

$main::lxdebug->leave_sub();

return $closed;
}

# prevents bookings to the to far away future
sub date_max_future {
$main::lxdebug->enter_sub();

my ($self, $date, $myconfig) = @_;
my $dbh = $self->get_standard_dbh;

my $query = "SELECT 1 FROM defaults WHERE ? - current_date > max_future_booking_interval";
my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));

my ($max_future_booking_interval) = $sth->fetchrow_array;

$main::lxdebug->leave_sub();

return $max_future_booking_interval;
}


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

my ($self, $dbh, $table, $field, $where, $value, @values) = @_;

# if we have a value, go do it
if ($value != 0) {

# retrieve balance from table
my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
my $sth = prepare_execute_query($self, $dbh, $query, @values);
my ($balance) = $sth->fetchrow_array;
$sth->finish;

$balance += $value;

# update balance
$query = "UPDATE $table SET $field = $balance WHERE $where";
do_query($self, $dbh, $query, @values);
}
$main::lxdebug->leave_sub();
}

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

validate_pos(@_,
{ isa => 'Form'},
{ isa => 'DBI::db'},
{ type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
{ type => SCALAR, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+\d+\d+/ } } }, # we have three numers
{ type => SCALAR, callbacks => { is_null_or_ar_int => sub { $_[0] == 0
|| $_[0] > 0
&& $_[1]->[0]->{script} =~ m/cp\.pl|ar\.pl|is\.pl/ } } }, # value buy fxrate
{ type => SCALAR, callbacks => { is_null_or_ap_int => sub { $_[0] == 0
|| $_[0] > 0
&& $_[1]->[0]->{script} =~ m/cp\.pl|ap\.pl|ir\.pl/ } } }, # value sell fxrate
{ type => SCALAR, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 },
{ type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/(ar|ap|bank_transactions)/ } }, optional => 1 }
);

my ($self, $dbh, $curr, $transdate, $buy, $sell, $id, $record_table) = @_;

# record has a exchange rate and should be updated
if ($record_table && $id) {
do_query($self, $dbh, qq|UPDATE $record_table SET exchangerate = ? WHERE id = ?|, $buy || $sell, $id);
$main::lxdebug->leave_sub();
return;
}

my ($query);
$query = qq|SELECT e.currency_id FROM exchangerate e
WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ?
FOR UPDATE|;
my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);

if ($buy == 0) {
$buy = "";
}
if ($sell == 0) {
$sell = "";
}

$buy = conv_i($buy, "NULL");
$sell = conv_i($sell, "NULL");

my $set;
if ($buy != 0 && $sell != 0) {
$set = "buy = $buy, sell = $sell";
} elsif ($buy != 0) {
$set = "buy = $buy";
} elsif ($sell != 0) {
$set = "sell = $sell";
}

if ($sth->fetchrow_array) {
# die "this never happens never"; # except for credit or debit bookings
$query = qq|UPDATE exchangerate
SET $set
WHERE currency_id = (SELECT id FROM currencies WHERE name = ?)
AND transdate = ?|;

} else {
$query = qq|INSERT INTO exchangerate (currency_id, buy, sell, transdate)
VALUES ((SELECT id FROM currencies WHERE name = ?), $buy, $sell, ?)|;
}
$sth->finish;
do_query($self, $dbh, $query, $curr, $transdate);

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

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

validate_pos(@_,
{ isa => 'Form'},
{ type => HASHREF, callbacks => { has_yy_in_dateformat => sub { $_[0]->{dateformat} =~ m/yy/ } } },
{ type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
{ type => SCALAR | HASHREF, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+\d+\d+/ } } }, # we have three numbers. Either DateTime or form scalar
{ type => SCALAR, callbacks => { is_buy_or_sell_rate => sub { shift =~ m/^buy|sell$/ } } },
{ type => SCALAR, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 },
{ type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/(ar|ap)/ } }, optional => 1 }
);
my ($self, $myconfig, $currency, $transdate, $fld, $id, $record_table) = @_;

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

# callers wants a check if record has a exchange rate and should be fetched instead
if ($record_table && $id) {
my ($record_exchange_rate) = selectrow_query($self, $dbh, qq|SELECT exchangerate FROM $record_table WHERE id = ?|, $id);
if ($record_exchange_rate && $record_exchange_rate > 0) {

$main::lxdebug->leave_sub();
# second param indicates record exchange rate
return ($record_exchange_rate, 1);
}
}

# fetch default from exchangerate table
my $query = qq|SELECT e.$fld FROM exchangerate e
WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|;

my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);

$main::lxdebug->leave_sub();

return $exchangerate;
}

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

my $self = shift;
my $myconfig = shift || \%::myconfig;
my $dbh = $self->get_standard_dbh($myconfig);

my $query = qq|SELECT name FROM currencies|;
my @currencies = map { $_->{name} } selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();

return @currencies;
}

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

my ($self, $myconfig) = @_;
my $dbh = $self->get_standard_dbh($myconfig);
my $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|;

my ($defaultcurrency) = selectrow_query($self, $dbh, $query);

$main::lxdebug->leave_sub();

return $defaultcurrency;
}

sub set_payment_options {
my ($self, $myconfig, $transdate, $type) = @_;

my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef;
return if !$terms;

my $is_invoice = $type =~ m{invoice}i;

$transdate ||= $self->{invdate} || $self->{transdate};
my $due_date = $self->{duedate} || $self->{reqdate};

$self->{$_} = $terms->$_ for qw(terms_netto terms_skonto percent_skonto);
$self->{payment_description} = $terms->description;
$self->{netto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'net')->to_kivitendo;
$self->{skonto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'discount')->to_kivitendo;

my ($invtotal, $total);
my (%amounts, %formatted_amounts);

if ($self->{type} =~ /_order$/) {
$amounts{invtotal} = $self->{ordtotal};
$amounts{total} = $self->{ordtotal};

} elsif ($self->{type} =~ /_quotation$/) {
$amounts{invtotal} = $self->{quototal};
$amounts{total} = $self->{quototal};

} else {
$amounts{invtotal} = $self->{invtotal};
$amounts{total} = $self->{total};
}
map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;

$amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
$amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto};
$amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
$amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto});

foreach (keys %amounts) {
$amounts{$_} = $self->round_amount($amounts{$_}, 2);
$formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
}

if ($self->{"language_id"}) {
my $language = SL::DB::Language->new(id => $self->{language_id})->load;

$self->{payment_terms} = $type =~ m{invoice}i ? $terms->translated_attribute('description_long_invoice', $language->id) : undef;
$self->{payment_terms} ||= $terms->translated_attribute('description_long', $language->id);

if ($language->output_dateformat) {
foreach my $key (qw(netto_date skonto_date)) {
$self->{$key} = $::locale->reformat_date($myconfig, $self->{$key}, $language->output_dateformat, $language->output_longdates);
}
}

if ($language->output_numberformat && ($language->output_numberformat ne $myconfig->{numberformat})) {
local $myconfig->{numberformat};
$myconfig->{"numberformat"} = $language->output_numberformat;
$formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) for keys %amounts;
}
}

$self->{payment_terms} = $self->{payment_terms} || ($is_invoice ? $terms->description_long_invoice : undef) || $terms->description_long;

$self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
$self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
$self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
$self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
$self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
$self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
$self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
$self->{payment_terms} =~ s/<\%bic\%>/$self->{bic}/g;
$self->{payment_terms} =~ s/<\%iban\%>/$self->{iban}/g;
$self->{payment_terms} =~ s/<\%mandate_date_of_signature\%>/$self->{mandate_date_of_signature}/g;
$self->{payment_terms} =~ s/<\%mandator_id\%>/$self->{mandator_id}/g;

map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
# put amounts in form for print template
foreach (keys %formatted_amounts) {
next if $_ =~ m/(^total$|^invtotal$)/;
$self->{$_} = $formatted_amounts{$_};
}
}

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

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

my $template_code = "";

if ($self->{language_id}) {
my $dbh = $self->get_standard_dbh($myconfig);
my $query = qq|SELECT template_code FROM language WHERE id = ?|;
($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id});
}

$main::lxdebug->leave_sub();

return $template_code;
}

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

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

my $template_code = "";

if ($self->{printer_id}) {
my $dbh = $self->get_standard_dbh($myconfig);
my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|;
($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id});
}

$main::lxdebug->leave_sub();

return $template_code;
}

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

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

my $template_code = "";

if ($self->{shipto_id}) {
my $dbh = $self->get_standard_dbh($myconfig);
my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id});
map({ $self->{$_} = $ref->{$_} } keys(%$ref));

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

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

sub add_shipto {
my ($self, $dbh, $id, $module) = @_;

my $shipto;
my @values;

foreach my $item (qw(name department_1 department_2 street zipcode city country gln
contact phone fax email)) {
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
push(@values, $self->{"shipto${item}"});
}

return if !$shipto;

# shiptocp_gender only makes sense, if any other shipto attribute is set.
# Because shiptocp_gender is set to 'm' by default in forms
# it must not be considered above to decide if shiptos has to be added or
# updated, but must be inserted or updated as well in case.
push(@values, $self->{shiptocp_gender});

my $shipto_id = $self->{shipto_id};

if ($self->{shipto_id}) {
my $query = qq|UPDATE shipto set
shiptoname = ?,
shiptodepartment_1 = ?,
shiptodepartment_2 = ?,
shiptostreet = ?,
shiptozipcode = ?,
shiptocity = ?,
shiptocountry = ?,
shiptogln = ?,
shiptocontact = ?,
shiptophone = ?,
shiptofax = ?,
shiptoemail = ?,
shiptocp_gender = ?
WHERE shipto_id = ?|;
do_query($self, $dbh, $query, @values, $self->{shipto_id});
} else {
my $query = qq|SELECT * FROM shipto
WHERE shiptoname = ? AND
shiptodepartment_1 = ? AND
shiptodepartment_2 = ? AND
shiptostreet = ? AND
shiptozipcode = ? AND
shiptocity = ? AND
shiptocountry = ? AND
shiptogln = ? AND
shiptocontact = ? AND
shiptophone = ? AND
shiptofax = ? AND
shiptoemail = ? AND
shiptocp_gender = ? AND
module = ? AND
trans_id = ?|;
my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
if(!$insert_check){
my $insert_query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln,
shiptocontact, shiptophone, shiptofax, shiptoemail, shiptocp_gender, module)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
do_query($self, $dbh, $insert_query, $id, @values, $module);

$insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
}

$shipto_id = $insert_check->{shipto_id};
}

return unless $shipto_id;

CVar->save_custom_variables(
dbh => $dbh,
module => 'ShipTo',
trans_id => $shipto_id,
variables => $self,
name_prefix => 'shipto',
);
}

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

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

$dbh ||= $self->get_standard_dbh(\%main::myconfig);

my $query = qq|SELECT id, name FROM employee WHERE login = ?|;
($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login});
$self->{"employee_id"} *= 1;

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

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

my $self = shift;
my %params = @_;
my $defaults = SL::DB::Default->get;

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

if (!$params{id}) {
$main::lxdebug->leave_sub();
return;
}

my $myconfig = \%main::myconfig;
my $dbh = $params{dbh} || $self->get_standard_dbh($myconfig);

my ($login, $deleted) = selectrow_query($self, $dbh, qq|SELECT login,deleted FROM employee WHERE id = ?|, conv_i($params{id}));

if ($login) {
# login already fetched and still the same client (mandant) | same for both cases (delete|!delete)
$self->{$params{prefix} . '_login'} = $login;
$self->{$params{prefix} . "_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns taxnumber);

if (!$deleted) {
# get employee data from auth.user_config
my $user = User->new(login => $login);
$self->{$params{prefix} . "_${_}"} = $user->{$_} for qw(email fax name signature tel);
} else {
# get saved employee data from employee
my $employee = SL::DB::Manager::Employee->find_by(id => conv_i($params{id}));
$self->{$params{prefix} . "_${_}"} = $employee->{"deleted_$_"} for qw(email fax signature tel);
$self->{$params{prefix} . "_name"} = $employee->name;
}
}
$main::lxdebug->leave_sub();
}

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

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

$key = "all_contacts" unless ($key);

if (!$id) {
$self->{$key} = [];
$main::lxdebug->leave_sub();
return;
}

my $query =
qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
qq|FROM contacts | .
qq|WHERE cp_cv_id = ? | .
qq|ORDER BY lower(cp_name)|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);

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

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

my ($self, $dbh, $key) = @_;

my ($all, $old_id, $where, @values);

if (ref($key) eq "HASH") {
my $params = $key;

$key = "ALL_PROJECTS";

foreach my $p (keys(%{$params})) {
if ($p eq "all") {
$all = $params->{$p};
} elsif ($p eq "old_id") {
$old_id = $params->{$p};
} elsif ($p eq "key") {
$key = $params->{$p};
}
}
}

if (!$all) {
$where = "WHERE active ";
if ($old_id) {
if (ref($old_id) eq "ARRAY") {
my @ids = grep({ $_ } @{$old_id});
if (@ids) {
$where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
push(@values, @ids);
}
} else {
$where .= " OR (id = ?) ";
push(@values, $old_id);
}
}
}

my $query =
qq|SELECT id, projectnumber, description, active | .
qq|FROM project | .
$where .
qq|ORDER BY lower(projectnumber)|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_printers" unless ($key);

my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $params) = @_;
my ($key);

$key = $params->{key};
$key = "all_charts" unless ($key);

my $transdate = quote_db_date($params->{transdate});

my $query =
qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
qq|FROM chart c | .
qq|LEFT JOIN taxkeys tk ON | .
qq|(tk.id = (SELECT id FROM taxkeys | .
qq| WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
qq| ORDER BY startdate DESC LIMIT 1)) | .
qq|ORDER BY c.accno|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_taxzones" unless ($key);
my $tzfilter = "";
$tzfilter = "WHERE obsolete is FALSE" if $key eq 'ALL_ACTIVE_TAXZONES';

my $query = qq|SELECT * FROM tax_zones $tzfilter ORDER BY sortkey|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $params) = @_;

my $deleted = 0;

my $key;
if (ref $params eq 'HASH') {
$key = $params->{key};
$deleted = $params->{deleted};

} else {
$key = $params;
}

$key ||= "all_employees";
my $filter = $deleted ? '' : 'WHERE NOT COALESCE(deleted, FALSE)';
$self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee $filter ORDER BY lower(name)|);

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

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

my ($self, $dbh, $key) = @_;

my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_business_types";
my $where = '';

if (exists $options->{salesman}) {
$where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
}

$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_languages" unless ($key);

my $query = qq|SELECT * FROM language ORDER BY id|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_dunning_configs" unless ($key);

my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_currencies" unless ($key);

$self->{$key} = [$self->get_all_currencies()];

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

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

my ($self, $dbh, $key) = @_;

$key = "all_payments" unless ($key);

my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $key) = @_;

my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_customers";
my $limit_clause = $options->{limit} ? "LIMIT $options->{limit}" : '';

my @where;
push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman};
push @where, qq|NOT obsolete| if !$options->{with_obsolete};
my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';

my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_vendors" unless ($key);

my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $key) = @_;

$key = "all_departments" unless ($key);

my $query = qq|SELECT * FROM department ORDER BY description|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

my ($self, $dbh, $param) = @_;

my ($key, $bins_key);

if ('' eq ref $param) {
$key = $param;

} else {
$key = $param->{key};
$bins_key = $param->{bins};
}

my $query = qq|SELECT w.* FROM warehouse w
WHERE (NOT w.invalid) AND
((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
ORDER BY w.sortkey|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

if ($bins_key) {
$query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
ORDER BY description|;
my $sth = prepare_query($self, $dbh, $query);

foreach my $warehouse (@{ $self->{$key} }) {
do_statement($self, $sth, $query, $warehouse->{id});
$warehouse->{$bins_key} = [];

while (my $ref = $sth->fetchrow_hashref()) {
push @{ $warehouse->{$bins_key} }, $ref;
}
}
$sth->finish();
}

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

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

my ($self, $dbh, $table, $key, $sortkey) = @_;

my $query = qq|SELECT * FROM $table|;
$query .= qq| ORDER BY $sortkey| if ($sortkey);

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

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

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

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

croak "get_lists: shipto is no longer supported" if $params{shipto};

my $dbh = $self->get_standard_dbh(\%main::myconfig);
my ($sth, $query, $ref);

my ($vc, $vc_id);
if ($params{contacts}) {
$vc = 'customer' if $self->{"vc"} eq "customer";
$vc = 'vendor' if $self->{"vc"} eq "vendor";
die "invalid use of get_lists, need 'vc'" unless $vc;
$vc_id = $self->{"${vc}_id"};
}

if ($params{"contacts"}) {
$self->_get_contacts($dbh, $vc_id, $params{"contacts"});
}

if ($params{"projects"} || $params{"all_projects"}) {
$self->_get_projects($dbh, $params{"all_projects"} ?
$params{"all_projects"} : $params{"projects"},
$params{"all_projects"} ? 1 : 0);
}

if ($params{"printers"}) {
$self->_get_printers($dbh, $params{"printers"});
}

if ($params{"languages"}) {
$self->_get_languages($dbh, $params{"languages"});
}

if ($params{"charts"}) {
$self->_get_charts($dbh, $params{"charts"});
}

if ($params{"taxzones"}) {
$self->_get_taxzones($dbh, $params{"taxzones"});
}

if ($params{"employees"}) {
$self->_get_employees($dbh, $params{"employees"});
}

if ($params{"salesmen"}) {
$self->_get_employees($dbh, $params{"salesmen"});
}

if ($params{"business_types"}) {
$self->_get_business_types($dbh, $params{"business_types"});
}

if ($params{"dunning_configs"}) {
$self->_get_dunning_configs($dbh, $params{"dunning_configs"});
}

if($params{"currencies"}) {
$self->_get_currencies($dbh, $params{"currencies"});
}

if($params{"customers"}) {
$self->_get_customers($dbh, $params{"customers"});
}

if($params{"vendors"}) {
if (ref $params{"vendors"} eq 'HASH') {
$self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
} else {
$self->_get_vendors($dbh, $params{"vendors"});
}
}

if($params{"payments"}) {
$self->_get_payments($dbh, $params{"payments"});
}

if($params{"departments"}) {
$self->_get_departments($dbh, $params{"departments"});
}

if ($params{price_factors}) {
$self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
}

if ($params{warehouses}) {
$self->_get_warehouses($dbh, $params{warehouses});
}

if ($params{partsgroup}) {
$self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
}

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

# this sub gets the id and name from $table
sub get_name {
$main::lxdebug->enter_sub();

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

# connect to database
my $dbh = $self->get_standard_dbh($myconfig);

$table = $table eq "customer" ? "customer" : "vendor";
my $arap = $self->{arap} eq "ar" ? "ar" : "ap";

my ($query, @values);

if (!$self->{openinvoices}) {
my $where;
if ($self->{customernumber} ne "") {
$where = qq|(vc.customernumber ILIKE ?)|;
push(@values, like($self->{customernumber}));
} else {
$where = qq|(vc.name ILIKE ?)|;
push(@values, like($self->{$table}));
}

$query =
qq~SELECT vc.id, vc.name,
vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
FROM $table vc
WHERE $where AND (NOT vc.obsolete)
ORDER BY vc.name~;
} else {
$query =
qq~SELECT DISTINCT vc.id, vc.name,
vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
FROM $arap a
JOIN $table vc ON (a.${table}_id = vc.id)
WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
ORDER BY vc.name~;
push(@values, like($self->{$table}));
}

$self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);

$main::lxdebug->leave_sub();

return scalar(@{ $self->{name_list} });
}

sub new_lastmtime {

my ($self, $table, $provided_dbh) = @_;

my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh;
return unless $self->{id};
croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;

my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
$ref->{mtime} ||= $ref->{itime};
$self->{lastmtime} = $ref->{mtime};

}

sub mtime_ischanged {
my ($self, $table, $option) = @_;

return unless $self->{id};
croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;

my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
my $ref = selectfirst_hashref_query($self, $self->get_standard_dbh, $query, $self->{id});
$ref->{mtime} ||= $ref->{itime};

if ($self->{lastmtime} && $self->{lastmtime} ne $ref->{mtime} ) {
$self->error(($option eq 'mail') ?
t8("The document has been changed by another user. No mail was sent. Please reopen it in another window and copy the changes to the new window") :
t8("The document has been changed by another user. Please reopen it in another window and copy the changes to the new window")
);
$::dispatcher->end_request;
}
}

# language_payment duplicates some of the functionality of all_vc (language,
# printer, payment_terms), and at least in the case of sales invoices both
# all_vc and language_payment are called when adding new invoices
sub language_payment {
$main::lxdebug->enter_sub();

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

my $dbh = $self->get_standard_dbh($myconfig);
# get languages
my $query = qq|SELECT id, description
FROM language
ORDER BY id|;

$self->{languages} = selectall_hashref_query($self, $dbh, $query);

# get printer
$query = qq|SELECT printer_description, id
FROM printers
ORDER BY printer_description|;

$self->{printers} = selectall_hashref_query($self, $dbh, $query);

# get payment terms
$query = qq|SELECT id, description
FROM payment_terms
WHERE ( obsolete IS FALSE OR id = ? )
ORDER BY sortkey |;
$self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef);

# get buchungsgruppen
$query = qq|SELECT id, description
FROM buchungsgruppen|;

$self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);

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

# this is only used for reports
sub all_departments {
$main::lxdebug->enter_sub();

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

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

my $query = qq|SELECT id, description
FROM department
ORDER BY description|;
$self->{all_departments} = selectall_hashref_query($self, $dbh, $query);

delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });

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

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

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

my ($fld, $arap);
if ($table eq "customer") {
$fld = "buy";
$arap = "ar";
} else {
$table = "vendor";
$fld = "sell";
$arap = "ap";
}

# get last customers or vendors
my ($query, $sth, $ref);

my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
my %xkeyref = ();

if (!$self->{id}) {

my $transdate = "current_date";
if ($self->{transdate}) {
$transdate = $dbh->quote($self->{transdate});
}

# now get the account numbers
$query = qq|
SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id
FROM chart c
-- find newest entries in taxkeys
INNER JOIN (
SELECT chart_id, MAX(startdate) AS startdate
FROM taxkeys
WHERE (startdate <= $transdate)
GROUP BY chart_id
) tk ON (c.id = tk.chart_id)
-- and load all of those entries
INNER JOIN taxkeys tk2
ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
WHERE (c.link LIKE ?)
ORDER BY c.accno|;

$sth = $dbh->prepare($query);

do_statement($self, $sth, $query, like($module));

$self->{accounts} = "";
while ($ref = $sth->fetchrow_hashref("NAME_lc")) {

foreach my $key (split(/:/, $ref->{link})) {
if ($key =~ /\Q$module\E/) {

# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;

push @{ $self->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
chart_id => $ref->{chart_id},
description => $ref->{description},
taxkey => $ref->{taxkey_id},
tax_id => $ref->{tax_id} };

$self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
}
}
}
}

# get taxkeys and description
$query = qq|SELECT id, taxkey, taxdescription FROM tax|;
$self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);

if (($module eq "AP") || ($module eq "AR")) {
# get tax rates and description
$query = qq|SELECT * FROM tax|;
$self->{TAX} = selectall_hashref_query($self, $dbh, $query);
}

my $extra_columns = '';
$extra_columns .= 'a.direct_debit, ' if ($module eq 'AR') || ($module eq 'AP');

if ($self->{id}) {
$query =
qq|SELECT
a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate,
a.duedate, a.tax_point, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes,
a.mtime, a.itime,
a.intnotes, a.department_id, a.amount AS oldinvtotal,
a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
a.globalproject_id, a.transaction_description, ${extra_columns}
c.name AS $table,
d.description AS department,
e.name AS employee
FROM $arap a
JOIN $table c ON (a.${table}_id = c.id)
LEFT JOIN employee e ON (e.id = a.employee_id)
LEFT JOIN department d ON (d.id = a.department_id)
WHERE a.id = ?|;
$ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});

foreach my $key (keys %$ref) {
$self->{$key} = $ref->{$key};
}
$self->{mtime} ||= $self->{itime};
$self->{lastmtime} = $self->{mtime};
my $transdate = "current_date";
if ($self->{transdate}) {
$transdate = $dbh->quote($self->{transdate});
}

# now get the account numbers
$query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id
FROM chart c
LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
WHERE c.link LIKE ?
AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
ORDER BY c.accno|;

$sth = $dbh->prepare($query);
do_statement($self, $sth, $query, like($module));

$self->{accounts} = "";
while ($ref = $sth->fetchrow_hashref("NAME_lc")) {

foreach my $key (split(/:/, $ref->{link})) {
if ($key =~ /\Q$module\E/) {

# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;

push @{ $self->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
chart_id => $ref->{chart_id},
description => $ref->{description},
taxkey => $ref->{taxkey_id},
tax_id => $ref->{tax_id} };

$self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
}
}
}


# get amounts from individual entries
$query =
qq|SELECT
c.accno, c.description,
a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id,
p.projectnumber,
t.rate, t.id
FROM acc_trans a
LEFT JOIN chart c ON (c.id = a.chart_id)
LEFT JOIN project p ON (p.id = a.project_id)
LEFT JOIN tax t ON (t.id= a.tax_id)
WHERE a.trans_id = ?
AND a.fx_transaction = '0'
ORDER BY a.acc_trans_id, a.transdate|;
$sth = $dbh->prepare($query);
do_statement($self, $sth, $query, $self->{id});

# get exchangerate for currency
($self->{exchangerate}, $self->{record_forex}) = $self->check_exchangerate($myconfig, $self->{currency}, $self->{transdate}, $fld,
$self->{id}, $arap);

my $index = 0;

# store amounts in {acc_trans}{$key} for multiple accounts
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
# credit and debit bookings calc fx rate for positions
# also used as exchangerate_$i for payments
$ref->{exchangerate} =
$self->check_exchangerate($myconfig, $self->{currency}, $ref->{transdate}, $fld);
if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
$index++;
}
if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
$ref->{amount} *= -1;
}
$ref->{index} = $index;

push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
}

$sth->finish;
#check das:
$query =
qq|SELECT
d.closedto, d.revtrans,
(SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
(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
FROM defaults d|;
$ref = selectfirst_hashref_query($self, $dbh, $query);
map { $self->{$_} = $ref->{$_} } keys %$ref;

} else {

# get date
$query =
qq|SELECT
current_date AS transdate, d.closedto, d.revtrans,
(SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
(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
FROM defaults d|;
$ref = selectfirst_hashref_query($self, $dbh, $query);
map { $self->{$_} = $ref->{$_} } keys %$ref;

# failsafe, set currency if caller has not yet assigned one
$self->lastname_used($dbh, $myconfig, $table, $module) unless ($self->{"$self->{vc}_id"});
$self->{currency} = $self->{defaultcurrency} unless $self->{currency};
$self->{exchangerate} =
$self->check_exchangerate($myconfig, $self->{currency}, $self->{transdate}, $fld);
}

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

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

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

my ($arap, $where);

$table = $table eq "customer" ? "customer" : "vendor";
my %column_map = ("a.${table}_id" => "${table}_id",
"a.department_id" => "department_id",
"d.description" => "department",
"ct.name" => $table,
"cu.name" => "currency",
);

if ($self->{type} =~ /delivery_order/) {
$arap = 'delivery_orders';
delete $column_map{"cu.currency"};

} elsif ($self->{type} =~ /_order/) {
$arap = 'oe';
$where = "quotation = '0'";

} elsif ($self->{type} =~ /_quotation/) {
$arap = 'oe';
$where = "quotation = '1'";

} elsif ($table eq 'customer') {
$arap = 'ar';

} else {
$arap = 'ap';

}

$where = "($where) AND" if ($where);
my $query = qq|SELECT MAX(id) FROM $arap
WHERE $where ${table}_id > 0|;
my ($trans_id) = selectrow_query($self, $dbh, $query);
$trans_id *= 1;

my $column_spec = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
$query = qq|SELECT $column_spec
FROM $arap a
LEFT JOIN $table ct ON (a.${table}_id = ct.id)
LEFT JOIN department d ON (a.department_id = d.id)
LEFT JOIN currencies cu ON (cu.id=ct.currency_id)
WHERE a.id = ?|;
my $ref = selectfirst_hashref_query($self, $dbh, $query, $trans_id);

map { $self->{$_} = $ref->{$_} } values %column_map;

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

sub get_variable_content_types {
my ($self) = @_;

my %html_variables = (
longdescription => 'html',
partnotes => 'html',
notes => 'html',
orignotes => 'html',
notes1 => 'html',
notes2 => 'html',
notes3 => 'html',
notes4 => 'html',
header_text => 'html',
footer_text => 'html',
);

return {
%html_variables,
$self->get_variable_content_types_for_cvars,
};
}

sub get_variable_content_types_for_cvars {
my ($self) = @_;
my $html_configs = SL::DB::Manager::CustomVariableConfig->get_all(where => [ type => 'htmlfield' ]);
my %types;

if (@{ $html_configs }) {
my %prefix_by_module = (
Contacts => 'cp_cvar_',
CT => 'vc_cvar_',
IC => 'ic_cvar_',
Projects => 'project_cvar_',
ShipTo => 'shiptocvar_',
);

foreach my $cfg (@{ $html_configs }) {
my $prefix = $prefix_by_module{$cfg->module};
$types{$prefix . $cfg->name} = 'html' if $prefix;
}
}

return %types;
}

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

my $self = shift;
my $myconfig = shift || \%::myconfig;
my ($thisdate, $days) = @_;

my $dbh = $self->get_standard_dbh($myconfig);
my $query;

$days *= 1;
if ($thisdate) {
my $dateformat = $myconfig->{dateformat};
$dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
$thisdate = $dbh->quote($thisdate);
$query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
} else {
$query = qq|SELECT current_date AS thisdate|;
}

($thisdate) = selectrow_query($self, $dbh, $query);

$main::lxdebug->leave_sub();

return $thisdate;
}

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

my ($self, $flds, $new, $count, $numrows) = @_;

my @ndx = ();

map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;

my $i = 0;

# fill rows
foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
$i++;
my $j = $item->{ndx} - 1;
map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
}

# delete empty rows
for $i ($count + 1 .. $numrows) {
map { delete $self->{"${_}_$i"} } @{$flds};
}

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

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

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

my ($i, $id);

SL::DB->client->with_transaction(sub {
my $dbh = SL::DB->client->dbh;

my $query = qq|DELETE FROM status
WHERE (formname = ?) AND (trans_id = ?)|;
my $sth = prepare_query($self, $dbh, $query);

if ($self->{formname} =~ /(check|receipt)/) {
for $i (1 .. $self->{rowcount}) {
do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
}
} else {
do_statement($self, $sth, $query, $self->{formname}, $self->{id});
}
$sth->finish();

my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";

my %queued = split / /, $self->{queued};
my @values;

if ($self->{formname} =~ /(check|receipt)/) {

# this is a check or receipt, add one entry for each lineitem
my ($accno) = split /--/, $self->{account};
$query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
@values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
$sth = prepare_query($self, $dbh, $query);

for $i (1 .. $self->{rowcount}) {
if ($self->{"checked_$i"}) {
do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
}
}
$sth->finish();

} else {
$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
$queued{$self->{formname}}, $self->{formname});
}
1;
}) or do { die SL::DB->client->error };

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

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

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

my ($query, $printed, $emailed);

my $formnames = $self->{printed};
my $emailforms = $self->{emailed};

$query = qq|DELETE FROM status
WHERE (formname = ?) AND (trans_id = ?)|;
do_query($self, $dbh, $query, $self->{formname}, $self->{id});

# this only applies to the forms
# checks and receipts are posted when printed or queued

if ($self->{queued}) {
my %queued = split / /, $self->{queued};

foreach my $formname (keys %queued) {
$printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
$emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";

$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);

$formnames =~ s/\Q$self->{formname}\E//;
$emailforms =~ s/\Q$self->{formname}\E//;

}
}

# save printed, emailed info
$formnames =~ s/^ +//g;
$emailforms =~ s/^ +//g;

my %status = ();
map { $status{$_}{printed} = 1 } split / +/, $formnames;
map { $status{$_}{emailed} = 1 } split / +/, $emailforms;

foreach my $formname (keys %status) {
$printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0";
$emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";

$query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
VALUES (?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
}

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

#--- 4 locale ---#
# $main::locale->text('SAVED')
# $main::locale->text('SCREENED')
# $main::locale->text('DELETED')
# $main::locale->text('ADDED')
# $main::locale->text('PAYMENT POSTED')
# $main::locale->text('POSTED')
# $main::locale->text('POSTED AS NEW')
# $main::locale->text('ELSE')
# $main::locale->text('SAVED FOR DUNNING')
# $main::locale->text('DUNNING STARTED')
# $main::locale->text('PREVIEWED')
# $main::locale->text('PRINTED')
# $main::locale->text('MAILED')
# $main::locale->text('SCREENED')
# $main::locale->text('CANCELED')
# $main::locale->text('IMPORT')
# $main::locale->text('UNDO TRANSFER')
# $main::locale->text('UNIMPORT')
# $main::locale->text('invoice')
# $main::locale->text('invoice_for_advance_payment')
# $main::locale->text('final_invoice')
# $main::locale->text('proforma')
# $main::locale->text('sales_order_intake')
# $main::locale->text('sales_order')
# $main::locale->text('pick_list')
# $main::locale->text('purchase_order')
# $main::locale->text('bin_list')
# $main::locale->text('sales_quotation')
# $main::locale->text('request_quotation')
# $main::locale->text('purchase_quotation_intake')

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

my $self = shift;
my $dbh = shift || SL::DB->client->dbh;
SL::DB->client->with_transaction(sub {

if(!exists $self->{employee_id}) {
&get_employee($self, $dbh);
}

my $query =
qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
my @values = (conv_i($self->{id}), $self->{login},
$self->{addition}, $self->{what_done}, "$self->{snumbers}");
do_query($self, $dbh, $query, @values);
1;
}) or do { die SL::DB->client->error };

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

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

my ($self, $dbh, $trans_id, $restriction, $order) = @_;
my ($orderBy, $desc) = split(/\-\-/, $order);
$order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
my @tempArray;
my $i = 0;
if ($trans_id ne "") {
my $query =
qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | .
qq|FROM history_erp h | .
qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
qq|WHERE (trans_id = | . $dbh->quote($trans_id) . qq|) $restriction | .
$order;

my $sth = $dbh->prepare($query) || $self->dberror($query);

$sth->execute() || $self->dberror("$query");

while(my $hash_ref = $sth->fetchrow_hashref()) {
$hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
$hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
my ( $what, $number ) = split /_/, $hash_ref->{snumbers};
$hash_ref->{snumbers} = $number;
$hash_ref->{haslink} = 'controller.pl?action=EmailJournal/show&id='.$number if $what eq 'emailjournal';
$hash_ref->{snumbers} = $main::locale->text("E-Mail").' '.$number if $what eq 'emailjournal';
$tempArray[$i++] = $hash_ref;
}
$main::lxdebug->leave_sub() and return \@tempArray
if ($i > 0 && $tempArray[0] ne "");
}
$main::lxdebug->leave_sub();
return 0;
}

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

my ($self, $myconfig, $p) = @_;
my $target = $p->{target} || 'all_partsgroup';

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

my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
FROM partsgroup pg
JOIN parts p ON (p.partsgroup_id = pg.id) |;
my @values;

if ($p->{searchitems} eq 'part') {
$query .= qq|WHERE p.part_type = 'part'|;
}
if ($p->{searchitems} eq 'service') {
$query .= qq|WHERE p.part_type = 'service'|;
}
if ($p->{searchitems} eq 'assembly') {
$query .= qq|WHERE p.part_type = 'assembly'|;
}

$query .= qq|ORDER BY partsgroup|;

if ($p->{all}) {
$query = qq|SELECT id, partsgroup FROM partsgroup
ORDER BY partsgroup|;
}

if ($p->{language_code}) {
$query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
t.description AS translation
FROM partsgroup pg
JOIN parts p ON (p.partsgroup_id = pg.id)
LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
ORDER BY translation|;
@values = ($p->{language_code});
}

$self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);

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

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

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

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

my $query = qq|SELECT p.id, p.pricegroup
FROM pricegroup p|;

$query .= qq| ORDER BY pricegroup|;

if ($p->{all}) {
$query = qq|SELECT id, pricegroup FROM pricegroup
ORDER BY pricegroup|;
}

$self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);

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

sub all_years {
# usage $form->all_years($myconfig, [$dbh])
# return list of all years where bookings found
# (@all_years)

$main::lxdebug->enter_sub();

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

$dbh ||= $self->get_standard_dbh($myconfig);

# get years
my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
(SELECT MAX(transdate) FROM acc_trans)|;
my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);

if ($myconfig->{dateformat} =~ /^yy/) {
($startdate) = split /\W/, $startdate;
($enddate) = split /\W/, $enddate;
} else {
(@_) = split /\W/, $startdate;
$startdate = $_[2];
(@_) = split /\W/, $enddate;
$enddate = $_[2];
}

my @all_years;
$startdate = substr($startdate,0,4);
$enddate = substr($enddate,0,4);

while ($enddate >= $startdate) {
push @all_years, $enddate--;
}

return @all_years;

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

sub backup_vars {
$main::lxdebug->enter_sub();
my $self = shift;
my @vars = @_;

map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;

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

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

my $self = shift;
my @vars = @_;

map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;

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

sub prepare_for_printing {
my ($self) = @_;

my $defaults = SL::DB::Default->get;

$self->{templates} ||= $defaults->templates;
$self->{formname} ||= $self->{type};
$self->{media} ||= 'email';

die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;

# Several fields that used to reside in %::myconfig (stored in
# auth.user_config) are now stored in defaults. Copy them over for
# compatibility.
$self->{$_} = $defaults->$_ for qw(company address taxnumber co_ustid duns sepa_creditor_id);

$self->{"myconfig_${_}"} = $::myconfig{$_} for grep { $_ ne 'dbpasswd' } keys %::myconfig;

if (!$self->{employee_id}) {
$self->{"employee_${_}"} = $::myconfig{$_} for qw(email tel fax name signature);
$self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
}

my $language = $self->{language} ? '_' . $self->{language} : '';

my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
if ($self->{language_id}) {
($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
}

$output_dateformat ||= $::myconfig{dateformat};
$output_numberformat ||= $::myconfig{numberformat};
$output_longdates //= 1;

$self->{myconfig_output_dateformat} = $output_dateformat // $::myconfig{dateformat};
$self->{myconfig_output_longdates} = $output_longdates // 1;
$self->{myconfig_output_numberformat} = $output_numberformat // $::myconfig{numberformat};

# Retrieve accounts for tax calculation.
IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});

if ($self->{type} =~ /_delivery_order$/) {
DO->order_details(\%::myconfig, $self);
} elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order|purchase_quotation_intake/) {
OE->order_details(\%::myconfig, $self);
} else {
IS->invoice_details(\%::myconfig, $self, $::locale);
}

$self->set_addition_billing_address_print_variables;

# Chose extension & set source file name
my $extension = 'html';
if ($self->{format} eq 'postscript') {
$self->{postscript} = 1;
$extension = 'tex';
} elsif ($self->{"format"} =~ /pdf/) {
$self->{pdf} = 1;
$extension = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
} elsif ($self->{"format"} =~ /opendocument/) {
$self->{opendocument} = 1;
$extension = 'odt';
} elsif ($self->{"format"} =~ /excel/) {
$self->{excel} = 1;
$extension = 'xls';
}

my $printer_code = $self->{printer_code} ? '_' . $self->{printer_code} : '';
my $email_extension = $self->{media} eq 'email' && -f ($defaults->templates . "/$self->{formname}_email${language}.${extension}") ? '_email' : '';
$self->{IN} = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";

# Format dates.
$self->format_dates($output_dateformat, $output_longdates,
qw(invdate orddate quodate pldate duedate reqdate transdate tax_point shippingdate deliverydate validitydate paymentdate datepaid
transdate_oe deliverydate_oe employee_startdate employee_enddate),
grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));

$self->reformat_numbers($output_numberformat, 2,
qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));

$self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));

my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');

if (scalar @{ $cvar_date_fields }) {
$self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
}

while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
$self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
}

# Translate units
if (($self->{language} // '') ne '') {
my $template_arrays = $self->{TEMPLATE_ARRAYS} || $self;
for my $idx (0..scalar(@{ $template_arrays->{unit} }) - 1) {
$template_arrays->{unit}->[$idx] = AM->translate_units($self, $self->{language}, $template_arrays->{unit}->[$idx], $template_arrays->{qty}->[$idx])
}
}

$self->{template_meta} = {
formname => $self->{formname},
language => SL::DB::Manager::Language->find_by_or_create(id => $self->{language_id} || undef),
format => $self->{format},
media => $self->{media},
extension => $extension,
printer => SL::DB::Manager::Printer->find_by_or_create(id => $self->{printer_id} || undef),
today => DateTime->today,
};

if ($defaults->print_interpolate_variables_in_positions) {
$self->substitute_placeholders_in_template_arrays({ field => 'description', type => 'text' }, { field => 'longdescription', type => 'html' });
}

return $self;
}

sub set_addition_billing_address_print_variables {
my ($self) = @_;

return if !$self->{billing_address_id};

my $address = SL::DB::Manager::AdditionalBillingAddress->find_by(id => $self->{billing_address_id});
return if !$address;

$self->{"billing_address_${_}"} = $address->$_ for map { $_->name } @{ $address->meta->columns };
}

sub substitute_placeholders_in_template_arrays {
my ($self, @fields) = @_;

foreach my $spec (@fields) {
$spec = { field => $spec, type => 'text' } if !ref($spec);
my $field = $spec->{field};

next unless exists $self->{TEMPLATE_ARRAYS} && exists $self->{TEMPLATE_ARRAYS}->{$field};

my $tag_start = $spec->{type} eq 'html' ? '&lt;%' : '<%';
my $tag_end = $spec->{type} eq 'html' ? '%&gt;' : '%>';
my $formatter = $spec->{type} eq 'html' ? sub { $::locale->quote_special_chars('html', $_[0] // '') } : sub { $_[0] };

$self->{TEMPLATE_ARRAYS}->{$field} = [
apply { s{${tag_start}(.+?)${tag_end}}{ $formatter->($self->{$1}) }eg }
@{ $self->{TEMPLATE_ARRAYS}->{$field} }
];
}

return $self;
}

sub calculate_arap {
my ($self,$buysell,$taxincluded,$exchangerate,$roundplaces) = @_;

# this function is used to calculate netamount, total_tax and amount for AP and
# AR transactions (Kreditoren-/Debitorenbuchungen) by going over all lines
# (1..$rowcount)
# Thus it needs a fully prepared $form to work on.
# calculate_arap assumes $form->{amount_$i} entries still need to be parsed

# The calculated total values are all rounded (default is to 2 places) and
# returned as parameters rather than directly modifying form. The aim is to
# make the calculation of AP and AR behave identically. There is a test-case
# for this function in t/form/arap.t

# While calculating the totals $form->{amount_$i} and $form->{tax_$i} are
# modified and formatted and receive the correct sign for writing straight to
# acc_trans, depending on whether they are ar or ap.

# check parameters
die "taxincluded needed in Form->calculate_arap" unless defined $taxincluded;
die "exchangerate needed in Form->calculate_arap" unless defined $exchangerate;
die 'illegal buysell parameter, has to be \"buy\" or \"sell\" in Form->calculate_arap\n' unless $buysell =~ /^(buy|sell)$/;
$roundplaces = 2 unless $roundplaces;

my $sign = 1; # adjust final results for writing amount to acc_trans
$sign = -1 if $buysell eq 'buy';

my ($netamount,$total_tax,$amount);

my $tax;

# parse and round amounts, setting correct sign for writing to acc_trans
for my $i (1 .. $self->{rowcount}) {
$self->{"amount_$i"} = $self->round_amount($self->parse_amount(\%::myconfig, $self->{"amount_$i"}) * $exchangerate * $sign, $roundplaces);

$amount += $self->{"amount_$i"} * $sign;
}

for my $i (1 .. $self->{rowcount}) {
next unless $self->{"amount_$i"};
($self->{"tax_id_$i"}) = split /--/, $self->{"taxchart_$i"};
my $tax_id = $self->{"tax_id_$i"};

my $selected_tax = SL::DB::Manager::Tax->find_by(id => "$tax_id");

if ( $selected_tax && $selected_tax->taxkey ne '94') {

if ( $buysell eq 'sell' ) {
$self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
} else {
$self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
};

$self->{"taxkey_$i"} = $selected_tax->taxkey;
$self->{"taxrate_$i"} = $selected_tax->rate;
};

$self->{"taxkey_$i"} = $selected_tax->taxkey if $selected_tax->taxkey eq '94';

($self->{"amount_$i"}, $self->{"tax_$i"}) = $self->calculate_tax($self->{"amount_$i"},$self->{"taxrate_$i"},$taxincluded,$roundplaces);

$netamount += $self->{"amount_$i"};
$total_tax += $self->{"tax_$i"};

}
$amount = $netamount + $total_tax;

# due to $sign amount_$i und tax_$i already have the right sign for acc_trans
# but reverse sign of totals for writing amounts to ar
if ( $buysell eq 'buy' ) {
$netamount *= -1;
$amount *= -1;
$total_tax *= -1;
};

return($netamount,$total_tax,$amount);
}

sub format_dates {
my ($self, $dateformat, $longformat, @indices) = @_;

$dateformat ||= $::myconfig{dateformat};

foreach my $idx (@indices) {
if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
$self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
}
}

next unless defined $self->{$idx};

if (!ref($self->{$idx})) {
$self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);

} elsif (ref($self->{$idx}) eq "ARRAY") {
for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
$self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
}
}
}
}

sub reformat_numbers {
my ($self, $numberformat, $places, @indices) = @_;

return if !$numberformat || ($numberformat eq $::myconfig{numberformat});

foreach my $idx (@indices) {
if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
$self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
}
}

next unless defined $self->{$idx};

if (!ref($self->{$idx})) {
$self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});

} elsif (ref($self->{$idx}) eq "ARRAY") {
for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
$self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
}
}
}

my $saved_numberformat = $::myconfig{numberformat};
$::myconfig{numberformat} = $numberformat;

foreach my $idx (@indices) {
if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
$self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
}
}

next unless defined $self->{$idx};

if (!ref($self->{$idx})) {
$self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);

} elsif (ref($self->{$idx}) eq "ARRAY") {
for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
$self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
}
}
}

$::myconfig{numberformat} = $saved_numberformat;
}

sub create_email_signature {
my $client_signature = $::instance_conf->get_signature;
my $user_signature = $::myconfig{signature};

return join '', grep { $_ } ($user_signature, $client_signature);
}

sub calculate_tax {
# this function calculates the net amount and tax for the lines in ar, ap and
# gl and is used for update as well as post. When used with update the return
# value of amount isn't needed

# calculate_tax should always work with positive values, or rather as the user inputs them
# calculate_tax uses db/perl numberformat, i.e. parsed numbers
# convert to negative numbers (when necessary) only when writing to acc_trans
# the amount from $form for ap/ar/gl is currently always rounded to 2 decimals before it reaches here
# for post_transaction amount already contains exchangerate and correct sign and is rounded
# calculate_tax doesn't (need to) know anything about exchangerate

my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_;

$roundplaces //= 2;
$taxincluded //= 0;

my $tax;

if ($taxincluded) {
# calculate tax (unrounded), subtract from amount, round amount and round tax
$tax = $amount - ($amount / ($taxrate + 1)); # equivalent to: taxrate * amount / (taxrate + 1)
$amount = $self->round_amount($amount - $tax, $roundplaces);
$tax = $self->round_amount($tax, $roundplaces);
} else {
$tax = $amount * $taxrate;
$tax = $self->round_amount($tax, $roundplaces);
}

$tax = 0 unless $tax;

return ($amount,$tax);
};

1;

__END__

=head1 NAME

SL::Form.pm - main data object.

=head1 SYNOPSIS

This is the main data object of kivitendo.
Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
Points of interest for a beginner are:

- $form->error - renders a generic error in html. accepts an error message
- $form->get_standard_dbh - returns a database connection for the

=head1 SPECIAL FUNCTIONS

=head2 C<redirect_header> $url

Generates a HTTP redirection header for the new C<$url>. Constructs an
absolute URL including scheme, host name and port. If C<$url> is a
relative URL then it is considered relative to kivitendo base URL.

This function C<die>s if headers have already been created with
C<$::form-E<gt>header>.

Examples:

print $::form->redirect_header('oe.pl?action=edit&id=1234');
print $::form->redirect_header('http://www.lx-office.org/');

=head2 C<header>

Generates a general purpose http/html header and includes most of the scripts
and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.

Only one header will be generated. If the method was already called in this
request it will not output anything and return undef. Also if no
HTTP_USER_AGENT is found, no header is generated.

Although header does not accept parameters itself, it will honor special
hashkeys of its Form instance:

=over 4

=item refresh_time

=item refresh_url

If one of these is set, a http-equiv refresh is generated. Missing parameters
default to 3 seconds and the refering url.

=item stylesheet

Either a scalar or an array ref. Will be inlined into the header. Add
stylesheets with the L<use_stylesheet> function.

=item landscape

If true, a css snippet will be generated that sets the page in landscape mode.

=item favicon

Used to override the default favicon.

=item title

A html page title will be generated from this

=item mtime_ischanged

Tries to avoid concurrent write operations to records by checking the database mtime with a fetched one.

Can be used / called with any table, that has itime and mtime attributes.
Valid C<table> names are: oe, ar, ap, delivery_orders, parts.
Can be called wit C<option> mail to generate a different error message.

Returns undef if no save operation has been done yet ($self->{id} not present).
Returns undef if no concurrent write process is detected otherwise a error message.

=back

=over 4

=item C<check_exchangerate> $myconfig, $currency, $transdate, $fld, $id, $record_table

Needs a local myconfig, a currency string, a date of the transaction, a field (fld) which
has to be either the buy or sell exchangerate and checks if there is already a buy or
sell exchangerate for this date.
Returns 0 or (NULL) if no entry is found or the already stored exchangerate.
If the optional parameter id and record_table is passed, the method tries to look up
a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions.
If none is found the default (daily) entry will be checked.
The method is very strict about the parameters and tries to fail if anything does
not look like the expected type.

=item C<update_exchangerate> $dbh, $curr, $transdate, $buy, $sell, $id, $record_table

Needs a dbh connection, a currency string, a date of the transaction, buy (0|1), sell (0|1) which
determines if either the buy or sell or both exchangerates should be updated and updates
the exchangerate for this currency for this date.
If the optional parameter id and record_table is passed, the method saves
a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions.

The method is very strict about the parameters and tries to fail if anything does not look
like the expected type.




=back

=cut
(30-30/83)