kivitendo/SL/DN.pm @ a422e87f
| 54e4131e | Moritz Bunkus | #======================================================================
|
||
# LX-Office ERP
|
||||
# Copyright (C) 2006
|
||||
# Based on SQL-Ledger Version 2.1.9
|
||||
# Web http://www.lx-office.org
|
||||
#
|
||||
#=====================================================================
|
||||
# SQL-Ledger Accounting
|
||||
# Copyright (C) 1998-2002
|
||||
#
|
||||
# Author: Dieter Simader
|
||||
# Email: dsimader@sql-ledger.org
|
||||
# Web: http://www.sql-ledger.org
|
||||
#
|
||||
# Contributors:
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
| f7b15d43 | Christian Wittmer | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
|
||
# MA 02110-1335, USA.
|
||||
| 54e4131e | Moritz Bunkus | #======================================================================
|
||
#
|
||||
# Dunning process module
|
||||
#
|
||||
#======================================================================
|
||||
package DN;
|
||||
| 7dab0cbd | Moritz Bunkus | use SL::Common;
|
||
use SL::DBUtils;
|
||||
| 29254bae | Jan Büren | use SL::DB::AuthUser;
|
||
| 2e66dde5 | Moritz Bunkus | use SL::DB::Default;
|
||
| a3b8cfa7 | Jan Büren | use SL::DB::Employee;
|
||
| 3431644a | Moritz Bunkus | use SL::GenericTranslations;
|
||
| 232a9153 | Moritz Bunkus | use SL::IS;
|
||
use SL::Mailer;
|
||||
use SL::MoreCommon;
|
||||
use SL::Template;
|
||||
| 20993efb | Sven Schöling | use SL::DB::Printer;
|
||
use SL::DB::Language;
|
||||
| 6887d2fc | Moritz Bunkus | use SL::TransNumber;
|
||
| 88dea78e | Moritz Bunkus | use SL::Util qw(trim);
|
||
| 64a301e5 | Sven Schöling | use SL::DB;
|
||
| 54e4131e | Moritz Bunkus | |||
| a2b43e37 | Jan Büren | use File::Copy;
|
||
| ed944ca3 | Sven Schöling | use strict;
|
||
| 54e4131e | Moritz Bunkus | sub get_config {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
| 64a301e5 | Sven Schöling | my $dbh = SL::DB->client->dbh;
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | my $query =
|
||
qq|SELECT * | .
|
||||
qq|FROM dunning_config | .
|
||||
qq|ORDER BY dunning_level|;
|
||||
$form->{DUNNING} = selectall_hashref_query($form, $dbh, $query);
|
||||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | foreach my $ref (@{ $form->{DUNNING} }) {
|
||
| 54e4131e | Moritz Bunkus | $ref->{fee} = $form->format_amount($myconfig, $ref->{fee}, 2);
|
||
| fd6900cc | Moritz Bunkus | $ref->{interest_rate} = $form->format_amount($myconfig, ($ref->{interest_rate} * 100));
|
||
| 54e4131e | Moritz Bunkus | }
|
||
| 232a9153 | Moritz Bunkus | $query =
|
||
| a3b8cfa7 | Jan Büren | qq|SELECT dunning_ar_amount_fee, dunning_ar_amount_interest, dunning_ar, dunning_creator
|
||
| 232a9153 | Moritz Bunkus | FROM defaults|;
|
||
| a3b8cfa7 | Jan Büren | ($form->{AR_amount_fee}, $form->{AR_amount_interest}, $form->{AR}, $form->{dunning_creator})
|
||
= selectrow_query($form, $dbh, $query);
|
||||
| 232a9153 | Moritz Bunkus | |||
| 54e4131e | Moritz Bunkus | $main::lxdebug->leave_sub();
|
||
}
|
||||
sub save_config {
|
||||
| 64a301e5 | Sven Schöling | my ($self, $myconfig, $form) = @_;
|
||
| 54e4131e | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
| 64a301e5 | Sven Schöling | my $rc = SL::DB->client->with_transaction(\&_save_config, $self, $myconfig, $form);
|
||
$::lxdebug->leave_sub;
|
||||
return $rc;
|
||||
}
|
||||
sub _save_config {
|
||||
| 54e4131e | Moritz Bunkus | my ($self, $myconfig, $form) = @_;
|
||
| 64a301e5 | Sven Schöling | my $dbh = SL::DB->client->dbh;
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | my ($query, @values);
|
||
| 54e4131e | Moritz Bunkus | for my $i (1 .. $form->{rowcount}) {
|
||
$form->{"fee_$i"} = $form->parse_amount($myconfig, $form->{"fee_$i"}) * 1;
|
||||
| fd6900cc | Moritz Bunkus | $form->{"interest_rate_$i"} = $form->parse_amount($myconfig, $form->{"interest_rate_$i"}) / 100;
|
||
| 7dab0cbd | Moritz Bunkus | |||
if (($form->{"dunning_level_$i"} ne "") &&
|
||||
($form->{"dunning_description_$i"} ne "")) {
|
||||
@values = (conv_i($form->{"dunning_level_$i"}), $form->{"dunning_description_$i"},
|
||||
$form->{"email_subject_$i"}, $form->{"email_body_$i"},
|
||||
| fd6900cc | Moritz Bunkus | $form->{"template_$i"}, $form->{"fee_$i"}, $form->{"interest_rate_$i"},
|
||
| 7dab0cbd | Moritz Bunkus | $form->{"active_$i"} ? 't' : 'f', $form->{"auto_$i"} ? 't' : 'f', $form->{"email_$i"} ? 't' : 'f',
|
||
| a6fbe7eb | Moritz Bunkus | $form->{"email_attachment_$i"} ? 't' : 'f', conv_i($form->{"payment_terms_$i"}), conv_i($form->{"terms_$i"}),
|
||
| ed0754c2 | Jan Büren | $form->{"create_invoices_for_fees_$i"} ? 't' : 'f',
|
||
$form->{"print_original_invoice_$i"} ? 't' : 'f');
|
||||
| 54e4131e | Moritz Bunkus | if ($form->{"id_$i"}) {
|
||
| 7dab0cbd | Moritz Bunkus | $query =
|
||
qq|UPDATE dunning_config SET
|
||||
dunning_level = ?, dunning_description = ?,
|
||||
email_subject = ?, email_body = ?,
|
||||
| fd6900cc | Moritz Bunkus | template = ?, fee = ?, interest_rate = ?,
|
||
| 7dab0cbd | Moritz Bunkus | active = ?, auto = ?, email = ?,
|
||
| a6fbe7eb | Moritz Bunkus | email_attachment = ?, payment_terms = ?, terms = ?,
|
||
| ed0754c2 | Jan Büren | create_invoices_for_fees = ?,
|
||
print_original_invoice = ?
|
||||
| 7dab0cbd | Moritz Bunkus | WHERE id = ?|;
|
||
push(@values, conv_i($form->{"id_$i"}));
|
||||
| 54e4131e | Moritz Bunkus | } else {
|
||
| 7dab0cbd | Moritz Bunkus | $query =
|
||
qq|INSERT INTO dunning_config
|
||||
(dunning_level, dunning_description, email_subject, email_body,
|
||||
| fd6900cc | Moritz Bunkus | template, fee, interest_rate, active, auto, email,
|
||
| ed0754c2 | Jan Büren | email_attachment, payment_terms, terms, create_invoices_for_fees,
|
||
print_original_invoice)
|
||||
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
|
||||
| 54e4131e | Moritz Bunkus | }
|
||
| 7dab0cbd | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
| 54e4131e | Moritz Bunkus | }
|
||
| 7dab0cbd | Moritz Bunkus | |||
| 54e4131e | Moritz Bunkus | if (($form->{"dunning_description_$i"} eq "") && ($form->{"id_$i"})) {
|
||
| 7dab0cbd | Moritz Bunkus | $query = qq|DELETE FROM dunning_config WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{"id_$i"});
|
||||
| 54e4131e | Moritz Bunkus | }
|
||
}
|
||||
| a3b8cfa7 | Jan Büren | $query = qq|UPDATE defaults SET dunning_ar_amount_fee = ?, dunning_ar_amount_interest = ?, dunning_ar = ?,
|
||
dunning_creator = ?|;
|
||||
@values = (conv_i($form->{AR_amount_fee}), conv_i($form->{AR_amount_interest}), conv_i($form->{AR}),
|
||||
$form->{dunning_creator});
|
||||
| 232a9153 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
| 64a301e5 | Sven Schöling | return 1;
|
||
| 232a9153 | Moritz Bunkus | }
|
||
sub create_invoice_for_fees {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $dbh, $dunning_id) = @_;
|
||||
my ($query, @values, $sth, $ref);
|
||||
| a6fbe7eb | Moritz Bunkus | $query = qq|SELECT dcfg.create_invoices_for_fees
|
||
FROM dunning d
|
||||
LEFT JOIN dunning_config dcfg ON (d.dunning_config_id = dcfg.id)
|
||||
WHERE d.dunning_id = ?|;
|
||||
my ($create_invoices_for_fees) = selectrow_query($form, $dbh, $query, $dunning_id);
|
||||
| 232a9153 | Moritz Bunkus | |||
| a6fbe7eb | Moritz Bunkus | if (!$create_invoices_for_fees) {
|
||
| 232a9153 | Moritz Bunkus | $main::lxdebug->leave_sub();
|
||
return;
|
||||
}
|
||||
| a6fbe7eb | Moritz Bunkus | $query = qq|SELECT dunning_ar_amount_fee, dunning_ar_amount_interest, dunning_ar FROM defaults|;
|
||
($form->{AR_amount_fee}, $form->{AR_amount_interest}, $form->{AR}) = selectrow_query($form, $dbh, $query);
|
||||
| 232a9153 | Moritz Bunkus | $query =
|
||
qq|SELECT
|
||||
fee,
|
||||
COALESCE((
|
||||
SELECT MAX(d_fee.fee)
|
||||
FROM dunning d_fee
|
||||
WHERE (d_fee.trans_id = d.trans_id)
|
||||
AND (d_fee.dunning_id <> ?)
|
||||
AND NOT (d_fee.fee_interest_ar_id ISNULL)
|
||||
), 0)
|
||||
AS max_previous_fee,
|
||||
interest,
|
||||
COALESCE((
|
||||
SELECT MAX(d_interest.interest)
|
||||
FROM dunning d_interest
|
||||
WHERE (d_interest.trans_id = d.trans_id)
|
||||
AND (d_interest.dunning_id <> ?)
|
||||
AND NOT (d_interest.fee_interest_ar_id ISNULL)
|
||||
), 0)
|
||||
| ad4bebf4 | Felix Eichler | AS max_previous_interest,
|
||
d.id AS link_id
|
||||
| 232a9153 | Moritz Bunkus | FROM dunning d
|
||
WHERE dunning_id = ?|;
|
||||
@values = ($dunning_id, $dunning_id, $dunning_id);
|
||||
$sth = prepare_execute_query($form, $dbh, $query, @values);
|
||||
my ($fee_remaining, $interest_remaining) = (0, 0);
|
||||
my ($fee_total, $interest_total) = (0, 0);
|
||||
| ad4bebf4 | Felix Eichler | my @link_ids;
|
||
| 232a9153 | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref()) {
|
||
$fee_remaining += $form->round_amount($ref->{fee}, 2);
|
||||
$fee_remaining -= $form->round_amount($ref->{max_previous_fee}, 2);
|
||||
$fee_total += $form->round_amount($ref->{fee}, 2);
|
||||
$interest_remaining += $form->round_amount($ref->{interest}, 2);
|
||||
$interest_remaining -= $form->round_amount($ref->{max_previous_interest}, 2);
|
||||
$interest_total += $form->round_amount($ref->{interest}, 2);
|
||||
| ad4bebf4 | Felix Eichler | push @link_ids, $ref->{link_id};
|
||
| 232a9153 | Moritz Bunkus | }
|
||
$sth->finish();
|
||||
my $amount = $fee_remaining + $interest_remaining;
|
||||
if (!$amount) {
|
||||
$main::lxdebug->leave_sub();
|
||||
return;
|
||||
}
|
||||
my ($ar_id) = selectrow_query($form, $dbh, qq|SELECT nextval('glid')|);
|
||||
| b4a36c72 | Philip Reetz | my $curr = $form->get_default_currency($myconfig);
|
||
| 6887d2fc | Moritz Bunkus | my $trans_number = SL::TransNumber->new(type => 'invoice', dbh => $dbh);
|
||
| 232a9153 | Moritz Bunkus | |||
$query =
|
||||
qq|INSERT INTO ar (id, invnumber, transdate, gldate, customer_id,
|
||||
taxincluded, amount, netamount, paid, duedate,
|
||||
| afe7df8b | Bernd Bleßmann | invoice, currency_id, taxzone_id, notes,
|
||
| 232a9153 | Moritz Bunkus | employee_id)
|
||
VALUES (
|
||||
?, -- id
|
||||
?, -- invnumber
|
||||
current_date, -- transdate
|
||||
current_date, -- gldate
|
||||
-- customer_id:
|
||||
(SELECT ar.customer_id
|
||||
FROM dunning dn
|
||||
LEFT JOIN ar ON (dn.trans_id = ar.id)
|
||||
WHERE dn.dunning_id = ?
|
||||
LIMIT 1),
|
||||
'f', -- taxincluded
|
||||
?, -- amount
|
||||
?, -- netamount
|
||||
0, -- paid
|
||||
-- duedate:
|
||||
| b4a36c72 | Philip Reetz | (SELECT duedate FROM dunning WHERE dunning_id = ? LIMIT 1),
|
||
| 232a9153 | Moritz Bunkus | 'f', -- invoice
|
||
| a4d74009 | Niclas Zimmermann | (SELECT id FROM currencies WHERE name = ?), -- curr
|
||
| afe7df8b | Bernd Bleßmann | --taxzone_id:
|
||
(SELECT taxzone_id FROM customer WHERE id =
|
||||
(SELECT ar.customer_id
|
||||
FROM dunning dn
|
||||
LEFT JOIN ar ON (dn.trans_id = ar.id)
|
||||
WHERE dn.dunning_id = ?
|
||||
LIMIT 1)
|
||||
),
|
||||
| 232a9153 | Moritz Bunkus | ?, -- notes
|
||
-- employee_id:
|
||||
(SELECT id FROM employee WHERE login = ?)
|
||||
)|;
|
||||
@values = ($ar_id, # id
|
||||
| 6887d2fc | Moritz Bunkus | $trans_number->create_unique, # invnumber
|
||
| 232a9153 | Moritz Bunkus | $dunning_id, # customer_id
|
||
$amount,
|
||||
$amount,
|
||||
$dunning_id, # duedate
|
||||
| b4a36c72 | Philip Reetz | $curr, # default currency
|
||
| afe7df8b | Bernd Bleßmann | $dunning_id, # taxzone_id
|
||
| 232a9153 | Moritz Bunkus | sprintf($main::locale->text('Automatically created invoice for fee and interest for dunning %s'), $dunning_id), # notes
|
||
| 4bd1e2f8 | Sven Schöling | $::myconfig{login}); # employee_id
|
||
| 232a9153 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
| ad4bebf4 | Felix Eichler | RecordLinks->create_links(
|
||
'dbh' => $dbh,
|
||||
'mode' => 'ids',
|
||||
'from_table' => 'dunning',
|
||||
'from_ids' => \@link_ids,
|
||||
'to_table' => 'ar',
|
||||
'to_id' => $ar_id,
|
||||
);
|
||||
| 232a9153 | Moritz Bunkus | $query =
|
||
| 1fba275d | Moritz Bunkus | qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, gldate, taxkey, tax_id, chart_link)
|
||
VALUES (?, ?, ?, current_date, current_date, 0,
|
||||
(SELECT id FROM tax WHERE (taxkey = 0) AND (rate = 0)),
|
||||
(SELECT link FROM chart WHERE id = ?))|;
|
||||
| 232a9153 | Moritz Bunkus | $sth = prepare_query($form, $dbh, $query);
|
||
| 1fba275d | Moritz Bunkus | @values = ($ar_id, conv_i($form->{AR_amount_fee}), $fee_remaining, conv_i($form->{AR_amount_fee}));
|
||
| 232a9153 | Moritz Bunkus | do_statement($form, $sth, $query, @values);
|
||
if ($interest_remaining) {
|
||||
| 1fba275d | Moritz Bunkus | @values = ($ar_id, conv_i($form->{AR_amount_interest}), $interest_remaining, conv_i($form->{AR_amount_interest}));
|
||
| 232a9153 | Moritz Bunkus | do_statement($form, $sth, $query, @values);
|
||
}
|
||||
| 1fba275d | Moritz Bunkus | @values = ($ar_id, conv_i($form->{AR}), -1 * $amount, conv_i($form->{AR}));
|
||
| 232a9153 | Moritz Bunkus | do_statement($form, $sth, $query, @values);
|
||
$sth->finish();
|
||||
$query = qq|UPDATE dunning SET fee_interest_ar_id = ? WHERE dunning_id = ?|;
|
||||
do_query($form, $dbh, $query, $ar_id, $dunning_id);
|
||||
| 54e4131e | Moritz Bunkus | |||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
| 64a301e5 | Sven Schöling | |||
| 54e4131e | Moritz Bunkus | sub save_dunning {
|
||
| 64a301e5 | Sven Schöling | my ($self, $myconfig, $form, $rows) = @_;
|
||
| 54e4131e | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
| 64a301e5 | Sven Schöling | my $rc = SL::DB->client->with_transaction(\&_save_dunning, $self, $myconfig, $form, $rows);
|
||
| d8cbaf14 | Sven Schöling | |||
if (!$rc) {
|
||||
die SL::DB->client->error
|
||||
}
|
||||
| 64a301e5 | Sven Schöling | $::lxdebug->leave_sub;
|
||
return $rc;
|
||||
}
|
||||
sub _save_dunning {
|
||||
| 8cd05ad6 | Moritz Bunkus | my ($self, $myconfig, $form, $rows) = @_;
|
||
| 64a301e5 | Sven Schöling | |||
my $dbh = SL::DB->client->dbh;
|
||||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | my ($query, @values);
|
||
| 840aea13 | Moritz Bunkus | my ($dunning_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
|
||
| fd6900cc | Moritz Bunkus | my $q_update_ar = qq|UPDATE ar SET dunning_config_id = ? WHERE id = ?|;
|
||
my $h_update_ar = prepare_query($form, $dbh, $q_update_ar);
|
||||
my $q_insert_dunning =
|
||||
| ad4bebf4 | Felix Eichler | qq|INSERT INTO dunning (id, dunning_id, dunning_config_id, dunning_level, trans_id,
|
||
fee, interest, transdate, duedate)
|
||||
VALUES (?, ?, ?,
|
||||
| fd6900cc | Moritz Bunkus | (SELECT dunning_level FROM dunning_config WHERE id = ?),
|
||
?,
|
||||
(SELECT SUM(fee)
|
||||
FROM dunning_config
|
||||
WHERE dunning_level <= (SELECT dunning_level FROM dunning_config WHERE id = ?)),
|
||||
| 14949630 | Joachim Zach | (SELECT (amount - paid) * (current_date - duedate) FROM ar WHERE id = ?)
|
||
| fd6900cc | Moritz Bunkus | * (SELECT interest_rate FROM dunning_config WHERE id = ?)
|
||
/ 360,
|
||||
current_date,
|
||||
current_date + (SELECT payment_terms FROM dunning_config WHERE id = ?))|;
|
||||
my $h_insert_dunning = prepare_query($form, $dbh, $q_insert_dunning);
|
||||
my @invoice_ids;
|
||||
my ($next_dunning_config_id, $customer_id);
|
||||
| a2b43e37 | Jan Büren | my ($send_email, $print_invoice) = (0, 0);
|
||
| fd6900cc | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | foreach my $row (@{ $rows }) {
|
||
| 915cb1a4 | Jan Büren | if ($row->{credit_note}) {
|
||
my $i = $row->{row};
|
||||
%{ $form->{LIST_CREDIT_NOTES}{$row->{customer_id}}{$row->{invoice_id}} } = (
|
||||
open_amount => $form->{"open_amount_$i"},
|
||||
amount => $form->{"amount_$i"},
|
||||
invnumber => $form->{"invnumber_$i"},
|
||||
invdate => $form->{"invdate_$i"},
|
||||
);
|
||||
next;
|
||||
}
|
||||
| fd6900cc | Moritz Bunkus | push @invoice_ids, $row->{invoice_id};
|
||
$next_dunning_config_id = $row->{next_dunning_config_id};
|
||||
$customer_id = $row->{customer_id};
|
||||
@values = ($row->{next_dunning_config_id}, $row->{invoice_id});
|
||||
do_statement($form, $h_update_ar, $q_update_ar, @values);
|
||||
| a2b43e37 | Jan Büren | $send_email |= $row->{email};
|
||
$print_invoice |= $row->{print_invoice};
|
||||
| 7dab0cbd | Moritz Bunkus | |||
| ad4bebf4 | Felix Eichler | my ($row_id) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|);
|
||
| fd6900cc | Moritz Bunkus | my $next_config_id = conv_i($row->{next_dunning_config_id});
|
||
my $invoice_id = conv_i($row->{invoice_id});
|
||||
| ad4bebf4 | Felix Eichler | @values = ($row_id, $dunning_id, $next_config_id,
|
||
$next_config_id, $invoice_id, $next_config_id,
|
||||
$invoice_id, $next_config_id, $next_config_id);
|
||||
| fd6900cc | Moritz Bunkus | do_statement($form, $h_insert_dunning, $q_insert_dunning, @values);
|
||
| ad4bebf4 | Felix Eichler | |||
RecordLinks->create_links(
|
||||
'dbh' => $dbh,
|
||||
'mode' => 'ids',
|
||||
'from_table' => 'ar',
|
||||
'from_ids' => $invoice_id,
|
||||
'to_table' => 'dunning',
|
||||
'to_id' => $row_id,
|
||||
);
|
||||
| 54e4131e | Moritz Bunkus | }
|
||
| 915cb1a4 | Jan Büren | # die this transaction, because for this customer only credit notes are
|
||
# selected ...
|
||||
return unless $customer_id;
|
||||
| 54e4131e | Moritz Bunkus | |||
| fd6900cc | Moritz Bunkus | $h_update_ar->finish();
|
||
$h_insert_dunning->finish();
|
||||
| 232a9153 | Moritz Bunkus | $form->{DUNNING_PDFS_EMAIL} = [];
|
||
| 2e0c8941 | Bernd Bleßmann | $form->{dunning_id} = $dunning_id;
|
||
| 232a9153 | Moritz Bunkus | $self->create_invoice_for_fees($myconfig, $form, $dbh, $dunning_id);
|
||
$self->print_invoice_for_fees($myconfig, $form, $dunning_id, $dbh);
|
||||
$self->print_dunning($myconfig, $form, $dunning_id, $dbh);
|
||||
| a2b43e37 | Jan Büren | if ($print_invoice) {
|
||
$self->print_original_invoices($myconfig, $form, $_, $dbh) for @invoice_ids;
|
||||
}
|
||||
| 232a9153 | Moritz Bunkus | |||
if ($send_email) {
|
||||
$self->send_email($myconfig, $form, $dunning_id, $dbh);
|
||||
}
|
||||
| 64a301e5 | Sven Schöling | return 1;
|
||
| 232a9153 | Moritz Bunkus | }
|
||
sub send_email {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $dunning_id, $dbh) = @_;
|
||||
| 7dab0cbd | Moritz Bunkus | my $query =
|
||
| fd6900cc | Moritz Bunkus | qq|SELECT
|
||
| 232a9153 | Moritz Bunkus | dcfg.email_body, dcfg.email_subject, dcfg.email_attachment,
|
||
| 29254bae | Jan Büren | COALESCE (NULLIF(c.invoice_mail, ''), c.email) AS recipient, c.name,
|
||
(SELECT login from employee where id = ar.employee_id) as invoice_employee_login
|
||||
| 232a9153 | Moritz Bunkus | FROM dunning d
|
||
LEFT JOIN dunning_config dcfg ON (d.dunning_config_id = dcfg.id)
|
||||
LEFT JOIN ar ON (d.trans_id = ar.id)
|
||||
LEFT JOIN customer c ON (ar.customer_id = c.id)
|
||||
WHERE (d.dunning_id = ?)
|
||||
LIMIT 1|;
|
||||
my $ref = selectfirst_hashref_query($form, $dbh, $query, $dunning_id);
|
||||
| fd6900cc | Moritz Bunkus | |||
| 29254bae | Jan Büren | # without a recipient, we cannot send a mail
|
||
if (!$ref || !$ref->{recipient}) {
|
||||
| 232a9153 | Moritz Bunkus | $main::lxdebug->leave_sub();
|
||
| d0ebc498 | Jan Büren | die $main::locale->text("No email recipient for customer #1 defined.", $ref->{name});
|
||
| 29254bae | Jan Büren | }
|
||
# without a sender we cannot send a mail
|
||||
# two cases: check mail from 1. current user OR 2. employee who created the invoice
|
||||
| d0ebc498 | Jan Büren | my ($from, $sign);
|
||
| 29254bae | Jan Büren | if ($::instance_conf->get_dunning_creator eq 'current_employee') {
|
||
$from = $myconfig->{email};
|
||||
| d0ebc498 | Jan Büren | die $main::locale->text('No email for current user #1 defined.', $myconfig->{name}) unless $from;
|
||
| 29254bae | Jan Büren | } else {
|
||
eval {
|
||||
$from = SL::DB::Manager::AuthUser->find_by(login => $ref->{invoice_employee_login})->get_config_value("email");
|
||||
| d0ebc498 | Jan Büren | $sign = SL::DB::Manager::AuthUser->find_by(login => $ref->{invoice_employee_login})->get_config_value("signature");
|
||
die unless ($from);
|
||||
| 29254bae | Jan Büren | 1;
|
||
| d0ebc498 | Jan Büren | } or die $main::locale->text('No email for user with login #1 defined.', $ref->{invoice_employee_login});
|
||
| 54e4131e | Moritz Bunkus | }
|
||
| 0fba3edd | Moritz Bunkus | my $template = SL::Template::create(type => 'PlainText', form => $form, myconfig => $myconfig);
|
||
| 232a9153 | Moritz Bunkus | my $mail = Mailer->new();
|
||
| 2e2ac4ba | Martin Helmling | $mail->{bcc} = $form->get_bcc_defaults($myconfig, $form->{bcc});
|
||
| 29254bae | Jan Büren | $mail->{from} = $from;
|
||
| 232a9153 | Moritz Bunkus | $mail->{to} = $ref->{recipient};
|
||
$mail->{subject} = $template->parse_block($ref->{email_subject});
|
||||
$mail->{message} = $template->parse_block($ref->{email_body});
|
||||
| d0ebc498 | Jan Büren | my $sign_backup = $::myconfig{signature};
|
||
$::myconfig{signature} = $sign if $sign;
|
||||
| 718f7a1b | Geoffrey Richardson | $mail->{message} .= $form->create_email_signature();
|
||
| d0ebc498 | Jan Büren | $::myconfig{signature} = $sign_backup if $sign;
|
||
| fd6900cc | Moritz Bunkus | |||
| 232a9153 | Moritz Bunkus | $mail->{message} =~ s/\r\n/\n/g;
|
||
if ($ref->{email_attachment} && @{ $form->{DUNNING_PDFS_EMAIL} }) {
|
||||
$mail->{attachments} = $form->{DUNNING_PDFS_EMAIL};
|
||||
}
|
||||
$mail->send();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub set_template_options {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
| fd6900cc | Moritz Bunkus | |||
| 2e66dde5 | Moritz Bunkus | my $defaults = SL::DB::Default->get;
|
||
$form->error($::locale->text('No print templates have been created for this client yet. Please do so in the client configuration.')) if !$defaults->templates;
|
||||
$form->{templates} = $defaults->templates;
|
||||
| 232a9153 | Moritz Bunkus | $form->{language} = $form->get_template_language($myconfig);
|
||
$form->{printer_code} = $form->get_printer_code($myconfig);
|
||||
| 54e4131e | Moritz Bunkus | |||
if ($form->{language} ne "") {
|
||||
$form->{language} = "_" . $form->{language};
|
||||
}
|
||||
if ($form->{printer_code} ne "") {
|
||||
$form->{printer_code} = "_" . $form->{printer_code};
|
||||
}
|
||||
| 20993efb | Sven Schöling | my $extension = 'html';
|
||
if ($form->{format} eq 'postscript') {
|
||||
$form->{postscript} = 1;
|
||||
$extension = 'tex';
|
||||
} elsif ($form->{"format"} =~ /pdf/) {
|
||||
$form->{pdf} = 1;
|
||||
$extension = $form->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
|
||||
} elsif ($form->{"format"} =~ /opendocument/) {
|
||||
$form->{opendocument} = 1;
|
||||
$extension = 'odt';
|
||||
} elsif ($form->{"format"} =~ /excel/) {
|
||||
$form->{excel} = 1;
|
||||
$extension = 'xls';
|
||||
}
|
||||
| 54e4131e | Moritz Bunkus | |||
| 20993efb | Sven Schöling | # search for the template
|
||
my @template_files;
|
||||
push @template_files, "$form->{formname}_email$form->{language}$form->{printer_code}.$extension" if $form->{media} eq 'email';
|
||||
push @template_files, "$form->{formname}$form->{language}$form->{printer_code}.$extension";
|
||||
push @template_files, "$form->{formname}.$extension";
|
||||
push @template_files, "default.$extension";
|
||||
$form->{IN} = undef;
|
||||
for my $filename (@template_files) {
|
||||
| 2e66dde5 | Moritz Bunkus | if (-f ($defaults->templates . "/$filename")) {
|
||
| 20993efb | Sven Schöling | $form->{IN} = $filename;
|
||
last;
|
||||
}
|
||||
| 54e4131e | Moritz Bunkus | }
|
||
| 7dab0cbd | Moritz Bunkus | |||
| 20993efb | Sven Schöling | if (!defined $form->{IN}) {
|
||
$::form->error($::locale->text('Cannot find matching template for this print request. Please contact your template maintainer. I tried these: #1.', join ', ', map { "'$_'"} @template_files));
|
||||
}
|
||||
# prepare meta information for template introspection
|
||||
$form->{template_meta} = {
|
||||
formname => $form->{formname},
|
||||
| 1d327692 | Sven Schöling | language => SL::DB::Manager::Language->find_by_or_create(id => $form->{language_id} || undef),
|
||
| 20993efb | Sven Schöling | format => $form->{format},
|
||
media => $form->{media},
|
||||
extension => $extension,
|
||||
| 1d327692 | Sven Schöling | printer => SL::DB::Manager::Printer->find_by_or_create(id => $form->{printer_id} || undef),
|
||
| 20993efb | Sven Schöling | today => DateTime->today,
|
||
};
|
||||
| 54e4131e | Moritz Bunkus | $main::lxdebug->leave_sub();
|
||
}
|
||||
sub get_invoices {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
| 64a301e5 | Sven Schöling | my $dbh = SL::DB->client->dbh;
|
||
| 54e4131e | Moritz Bunkus | |||
| fd6900cc | Moritz Bunkus | my $where;
|
||
| 7dab0cbd | Moritz Bunkus | my @values;
|
||
$form->{customer_id} = $1 if ($form->{customer} =~ /--(\d+)$/);
|
||||
if ($form->{customer_id}) {
|
||||
$where .= qq| AND (a.customer_id = ?)|;
|
||||
push(@values, $form->{customer_id});
|
||||
} elsif ($form->{customer}) {
|
||||
$where .= qq| AND (ct.name ILIKE ?)|;
|
||||
| bc40bcab | Moritz Bunkus | push(@values, like($form->{customer}));
|
||
| 54e4131e | Moritz Bunkus | }
|
||
| 4aa9760e | Geoffrey Richardson | if ($form->{department_id}) {
|
||
$where .= qq| AND (a.department_id = ?)|;
|
||||
push(@values, $form->{department_id});
|
||||
}
|
||||
| 7dab0cbd | Moritz Bunkus | my %columns = (
|
||
"ordnumber" => "a.ordnumber",
|
||||
"invnumber" => "a.invnumber",
|
||||
| 431181fc | Moritz Bunkus | "notes" => "a.notes",
|
||
| 51323d9a | Jan Büren | "country" => "ct.country",
|
||
| 7dab0cbd | Moritz Bunkus | );
|
||
foreach my $key (keys(%columns)) {
|
||||
next unless ($form->{$key});
|
||||
$where .= qq| AND $columns{$key} ILIKE ?|;
|
||||
| bc40bcab | Moritz Bunkus | push(@values, like($form->{$key}));
|
||
| 7dab0cbd | Moritz Bunkus | }
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | if ($form->{dunning_level}) {
|
||
| 431181fc | Moritz Bunkus | $where .= qq| AND nextcfg.id = ?|;
|
||
| 7dab0cbd | Moritz Bunkus | push(@values, conv_i($form->{dunning_level}));
|
||
}
|
||||
| 54e4131e | Moritz Bunkus | |||
$form->{minamount} = $form->parse_amount($myconfig,$form->{minamount});
|
||||
| 7dab0cbd | Moritz Bunkus | if ($form->{minamount}) {
|
||
$where .= qq| AND ((a.amount - a.paid) > ?) |;
|
||||
| 88dea78e | Moritz Bunkus | push(@values, trim($form->{minamount}));
|
||
| 7dab0cbd | Moritz Bunkus | }
|
||
| 54e4131e | Moritz Bunkus | |||
| 8e08bedb | Sven Schöling | my $query =
|
||
| 5d92bf35 | Moritz Bunkus | qq|SELECT id
|
||
FROM dunning_config
|
||||
WHERE dunning_level = (SELECT MAX(dunning_level) FROM dunning_config)|;
|
||||
my ($id_for_max_dunning_level) = selectrow_query($form, $dbh, $query);
|
||||
| d6a21120 | Moritz Bunkus | if (!$form->{l_include_direct_debit}) {
|
||
$where .= qq| AND NOT COALESCE(a.direct_debit, FALSE) |;
|
||||
}
|
||||
| 915cb1a4 | Jan Büren | my $paid = ($form->{l_include_credit_notes}) ? "WHERE (a.paid <> a.amount)" : "WHERE (a.paid < a.amount)";
|
||
| d6a21120 | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | $query =
|
||
| fd6900cc | Moritz Bunkus | qq|SELECT
|
||
| 78c8e7ac | Moritz Bunkus | a.id, a.invoice, a.ordnumber, a.transdate, a.invnumber, a.amount, a.language_id,
|
||
| 7dab0cbd | Moritz Bunkus | ct.name AS customername, a.customer_id, a.duedate,
|
||
| 7fe03300 | Moritz Bunkus | a.amount - a.paid AS open_amount,
|
||
| d6a21120 | Moritz Bunkus | a.direct_debit,
|
||
| 4aa9760e | Geoffrey Richardson | dep.description as departmentname,
|
||
| fd6900cc | Moritz Bunkus | |||
cfg.dunning_description, cfg.dunning_level,
|
||||
d.transdate AS dunning_date, d.duedate AS dunning_duedate,
|
||||
d.fee, d.interest,
|
||||
a.duedate + cfg.terms - current_date AS nextlevel,
|
||||
current_date - COALESCE(d.duedate, a.duedate) AS pastdue,
|
||||
current_date + cfg.payment_terms AS next_duedate,
|
||||
nextcfg.dunning_description AS next_dunning_description,
|
||||
nextcfg.id AS next_dunning_config_id,
|
||||
| ed0754c2 | Jan Büren | nextcfg.terms, nextcfg.active, nextcfg.email, nextcfg.print_original_invoice
|
||
| fd6900cc | Moritz Bunkus | |||
FROM ar a
|
||||
LEFT JOIN customer ct ON (a.customer_id = ct.id)
|
||||
| 4aa9760e | Geoffrey Richardson | LEFT JOIN department dep ON (a.department_id = dep.id)
|
||
| fd6900cc | Moritz Bunkus | LEFT JOIN dunning_config cfg ON (a.dunning_config_id = cfg.id)
|
||
LEFT JOIN dunning_config nextcfg ON
|
||||
(nextcfg.id =
|
||||
| 5d92bf35 | Moritz Bunkus | COALESCE(
|
||
(SELECT id
|
||||
FROM dunning_config
|
||||
WHERE dunning_level >
|
||||
COALESCE((SELECT dunning_level
|
||||
FROM dunning_config
|
||||
WHERE id = a.dunning_config_id
|
||||
ORDER BY dunning_level DESC
|
||||
LIMIT 1),
|
||||
0)
|
||||
ORDER BY dunning_level ASC
|
||||
LIMIT 1)
|
||||
, ?))
|
||||
| e7bb715f | Moritz Bunkus | LEFT JOIN dunning d ON (d.id = (
|
||
SELECT MAX(d2.id)
|
||||
FROM dunning d2
|
||||
WHERE (d2.trans_id = a.id)
|
||||
AND (d2.dunning_level = cfg.dunning_level)
|
||||
))
|
||||
| 915cb1a4 | Jan Büren | $paid
|
||
AND (a.duedate < current_date)
|
||||
| fd6900cc | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | $where
|
||
| fd6900cc | Moritz Bunkus | ORDER BY a.id, transdate, duedate, name|;
|
||
| 5d92bf35 | Moritz Bunkus | my $sth = prepare_execute_query($form, $dbh, $query, $id_for_max_dunning_level, @values);
|
||
| 7dab0cbd | Moritz Bunkus | |||
$form->{DUNNINGS} = [];
|
||||
| 54e4131e | Moritz Bunkus | |||
| 8e08bedb | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
| 1d089d50 | Moritz Bunkus | next if ($ref->{pastdue} < $ref->{terms});
|
||
| 915cb1a4 | Jan Büren | $ref->{credit_note} = 1 if ($ref->{amount} < 0 && $form->{l_include_credit_notes});
|
||
| 7dab0cbd | Moritz Bunkus | $ref->{interest} = $form->round_amount($ref->{interest}, 2);
|
||
| fd6900cc | Moritz Bunkus | push(@{ $form->{DUNNINGS} }, $ref);
|
||
| 54e4131e | Moritz Bunkus | }
|
||
$sth->finish;
|
||||
| 7dab0cbd | Moritz Bunkus | $query = qq|SELECT id, dunning_description FROM dunning_config ORDER BY dunning_level|;
|
||
$form->{DUNNING_CONFIG} = selectall_hashref_query($form, $dbh, $query);
|
||||
| 54e4131e | Moritz Bunkus | |||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_dunning {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
| 64a301e5 | Sven Schöling | my $dbh = SL::DB->client->dbh;
|
||
| 54e4131e | Moritz Bunkus | |||
| 8e08bedb | Sven Schöling | my $where = qq| WHERE (da.trans_id = a.id)|;
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | my @values;
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | if ($form->{customer_id}) {
|
||
$where .= qq| AND (a.customer_id = ?)|;
|
||||
push(@values, $form->{customer_id});
|
||||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | } elsif ($form->{customer}) {
|
||
$where .= qq| AND (ct.name ILIKE ?)|;
|
||||
| bc40bcab | Moritz Bunkus | push(@values, like($form->{customer}));
|
||
| 7dab0cbd | Moritz Bunkus | }
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | my %columns = (
|
||
"ordnumber" => "a.ordnumber",
|
||||
"invnumber" => "a.invnumber",
|
||||
"notes" => "a.notes",
|
||||
);
|
||||
foreach my $key (keys(%columns)) {
|
||||
next unless ($form->{$key});
|
||||
$where .= qq| AND $columns{$key} ILIKE ?|;
|
||||
| bc40bcab | Moritz Bunkus | push(@values, like($form->{$key}));
|
||
| 7dab0cbd | Moritz Bunkus | }
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | if ($form->{dunning_level}) {
|
||
| 840aea13 | Moritz Bunkus | $where .= qq| AND a.dunning_config_id = ?|;
|
||
| 7dab0cbd | Moritz Bunkus | push(@values, conv_i($form->{dunning_level}));
|
||
}
|
||||
| 54e4131e | Moritz Bunkus | |||
| 2c5603bb | Moritz Bunkus | if ($form->{department_id}) {
|
||
$where .= qq| AND a.department_id = ?|;
|
||||
push @values, conv_i($form->{department_id});
|
||||
}
|
||||
$form->{minamount} = $form->parse_amount($myconfig, $form->{minamount});
|
||||
| 7dab0cbd | Moritz Bunkus | if ($form->{minamount}) {
|
||
$where .= qq| AND ((a.amount - a.paid) > ?) |;
|
||||
push(@values, $form->{minamount});
|
||||
}
|
||||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | if (!$form->{showold}) {
|
||
| 840aea13 | Moritz Bunkus | $where .= qq| AND (a.amount > a.paid) AND (da.dunning_config_id = a.dunning_config_id) |;
|
||
| 7dab0cbd | Moritz Bunkus | }
|
||
| 54e4131e | Moritz Bunkus | |||
| 7dab0cbd | Moritz Bunkus | if ($form->{transdatefrom}) {
|
||
$where .= qq| AND a.transdate >= ?|;
|
||||
push(@values, $form->{transdatefrom});
|
||||
}
|
||||
if ($form->{transdateto}) {
|
||||
$where .= qq| AND a.transdate <= ?|;
|
||||
push(@values, $form->{transdateto});
|
||||
}
|
||||
if ($form->{dunningfrom}) {
|
||||
$where .= qq| AND da.transdate >= ?|;
|
||||
push(@values, $form->{dunningfrom});
|
||||
}
|
||||
if ($form->{dunningto}) {
|
||||
$where .= qq| AND da.transdate >= ?|;
|
||||
push(@values, $form->{dunningto});
|
||||
}
|
||||
| 54e4131e | Moritz Bunkus | |||
| 8145351d | David Ohlbrecht | if ($form->{salesman_id}) {
|
||
$where .= qq| AND a.salesman_id = ?|;
|
||||
push(@values, conv_i($form->{salesman_id}));
|
||||
}
|
||||
| dde9d68d | Moritz Bunkus | my %sort_columns = (
|
||
'dunning_description' => [ qw(dn.dunning_description customername invnumber) ],
|
||||
'customername' => [ qw(customername invnumber) ],
|
||||
'invnumber' => [ qw(a.invnumber) ],
|
||||
'transdate' => [ qw(a.transdate a.invnumber) ],
|
||||
'duedate' => [ qw(a.duedate a.invnumber) ],
|
||||
'dunning_date' => [ qw(dunning_date a.invnumber) ],
|
||||
'dunning_duedate' => [ qw(dunning_duedate a.invnumber) ],
|
||||
| edd7f7c0 | David Ohlbrecht | 'salesman' => [ qw(salesman) ],
|
||
| dde9d68d | Moritz Bunkus | );
|
||
my $sortdir = !defined $form->{sortdir} ? 'ASC' : $form->{sortdir} ? 'ASC' : 'DESC';
|
||||
my $sortkey = $sort_columns{$form->{sort}} ? $form->{sort} : 'customername';
|
||||
| a3403ac5 | Bernd Bleßmann | my $sortorder = join ', ', map { "$_ $sortdir" } (@{ $sort_columns{$sortkey} }, 'da.dunning_id');
|
||
| dde9d68d | Moritz Bunkus | |||
my $query =
|
||||
| 94944f08 | Bernd Bleßmann | qq|SELECT a.id, a.ordnumber, a.invoice, a.transdate, a.invnumber, a.amount, a.language_id,
|
||
| 840aea13 | Moritz Bunkus | ct.name AS customername, ct.id AS customer_id, a.duedate, da.fee,
|
||
| a422e87f | Bernd Bleßmann | da.interest, dn.dunning_description, dn.dunning_level, da.transdate AS dunning_date,
|
||
| 8f1fb2d6 | Roman Karuschka | da.duedate AS dunning_duedate, da.dunning_id, da.dunning_config_id,
|
||
e2.name AS salesman
|
||||
| 840aea13 | Moritz Bunkus | FROM ar a
|
||
| 8f1fb2d6 | Roman Karuschk |