"Form.pm.html#L2209" data-txt="2209">
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->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
my $index = 0;

# store amounts in {acc_trans}{$key} for multiple accounts
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
$ref->{exchangerate} =
$self->get_exchangerate($dbh, $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;

if ($self->{"$self->{vc}_id"}) {

# only setup currency
($self->{currency}) = $self->{defaultcurrency} if !$self->{currency};

} else {

$self->lastname_used($dbh, $myconfig, $table, $module);

# get exchangerate for currency
$self->{exchangerate} =
$self->get_exchangerate($dbh, $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')
# $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')

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/) {
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 ) {

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->{"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

=cut
(30-30/82)