Revision 1c603341
Von Jan Büren vor mehr als 15 Jahren hinzugefügt
| SL/Chart.pm | ||
|---|---|---|
|
package SL::Chart;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use SL::Form;
|
||
|
use SL::DBUtils;
|
||
|
|
||
|
sub list {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my @values = ();
|
||
|
my @where = ();
|
||
|
|
||
|
if ($params{link}) {
|
||
|
if ($params{link} =~ '%') {
|
||
|
push @where, "c.link LIKE ?";
|
||
|
push @values, $params{link};
|
||
|
|
||
|
} else {
|
||
|
push @where, "(c.link = ?) OR (c.link LIKE ?) OR (c.link LIKE ?) OR (c.link LIKE ?)";
|
||
|
push @values, $params{link}, '%:' . $params{link} . ':%', '%:' . $params{link}, $params{link} . ':%';
|
||
|
}
|
||
|
}
|
||
|
|
||
|
my $where = scalar @where ? 'WHERE ' . join(' AND ', map { "($_)" } @where) : '';
|
||
|
|
||
|
my $query =
|
||
|
qq|SELECT c.id, c.accno, c.description, c.link
|
||
|
FROM chart c
|
||
|
$where
|
||
|
ORDER BY c.accno|;
|
||
|
|
||
|
my $charts = selectall_hashref_query($form, $dbh, $query, @values);
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $charts;
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
| SL/SEPA.pm | ||
|---|---|---|
|
package SL::SEPA;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use POSIX qw(strftime);
|
||
|
|
||
|
use SL::DBUtils;
|
||
|
|
||
|
sub retrieve_open_invoices {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my $query =
|
||
|
qq|
|
||
|
SELECT ap.id, ap.invnumber, ap.vendor_id, ap.amount AS invoice_amount, ap.invoice,
|
||
|
v.name AS vendorname,
|
||
|
|
||
|
COALESCE(v.iban, '') <> '' AND COALESCE(v.bic, '') <> '' AS vendor_bank_info_ok,
|
||
|
|
||
|
ap.amount - ap.paid - COALESCE(open_transfers.amount, 0) AS open_amount
|
||
|
|
||
|
FROM ap
|
||
|
LEFT JOIN vendor v ON (ap.vendor_id = v.id)
|
||
|
LEFT JOIN (SELECT sei.ap_id, SUM(sei.amount) AS amount
|
||
|
FROM sepa_export_items sei
|
||
|
LEFT JOIN sepa_export se ON (sei.sepa_export_id = se.id)
|
||
|
WHERE NOT se.closed
|
||
|
GROUP BY sei.ap_id)
|
||
|
AS open_transfers ON (ap.id = open_transfers.ap_id)
|
||
|
|
||
|
WHERE ap.amount > (COALESCE(open_transfers.amount, 0) + ap.paid)
|
||
|
|
||
|
ORDER BY lower(v.name) ASC, lower(ap.invnumber) ASC
|
||
|
|;
|
||
|
|
||
|
my $results = selectall_hashref_query($form, $dbh, $query);
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $results;
|
||
|
}
|
||
|
|
||
|
sub create_export {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
Common::check_params(\%params, qw(employee bank_transfers));
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my ($export_id) = selectfirst_array_query($form, $dbh, qq|SELECT nextval('sepa_export_id_seq')|);
|
||
|
my $query =
|
||
|
qq|INSERT INTO sepa_export (id, employee_id)
|
||
|
VALUES (?, (SELECT id
|
||
|
FROM employee
|
||
|
WHERE login = ?))|;
|
||
|
do_query($form, $dbh, $query, $export_id, $params{employee});
|
||
|
|
||
|
my $q_item_id = qq|SELECT nextval('id')|;
|
||
|
my $h_item_id = prepare_query($form, $dbh, $q_item_id);
|
||
|
|
||
|
my $q_insert =
|
||
|
qq|INSERT INTO sepa_export_items (id, sepa_export_id, ap_id, chart_id,
|
||
|
amount, requested_execution_date, reference, end_to_end_id,
|
||
|
our_iban, our_bic, vendor_iban, vendor_bic)
|
||
|
VALUES (?, ?, ?, ?,
|
||
|
?, ?, ?, ?,
|
||
|
?, ?, ?, ?)|;
|
||
|
my $h_insert = prepare_query($form, $dbh, $q_insert);
|
||
|
|
||
|
my $q_reference =
|
||
|
qq|SELECT ap.invnumber,
|
||
|
(SELECT COUNT(at.*)
|
||
|
FROM acc_trans at
|
||
|
LEFT JOIN chart c ON (at.chart_id = c.id)
|
||
|
WHERE (at.trans_id = ?)
|
||
|
AND (c.link LIKE '%AP_paid%'))
|
||
|
+
|
||
|
(SELECT COUNT(sei.*)
|
||
|
FROM sepa_export_items sei
|
||
|
WHERE (sei.ap_id = ?))
|
||
|
AS num_payments
|
||
|
FROM ap
|
||
|
WHERE id = ?|;
|
||
|
my $h_reference = prepare_query($form, $dbh, $q_reference);
|
||
|
|
||
|
my @now = localtime;
|
||
|
|
||
|
foreach my $transfer (@{ $params{bank_transfers} }) {
|
||
|
if (!$transfer->{reference}) {
|
||
|
do_statement($form, $h_reference, $q_reference, (conv_i($transfer->{ap_id})) x 3);
|
||
|
|
||
|
my ($invnumber, $num_payments) = $h_reference->fetchrow_array();
|
||
|
$num_payments++;
|
||
|
|
||
|
$transfer->{reference} = "${invnumber}-${num_payments}";
|
||
|
}
|
||
|
|
||
|
$h_item_id->execute();
|
||
|
my ($item_id) = $h_item_id->fetchrow_array();
|
||
|
|
||
|
my $end_to_end_id = strftime "LXO%Y%m%d%H%M%S", localtime;
|
||
|
my $item_id_len = length "$item_id";
|
||
|
my $num_zeroes = 35 - $item_id_len - length $end_to_end_id;
|
||
|
$end_to_end_id .= '0' x $num_zeroes if (0 < $num_zeroes);
|
||
|
$end_to_end_id .= $item_id;
|
||
|
$end_to_end_id = substr $end_to_end_id, 0, 35;
|
||
|
|
||
|
my @values = ($item_id, $export_id,
|
||
|
conv_i($transfer->{ap_id}), conv_i($transfer->{chart_id}),
|
||
|
$transfer->{amount}, conv_date($transfer->{requested_execution_date}),
|
||
|
$transfer->{reference}, $end_to_end_id,
|
||
|
map { my $pfx = $_; map { $transfer->{"${pfx}_${_}"} } qw(iban bic) } qw(our vendor));
|
||
|
|
||
|
do_statement($form, $h_insert, $q_insert, @values);
|
||
|
}
|
||
|
|
||
|
$h_insert->finish();
|
||
|
$h_item_id->finish();
|
||
|
|
||
|
$dbh->commit() unless ($params{dbh});
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $export_id;
|
||
|
}
|
||
|
|
||
|
sub retrieve_export {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
Common::check_params(\%params, qw(id));
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my ($joins, $columns);
|
||
|
|
||
|
if ($params{details}) {
|
||
|
$columns = ', ap.invoice';
|
||
|
$joins = 'LEFT JOIN ap ON (se.ap_id = ap.id)';
|
||
|
}
|
||
|
|
||
|
my $query =
|
||
|
qq|SELECT se.*,
|
||
|
CASE WHEN COALESCE(e.name, '') <> '' THEN e.name ELSE e.login END AS employee
|
||
|
FROM sepa_export se
|
||
|
LEFT JOIN employee e ON (se.employee_id = e.id)
|
||
|
WHERE se.id = ?|;
|
||
|
|
||
|
my $export = selectfirst_hashref_query($form, $dbh, $query, conv_i($params{id}));
|
||
|
|
||
|
if ($export->{id}) {
|
||
|
my ($columns, $joins);
|
||
|
|
||
|
if ($params{details}) {
|
||
|
$columns = qq|, ap.invnumber, ap.invoice, v.name AS vendor_name, c.accno AS chart_accno, c.description AS chart_description|;
|
||
|
$joins = qq|LEFT JOIN ap ON (sei.ap_id = ap.id)
|
||
|
LEFT JOIN vendor v ON (ap.vendor_id = v.id)
|
||
|
LEFT JOIN chart c ON (sei.chart_id = c.id)|;
|
||
|
}
|
||
|
|
||
|
$query = qq|SELECT sei.*
|
||
|
$columns
|
||
|
FROM sepa_export_items sei
|
||
|
$joins
|
||
|
WHERE sei.sepa_export_id = ?|;
|
||
|
$export->{items} = selectall_hashref_query($form, $dbh, $query, conv_i($params{id}));
|
||
|
|
||
|
} else {
|
||
|
$export->{items} = [];
|
||
|
}
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $export;
|
||
|
}
|
||
|
|
||
|
sub close_export {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
Common::check_params(\%params, qw(id));
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my @ids = ref $params{id} eq 'ARRAY' ? @{ $params{id} } : ($params{id});
|
||
|
my $placeholders = join ', ', ('?') x scalar @ids;
|
||
|
my $query = qq|UPDATE sepa_export SET closed = TRUE WHERE id IN ($placeholders)|;
|
||
|
|
||
|
do_query($form, $dbh, $query, map { conv_i($_) } @ids);
|
||
|
|
||
|
$dbh->commit() unless ($params{dbh});
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub list_exports {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my %sort_columns = (
|
||
|
'id' => [ 'se.id', ],
|
||
|
'export_date' => [ 'se.itime', ],
|
||
|
'employee' => [ 'e.name', 'se.id', ],
|
||
|
'executed' => [ 'se.executed', 'se.id', ],
|
||
|
'closed' => [ 'se.closed', 'se.id', ],
|
||
|
);
|
||
|
|
||
|
my %sort_spec = create_sort_spec('defs' => \%sort_columns, 'default' => 'id', 'column' => $params{sortorder}, 'dir' => $params{sortdir});
|
||
|
|
||
|
my (@where, @values, @where_sub, @values_sub, %joins_sub);
|
||
|
|
||
|
my $filter = $params{filter} || { };
|
||
|
|
||
|
foreach (qw(executed closed)) {
|
||
|
push @where, $filter->{$_} ? "se.$_" : "NOT se.$_" if (exists $filter->{$_});
|
||
|
}
|
||
|
|
||
|
my %operators = ('from' => '>=',
|
||
|
'to' => '<=');
|
||
|
|
||
|
foreach my $dir (qw(from to)) {
|
||
|
next unless ($filter->{"export_date_${dir}"});
|
||
|
push @where, "se.itime $operators{$dir} ?::date";
|
||
|
push @values, $filter->{"export_date_${dir}"};
|
||
|
}
|
||
|
|
||
|
if ($filter->{invnumber}) {
|
||
|
push @where_sub, "ap.invnumber ILIKE ?";
|
||
|
push @values_sub, '%' . $filter->{invnumber} . '%';
|
||
|
$joins_sub{ap} = 1;
|
||
|
}
|
||
|
|
||
|
if ($filter->{vendor}) {
|
||
|
push @where_sub, "v.name ILIKE ?";
|
||
|
push @values_sub, '%' . $filter->{vendor} . '%';
|
||
|
$joins_sub{ap} = 1;
|
||
|
$joins_sub{vendor} = 1;
|
||
|
}
|
||
|
|
||
|
foreach my $type (qw(requested_execution execution)) {
|
||
|
foreach my $dir (qw(from to)) {
|
||
|
next unless ($filter->{"${type}_date_${dir}"});
|
||
|
push @where_sub, "(items.${type}_date IS NOT NULL) AND (items.${type}_date $operators{$dir} ?)";
|
||
|
push @values_sub, $filter->{"${type}_date_${_}"};
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if (@where_sub) {
|
||
|
my $joins_sub = '';
|
||
|
$joins_sub .= ' LEFT JOIN ap ON (items.ap_id = ap.id)' if ($joins_sub{ap});
|
||
|
$joins_sub .= ' LEFT JOIN vendor v ON (ap.vendor_id = v.id)' if ($joins_sub{vendor});
|
||
|
|
||
|
my $where_sub = join(' AND ', map { "(${_})" } @where_sub);
|
||
|
|
||
|
my $query_sub = qq|se.id IN (SELECT items.sepa_export_id
|
||
|
FROM sepa_export_items items
|
||
|
$joins_sub
|
||
|
WHERE $where_sub)|;
|
||
|
|
||
|
push @where, $query_sub;
|
||
|
push @values, @values_sub;
|
||
|
}
|
||
|
|
||
|
my $where = ' WHERE ' . join(' AND ', map { "(${_})" } @where) if (@where);
|
||
|
|
||
|
my $query =
|
||
|
qq|SELECT se.id, se.employee_id, se.executed, se.closed, itime::date AS export_date,
|
||
|
e.name AS employee
|
||
|
FROM sepa_export se
|
||
|
LEFT JOIN (
|
||
|
SELECT emp.id,
|
||
|
CASE WHEN COALESCE(emp.name, '') <> '' THEN emp.name ELSE emp.login END AS name
|
||
|
FROM employee emp
|
||
|
) AS e ON (se.employee_id = e.id)
|
||
|
$where
|
||
|
ORDER BY $sort_spec{sql}|;
|
||
|
|
||
|
my $results = selectall_hashref_query($form, $dbh, $query, @values);
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $results;
|
||
|
}
|
||
|
|
||
|
sub post_payment {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
Common::check_params(\%params, qw(items));
|
||
|
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
|
|
||
|
my @items = ref $params{items} eq 'ARRAY' ? @{ $params{items} } : ($params{items});
|
||
|
|
||
|
my %handles = (
|
||
|
'get_item' => [ qq|SELECT sei.*
|
||
|
FROM sepa_export_items sei
|
||
|
WHERE sei.id = ?| ],
|
||
|
|
||
|
'get_ap' => [ qq|SELECT at.chart_id
|
||
|
FROM acc_trans at
|
||
|
LEFT JOIN chart c ON (at.chart_id = c.id)
|
||
|
WHERE (trans_id = ?)
|
||
|
AND ((c.link LIKE '%:AP') OR (c.link LIKE 'AP:%') OR (c.link = 'AP'))
|
||
|
LIMIT 1| ],
|
||
|
|
||
|
'add_acc_trans' => [ qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, gldate, source, memo)
|
||
|
VALUES (?, ?, ?, ?, current_date, ?, '')| ],
|
||
|
|
||
|
'update_ap' => [ qq|UPDATE ap
|
||
|
SET paid = paid + ?
|
||
|
WHERE id = ?| ],
|
||
|
|
||
|
'finish_item' => [ qq|UPDATE sepa_export_items
|
||
|
SET execution_date = ?, executed = TRUE
|
||
|
WHERE id = ?| ],
|
||
|
|
||
|
'has_unexecuted' => [ qq|SELECT sei1.id
|
||
|
FROM sepa_export_items sei1
|
||
|
WHERE (sei1.sepa_export_id = (SELECT sei2.sepa_export_id
|
||
|
FROM sepa_export_items sei2
|
||
|
WHERE sei2.id = ?))
|
||
|
AND NOT COALESCE(sei1.executed, FALSE)
|
||
|
LIMIT 1| ],
|
||
|
|
||
|
'do_close' => [ qq|UPDATE sepa_export
|
||
|
SET executed = TRUE, closed = TRUE
|
||
|
WHERE (id = ?)| ],
|
||
|
);
|
||
|
|
||
|
map { unshift @{ $_ }, prepare_query($form, $dbh, $_->[0]) } values %handles;
|
||
|
|
||
|
foreach my $item (@items) {
|
||
|
my $item_id = conv_i($item->{id});
|
||
|
|
||
|
# Retrieve the item data belonging to the ID.
|
||
|
do_statement($form, @{ $handles{get_item} }, $item_id);
|
||
|
my $orig_item = $handles{get_item}->[0]->fetchrow_hashref();
|
||
|
|
||
|
next if (!$orig_item);
|
||
|
|
||
|
# Retrieve the invoice's AP chart ID.
|
||
|
do_statement($form, @{ $handles{get_ap} }, $orig_item->{ap_id});
|
||
|
my ($ap_chart_id) = $handles{get_ap}->[0]->fetchrow_array();
|
||
|
|
||
|
# Record the payment in acc_trans offsetting AP.
|
||
|
do_statement($form, @{ $handles{add_acc_trans} }, $orig_item->{ap_id}, $ap_chart_id, -1 * $orig_item->{amount}, $item->{execution_date}, '');
|
||
|
do_statement($form, @{ $handles{add_acc_trans} }, $orig_item->{ap_id}, $orig_item->{chart_id}, $orig_item->{amount}, $item->{execution_date}, $orig_item->{reference});
|
||
|
|
||
|
# Update the invoice to reflect the new paid amount.
|
||
|
do_statement($form, @{ $handles{update_ap} }, $orig_item->{amount}, $orig_item->{ap_id});
|
||
|
|
||
|
# Update the item to reflect that it has been posted.
|
||
|
do_statement($form, @{ $handles{finish_item} }, $item->{execution_date}, $item_id);
|
||
|
|
||
|
# Check whether or not we can close the export itself if there are no unexecuted items left.
|
||
|
do_statement($form, @{ $handles{has_unexecuted} }, $item_id);
|
||
|
my ($has_unexecuted) = $handles{has_unexecuted}->[0]->fetchrow_array();
|
||
|
|
||
|
if (!$has_unexecuted) {
|
||
|
do_statement($form, @{ $handles{do_close} }, $orig_item->{sepa_export_id});
|
||
|
}
|
||
|
}
|
||
|
|
||
|
map { $_->[0]->finish() } values %handles;
|
||
|
|
||
|
$dbh->commit() unless ($params{dbh});
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/SEPA/XML.pm | ||
|---|---|---|
|
package SL::SEPA::XML;
|
||
|
|
||
|
use strict;
|
||
|
use utf8;
|
||
|
|
||
|
use Carp;
|
||
|
use Encode;
|
||
|
use List::Util qw(first sum);
|
||
|
use List::MoreUtils qw(any);
|
||
|
use POSIX qw(strftime);
|
||
|
use Text::Iconv;
|
||
|
use XML::Writer;
|
||
|
|
||
|
use SL::SEPA::XML::Transaction;
|
||
|
|
||
|
sub new {
|
||
|
my $class = shift;
|
||
|
my $self = {};
|
||
|
|
||
|
bless $self, $class;
|
||
|
|
||
|
$self->_init(@_);
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _init {
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
$self->{transactions} = [];
|
||
|
$self->{src_charset} = 'UTF-8';
|
||
|
$self->{grouped} = 0;
|
||
|
|
||
|
map { $self->{$_} = $params{$_} if (exists $params{$_}) } qw(src_charset company message_id grouped);
|
||
|
|
||
|
$self->{iconv} = Text::Iconv->new($self->{src_charset}, "UTF-8") || croak "Unsupported source charset $self->{src_charset}.";
|
||
|
|
||
|
my $missing_parameter = first { !$self->{$_} } qw(company message_id);
|
||
|
croak "Missing parameter: $missing_parameter" if ($missing_parameter);
|
||
|
|
||
|
map { $self->{$_} = $self->_replace_special_chars(decode('UTF-8', $self->{iconv}->convert($self->{$_}))) } qw(company message_id);
|
||
|
}
|
||
|
|
||
|
sub add_transaction {
|
||
|
my $self = shift;
|
||
|
|
||
|
foreach my $transaction (@_) {
|
||
|
croak "Expecting hash reference." if (ref $transaction ne 'HASH');
|
||
|
push @{ $self->{transactions} }, SL::SEPA::XML::Transaction->new(%{ $transaction }, 'sepa' => $self);
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
sub _replace_special_chars {
|
||
|
my $self = shift;
|
||
|
my $text = shift;
|
||
|
|
||
|
my %special_chars = (
|
||
|
'ä' => 'ae',
|
||
|
'ö' => 'oe',
|
||
|
'ü' => 'ue',
|
||
|
'Ä' => 'Ae',
|
||
|
'Ö' => 'Oe',
|
||
|
'Ü' => 'Ue',
|
||
|
'ß' => 'ss',
|
||
|
'&' => '+',
|
||
|
);
|
||
|
|
||
|
map { $text =~ s/$_/$special_chars{$_}/g; } keys %special_chars;
|
||
|
|
||
|
return $text;
|
||
|
}
|
||
|
|
||
|
sub _format_amount {
|
||
|
my $self = shift;
|
||
|
my $amount = shift;
|
||
|
|
||
|
return sprintf '%d.%02d', int($amount), int($amount * 100) % 100;
|
||
|
}
|
||
|
|
||
|
sub _group_transactions {
|
||
|
my $self = shift;
|
||
|
|
||
|
my $grouped = {
|
||
|
'sum_amount' => 0,
|
||
|
'groups' => { },
|
||
|
};
|
||
|
|
||
|
foreach my $transaction (@{ $self->{transactions} }) {
|
||
|
my $key = $self->{grouped} ? join("\t", map { $transaction->get($_) } qw(src_bic src_iban execution_date)) : 'all';
|
||
|
$grouped->{groups}->{$key} ||= {
|
||
|
'sum_amount' => 0,
|
||
|
'transactions' => [ ],
|
||
|
};
|
||
|
|
||
|
push @{ $grouped->{groups}->{$key}->{transactions} }, $transaction;
|
||
|
|
||
|
$grouped->{groups}->{$key}->{sum_amount} += $transaction->{amount};
|
||
|
$grouped->{sum_amount} += $transaction->{amount};
|
||
|
}
|
||
|
|
||
|
return $grouped;
|
||
|
}
|
||
|
|
||
|
sub to_xml {
|
||
|
my $self = shift;
|
||
|
|
||
|
croak "No transactions added yet." if (!@{ $self->{transactions} });
|
||
|
|
||
|
my $output = '';
|
||
|
|
||
|
my $xml = XML::Writer->new(OUTPUT => \$output,
|
||
|
DATA_MODE => 1,
|
||
|
DATA_INDENT => 2,
|
||
|
ENCODING => 'utf-8');
|
||
|
|
||
|
my @now = localtime;
|
||
|
my $time_zone = strftime "%z", @now;
|
||
|
my $now_str = strftime('%Y-%m-%dT%H:%M:%S', @now) . substr($time_zone, 0, 3) . ':' . substr($time_zone, 3, 2);
|
||
|
|
||
|
my $grouped_transactions = $self->_group_transactions();
|
||
|
|
||
|
$xml->xmlDecl();
|
||
|
$xml->startTag('Document',
|
||
|
'xmlns' => 'urn:sepade:xsd:pain.001.001.02.grp',
|
||
|
'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance',
|
||
|
'xsi:schemaLocation' => 'urn:sepade:xsd:pain.001.001.02.grp pain.001.001.02.grp.xsd');
|
||
|
|
||
|
$xml->startTag('pain.001.001.02');
|
||
|
|
||
|
$xml->startTag('GrpHdr');
|
||
|
$xml->dataElement('MsgId', encode('UTF-8', substr($self->{message_id}, 0, 35)));
|
||
|
$xml->dataElement('CreDtTm', $now_str);
|
||
|
$xml->dataElement('NbOfTxs', scalar @{ $self->{transactions} });
|
||
|
$xml->dataElement('CtrlSum', $self->_format_amount($grouped_transactions->{sum_amount}));
|
||
|
$xml->dataElement('Grpg', 'MIXD');
|
||
|
|
||
|
$xml->startTag('InitgPty');
|
||
|
$xml->dataElement('Nm', encode('UTF-8', substr($self->{company}, 0, 70)));
|
||
|
$xml->endTag('InitgPty');
|
||
|
|
||
|
$xml->endTag('GrpHdr');
|
||
|
|
||
|
foreach my $key (keys %{ $grouped_transactions->{groups} }) {
|
||
|
my $transaction_group = $grouped_transactions->{groups}->{$key};
|
||
|
my $master_transaction = $transaction_group->{transactions}->[0];
|
||
|
|
||
|
$xml->startTag('PmtInf');
|
||
|
$xml->dataElement('PmtMtd', 'TRF');
|
||
|
|
||
|
$xml->startTag('PmtTpInf');
|
||
|
$xml->startTag('SvcLvl');
|
||
|
$xml->dataElement('Cd', 'SEPA');
|
||
|
$xml->endTag('SvcLvl');
|
||
|
$xml->endTag('PmtTpInf');
|
||
|
|
||
|
$xml->dataElement('ReqdExctnDt', $master_transaction->get('execution_date'));
|
||
|
$xml->startTag('Dbtr');
|
||
|
$xml->dataElement('Nm', encode('UTF-8', substr($self->{company}, 0, 70)));
|
||
|
$xml->endTag('Dbtr');
|
||
|
|
||
|
$xml->startTag('DbtrAcct');
|
||
|
$xml->startTag('Id');
|
||
|
$xml->dataElement('IBAN', $master_transaction->get('src_iban', 34));
|
||
|
$xml->endTag('Id');
|
||
|
$xml->endTag('DbtrAcct');
|
||
|
|
||
|
$xml->startTag('DbtrAgt');
|
||
|
$xml->startTag('FinInstnId');
|
||
|
$xml->dataElement('BIC', $master_transaction->get('src_bic', 20));
|
||
|
$xml->endTag('FinInstnId');
|
||
|
$xml->endTag('DbtrAgt');
|
||
|
|
||
|
$xml->dataElement('ChrgBr', 'SLEV');
|
||
|
|
||
|
foreach my $transaction (@{ $transaction_group->{transactions} }) {
|
||
|
$xml->startTag('CdtTrfTxInf');
|
||
|
|
||
|
$xml->startTag('PmtId');
|
||
|
$xml->dataElement('EndToEndId', $transaction->get('end_to_end_id', 35));
|
||
|
$xml->endTag('PmtId');
|
||
|
|
||
|
$xml->startTag('Amt');
|
||
|
$xml->startTag('InstdAmt', 'Ccy' => 'EUR');
|
||
|
$xml->characters($self->_format_amount($transaction->{amount}));
|
||
|
$xml->endTag('InstdAmt');
|
||
|
$xml->endTag('Amt');
|
||
|
|
||
|
$xml->startTag('CdtrAgt');
|
||
|
$xml->startTag('FinInstnId');
|
||
|
$xml->dataElement('BIC', $transaction->get('dst_bic', 20));
|
||
|
$xml->endTag('FinInstnId');
|
||
|
$xml->endTag('CdtrAgt');
|
||
|
|
||
|
$xml->startTag('Cdtr');
|
||
|
$xml->dataElement('Nm', $transaction->get('recipient', 70));
|
||
|
$xml->endTag('Cdtr');
|
||
|
|
||
|
$xml->startTag('CdtrAcct');
|
||
|
$xml->startTag('Id');
|
||
|
$xml->dataElement('IBAN', $transaction->get('dst_iban', 34));
|
||
|
$xml->endTag('Id');
|
||
|
$xml->endTag('CdtrAcct');
|
||
|
|
||
|
$xml->startTag('RmtInf');
|
||
|
$xml->dataElement('Ustrd', $transaction->get('reference', 140));
|
||
|
$xml->endTag('RmtInf');
|
||
|
|
||
|
$xml->endTag('CdtTrfTxInf');
|
||
|
}
|
||
|
|
||
|
$xml->endTag('PmtInf');
|
||
|
}
|
||
|
|
||
|
$xml->endTag('pain.001.001.02');
|
||
|
$xml->endTag('Document');
|
||
|
|
||
|
return $output;
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
|
# Local Variables:
|
||
|
# coding: utf-8
|
||
|
# End:
|
||
| SL/SEPA/XML/Transaction.pm | ||
|---|---|---|
|
package SL::SEPA::XML::Transaction;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use Carp;
|
||
|
use Encode;
|
||
|
use List::Util qw(first);
|
||
|
use POSIX qw(strftime);
|
||
|
use Text::Iconv;
|
||
|
|
||
|
sub new {
|
||
|
my $class = shift;
|
||
|
my $self = {};
|
||
|
|
||
|
bless $self, $class;
|
||
|
|
||
|
$self->_init(@_);
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub _init {
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
$self->{sepa} = $params{sepa};
|
||
|
delete $params{sepa};
|
||
|
|
||
|
my $missing_parameter = first { !$params{$_} } qw(src_iban src_bic dst_iban dst_bic recipient reference amount end_to_end_id);
|
||
|
croak "Missing parameter: $missing_parameter" if ($missing_parameter);
|
||
|
|
||
|
$params{end_to_end_id} ||= 'NOTPROVIDED';
|
||
|
$params{execution_date} ||= strftime "%Y-%m-%d", localtime;
|
||
|
|
||
|
croak "Execution date format wrong for '$params{execution_date}': not YYYY-MM-DD." if ($params{execution_date} !~ /^\d{4}-\d{2}-\d{2}$/);
|
||
|
|
||
|
map { $self->{$_} = decode('UTF-8', $self->{sepa}->{iconv}->convert($params{$_})) } keys %params;
|
||
|
map { $self->{$_} =~ s/\s+//g } qw(src_iban src_bic dst_iban dst_bic);
|
||
|
map { $self->{$_} = $self->{sepa}->_replace_special_chars($self->{$_}) } qw(recipient reference end_to_end_id);
|
||
|
}
|
||
|
|
||
|
sub get {
|
||
|
my $self = shift;
|
||
|
my $key = shift;
|
||
|
my $max_len = shift;
|
||
|
|
||
|
return undef if (!defined $self->{$key});
|
||
|
|
||
|
my $str = $max_len ? substr($self->{$key}, 0, $max_len) : $self->{$key};
|
||
|
|
||
|
return encode('UTF-8', $str);
|
||
|
}
|
||
|
|
||
|
1;
|
||
| bankaccounts.pl | ||
|---|---|---|
|
am.pl
|
||
| bin/mozilla/bankaccounts.pl | ||
|---|---|---|
|
use strict;
|
||
|
|
||
|
use POSIX qw(strftime);
|
||
|
|
||
|
use SL::BankAccount;
|
||
|
use SL::Chart;
|
||
|
use SL::Form;
|
||
|
use SL::ReportGenerator;
|
||
|
|
||
|
require "bin/mozilla/common.pl";
|
||
|
require "bin/mozilla/reportgenerator.pl";
|
||
|
|
||
|
sub bank_account_add {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
bank_account_display_form('account' => {});
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_account_edit {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my %params = @_;
|
||
|
my $form = $main::form;
|
||
|
|
||
|
my $account = SL::BankAccount->retrieve('id' => $params{id} || $form->{id});
|
||
|
|
||
|
bank_account_display_form('account' => $account);
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_account_display_form {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my %params = @_;
|
||
|
my $account = $params{account} || {};
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
my $charts = SL::Chart->list('link' => 'AP_paid');
|
||
|
my $label_sub = sub { join '--', map { $_[0]->{$_} } qw(accno description) };
|
||
|
|
||
|
$form->{title} = $account->{id} ? $locale->text('Edit bank account') : $locale->text('Add bank account');
|
||
|
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('bankaccounts/bank_account_display_form',
|
||
|
{ 'CHARTS' => $charts,
|
||
|
'account' => $account,
|
||
|
'chart_label' => $label_sub,
|
||
|
'params' => \%params });
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_account_save {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
my $account = $form->{account} && (ref $form->{account} eq 'HASH') ? $form->{account} : { };
|
||
|
|
||
|
if (any { !$account->{$_} } qw(account_number bank_code iban bic)) {
|
||
|
bank_account_display_form('account' => $account,
|
||
|
'error' => $locale->text('You have to fill in at least an account number, the bank code, the IBAN and the BIC.'));
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
my $id = SL::BankAccount->save(%{ $account });
|
||
|
|
||
|
if ($form->{callback}) {
|
||
|
$form->redirect();
|
||
|
|
||
|
} else {
|
||
|
bank_account_edit('id' => $id);
|
||
|
}
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
|
||
|
sub bank_account_list {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
$form->{title} = $locale->text('List of bank accounts');
|
||
|
|
||
|
$form->{sort} ||= 'account_number';
|
||
|
$form->{sortdir} = '1' if (!defined $form->{sortdir});
|
||
|
|
||
|
$form->{callback} = build_std_url('action=bank_account_list', 'sort', 'sortdir');
|
||
|
|
||
|
my $accounts = SL::BankAccount->list('sortorder' => $form->{sort},
|
||
|
'sortdir' => $form->{sortdir});
|
||
|
|
||
|
my $report = SL::ReportGenerator->new(\%main::myconfig, $form);
|
||
|
|
||
|
my $href = build_std_url('action=bank_account_list');
|
||
|
|
||
|
my %column_defs = (
|
||
|
'account_number' => { 'text' => $locale->text('Account number'), },
|
||
|
'bank_code' => { 'text' => $locale->text('Bank code'), },
|
||
|
'bank' => { 'text' => $locale->text('Bank'), },
|
||
|
'bic' => { 'text' => $locale->text('BIC'), },
|
||
|
'iban' => { 'text' => $locale->text('IBAN'), },
|
||
|
);
|
||
|
|
||
|
my @columns = qw(account_number bank bank_code bic iban);
|
||
|
|
||
|
foreach my $name (@columns) {
|
||
|
my $sortdir = $form->{sort} eq $name ? 1 - $form->{sortdir} : $form->{sortdir};
|
||
|
$column_defs{$name}->{link} = $href . "&sort=$name&sortdir=$sortdir";
|
||
|
}
|
||
|
|
||
|
$report->set_options('raw_bottom_info_text' => $form->parse_html_template('bankaccounts/bank_account_list_bottom'),
|
||
|
'std_column_visibility' => 1,
|
||
|
'output_format' => 'HTML',
|
||
|
'title' => $form->{title},
|
||
|
'attachment_basename' => $locale->text('bankaccounts') . strftime('_%Y%m%d', localtime time),
|
||
|
);
|
||
|
$report->set_options_from_form();
|
||
|
|
||
|
$report->set_columns(%column_defs);
|
||
|
$report->set_column_order(@columns);
|
||
|
$report->set_export_options('bank_account_list');
|
||
|
$report->set_sort_indicator($form->{sort}, $form->{sortdir});
|
||
|
|
||
|
my $edit_url = build_std_url('action=bank_account_edit', 'callback');
|
||
|
|
||
|
foreach my $account (@{ $accounts }) {
|
||
|
my $row = { map { $_ => { 'data' => $account->{$_} } } keys %{ $account } };
|
||
|
|
||
|
$row->{account_number}->{link} = $edit_url . '&id=' . E($account->{id});
|
||
|
|
||
|
$report->add_data($row);
|
||
|
}
|
||
|
|
||
|
$report->generate_with_headers();
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub dispatcher {
|
||
|
my $form = $main::form;
|
||
|
|
||
|
foreach my $action (qw(bank_account_save bank_account_delete)) {
|
||
|
if ($form->{"action_${action}"}) {
|
||
|
call_sub($action);
|
||
|
return;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
$form->error($main::locale->text('No action defined.'));
|
||
|
}
|
||
|
|
||
|
1;
|
||
| bin/mozilla/sepa.pl | ||
|---|---|---|
|
use strict;
|
||
|
|
||
|
use List::MoreUtils qw(any none uniq);
|
||
|
use List::Util qw(first);
|
||
|
use POSIX qw(strftime);
|
||
|
|
||
|
use SL::BankAccount;
|
||
|
use SL::Chart;
|
||
|
use SL::CT;
|
||
|
use SL::Form;
|
||
|
use SL::ReportGenerator;
|
||
|
use SL::SEPA;
|
||
|
use SL::SEPA::XML;
|
||
|
|
||
|
require "bin/mozilla/common.pl";
|
||
|
require "bin/mozilla/reportgenerator.pl";
|
||
|
|
||
|
sub bank_transfer_add {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
$form->{title} = $locale->text('Prepare bank transfer via SEPA XML');
|
||
|
|
||
|
my $bank_accounts = SL::BankAccount->list();
|
||
|
|
||
|
if (!scalar @{ $bank_accounts }) {
|
||
|
$form->error($locale->text('You have not added bank accounts yet.'));
|
||
|
}
|
||
|
|
||
|
my $invoices = SL::SEPA->retrieve_open_invoices();
|
||
|
|
||
|
if (!scalar @{ $invoices }) {
|
||
|
$form->show_generic_information($locale->text('Either there are no open invoices, or you have already initiated bank transfers ' .
|
||
|
'with the open amounts for those that are still open.'));
|
||
|
$main::lxdebug->leave_sub();
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
my $bank_account_label_sub = sub { $locale->text('Account number #1, bank code #2, #3', $_[0]->{account_number}, $_[0]->{bank_code}, $_[0]->{bank}) };
|
||
|
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('sepa/bank_transfer_add',
|
||
|
{ 'INVOICES' => $invoices,
|
||
|
'BANK_ACCOUNTS' => $bank_accounts,
|
||
|
'bank_account_label' => $bank_account_label_sub, });
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_create {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
|
||
|
$form->{title} = $locale->text('Create bank transfer via SEPA XML');
|
||
|
|
||
|
my $bank_accounts = SL::BankAccount->list();
|
||
|
|
||
|
if (!scalar @{ $bank_accounts }) {
|
||
|
$form->error($locale->text('You have not added bank accounts yet.'));
|
||
|
}
|
||
|
|
||
|
my $bank_account = first { $form->{bank_account}->{id} == $_->{id} } @{ $bank_accounts };
|
||
|
|
||
|
if (!$bank_account) {
|
||
|
$form->error($locale->text('The selected bank account does not exist anymore.'));
|
||
|
}
|
||
|
|
||
|
my $invoices = SL::SEPA->retrieve_open_invoices();
|
||
|
my %invoices_map = map { $_->{id} => $_ } @{ $invoices };
|
||
|
my @bank_transfers =
|
||
|
map +{ %{ $invoices_map{ $_->{ap_id} } }, %{ $_ } },
|
||
|
grep { $_->{selected} && (0 < $_->{amount}) && $invoices_map{ $_->{ap_id} } }
|
||
|
map { $_->{amount} = $form->parse_amount($myconfig, $_->{amount}); $_ }
|
||
|
@{ $form->{bank_transfers} || [] };
|
||
|
|
||
|
if (!scalar @bank_transfers) {
|
||
|
$form->error($locale->text('You have selected none of the invoices.'));
|
||
|
}
|
||
|
|
||
|
my ($vendor_bank_info);
|
||
|
my $error_message;
|
||
|
|
||
|
if ($form->{confirmation}) {
|
||
|
$vendor_bank_info = { map { $_->{id} => $_ } @{ $form->{vendor_bank_info} || [] } };
|
||
|
|
||
|
foreach my $info (values %{ $vendor_bank_info }) {
|
||
|
if (any { !$info->{$_} } qw(iban bic)) {
|
||
|
$error_message = $locale->text('The bank information must not be empty.');
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if ($error_message || !$form->{confirmation}) {
|
||
|
my @vendor_ids = uniq map { $_->{vendor_id} } @bank_transfers;
|
||
|
$vendor_bank_info ||= CT->get_bank_info('vc' => 'vendor',
|
||
|
'id' => \@vendor_ids);
|
||
|
my @vendor_bank_info = sort { lc $a->{name} cmp lc $b->{name} } values %{ $vendor_bank_info };
|
||
|
|
||
|
my $bank_account_label_sub = sub { $locale->text('Account number #1, bank code #2, #3', $_[0]->{account_number}, $_[0]->{bank_code}, $_[0]->{bank}) };
|
||
|
|
||
|
$form->{jsscript} = 1;
|
||
|
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('sepa/bank_transfer_create',
|
||
|
{ 'BANK_TRANSFERS' => \@bank_transfers,
|
||
|
'BANK_ACCOUNTS' => $bank_accounts,
|
||
|
'VENDOR_BANK_INFO' => \@vendor_bank_info,
|
||
|
'bank_account' => $bank_account,
|
||
|
'bank_account_label' => $bank_account_label_sub,
|
||
|
'error_message' => $error_message,
|
||
|
});
|
||
|
|
||
|
} else {
|
||
|
foreach my $bank_transfer (@bank_transfers) {
|
||
|
foreach (qw(iban bic)) {
|
||
|
$bank_transfer->{"vendor_${_}"} = $vendor_bank_info->{ $bank_transfer->{vendor_id} }->{$_};
|
||
|
$bank_transfer->{"our_${_}"} = $bank_account->{$_};
|
||
|
}
|
||
|
|
||
|
$bank_transfer->{chart_id} = $bank_account->{chart_id};
|
||
|
}
|
||
|
|
||
|
my $id = SL::SEPA->create_export('employee' => $form->{login},
|
||
|
'bank_transfers' => \@bank_transfers);
|
||
|
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('sepa/bank_transfer_created', { 'id' => $id });
|
||
|
}
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_search {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
$form->{title} = $locale->text('List of bank transfers');
|
||
|
$form->{jsscript} = 1;
|
||
|
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('sepa/bank_transfer_search');
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
|
||
|
sub bank_transfer_list {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
my $cgi = $main::cgi;
|
||
|
|
||
|
$form->{title} = $locale->text('List of bank transfers');
|
||
|
|
||
|
$form->{sort} ||= 'id';
|
||
|
$form->{sortdir} = '1' if (!defined $form->{sortdir});
|
||
|
|
||
|
$form->{callback} = build_std_url('action=bank_transfer_list', 'sort', 'sortdir');
|
||
|
|
||
|
my %filter = map +( $_ => $form->{"f_${_}"} ),
|
||
|
grep { $form->{"f_${_}"} }
|
||
|
(qw(vendor invnumber),
|
||
|
map { ("${_}_date_from", "${_}_date_to") }
|
||
|
qw(export requested_execution execution));
|
||
|
$filter{executed} = $form->{l_executed} ? 1 : 0 if ($form->{l_executed} != $form->{l_not_executed});
|
||
|
$filter{closed} = $form->{l_closed} ? 1 : 0 if ($form->{l_open} != $form->{l_closed});
|
||
|
|
||
|
my $exports = SL::SEPA->list_exports('filter' => \%filter,
|
||
|
'sortorder' => $form->{sort},
|
||
|
'sortdir' => $form->{sortdir});
|
||
|
|
||
|
my $open_available = any { !$_->{closed} } @{ $exports };
|
||
|
|
||
|
my $report = SL::ReportGenerator->new(\%main::myconfig, $form);
|
||
|
|
||
|
my @hidden_vars = grep { m/^[fl]_/ && $form->{$_} } keys %{ $form };
|
||
|
|
||
|
my $href = build_std_url('action=bank_transfer_list', @hidden_vars);
|
||
|
|
||
|
my %column_defs = (
|
||
|
'selected' => { 'text' => $cgi->checkbox(-name => 'select_all', -id => 'select_all', -label => ''), },
|
||
|
'id' => { 'text' => $locale->text('Number'), },
|
||
|
'export_date' => { 'text' => $locale->text('Export date'), },
|
||
|
'employee' => { 'text' => $locale->text('Employee'), },
|
||
|
'executed' => { 'text' => $locale->text('Executed'), },
|
||
|
'closed' => { 'text' => $locale->text('Closed'), },
|
||
|
);
|
||
|
|
||
|
my @columns = qw(selected id export_date employee executed closed);
|
||
|
|
||
|
foreach my $name (qw(id export_date employee executed closed)) {
|
||
|
my $sortdir = $form->{sort} eq $name ? 1 - $form->{sortdir} : $form->{sortdir};
|
||
|
$column_defs{$name}->{link} = $href . "&sort=$name&sortdir=$sortdir";
|
||
|
}
|
||
|
|
||
|
$column_defs{selected}->{visible} = $open_available ? 1 : 0;
|
||
|
$column_defs{executed}->{visible} = $form->{l_executed} && $form->{l_not_executed} ? 1 : 0;
|
||
|
$column_defs{closed}->{visible} = $form->{l_closed} && $form->{l_open} ? 1 : 0;
|
||
|
|
||
|
my @options = ();
|
||
|
push @options, $locale->text('Vendor') . ' : ' . $form->{f_vendor} if ($form->{f_vendor});
|
||
|
push @options, $locale->text('Invoice number') . ' : ' . $form->{f_invnumber} if ($form->{f_invnumber});
|
||
|
push @options, $locale->text('Export date from') . ' : ' . $form->{f_export_date_from} if ($form->{f_export_date_from});
|
||
|
push @options, $locale->text('Export date to') . ' : ' . $form->{f_export_date_to} if ($form->{f_export_date_to});
|
||
|
push @options, $locale->text('Requested execution date from') . ' : ' . $form->{f_requested_execution_date_from} if ($form->{f_requested_execution_date_from});
|
||
|
push @options, $locale->text('Requested execution date to') . ' : ' . $form->{f_requested_execution_date_to} if ($form->{f_requested_execution_date_to});
|
||
|
push @options, $locale->text('Execution date from') . ' : ' . $form->{f_execution_date_from} if ($form->{f_execution_date_from});
|
||
|
push @options, $locale->text('Execution date to') . ' : ' . $form->{f_execution_date_to} if ($form->{f_execution_date_to});
|
||
|
push @options, $form->{l_executed} ? $locale->text('executed') : $locale->text('not yet executed') if ($form->{l_executed} != $form->{l_not_executed});
|
||
|
push @options, $form->{l_closed} ? $locale->text('closed') : $locale->text('open') if ($form->{l_open} != $form->{l_closed});
|
||
|
|
||
|
$report->set_options('top_info_text' => join("\n", @options),
|
||
|
'raw_top_info_text' => $form->parse_html_template('sepa/bank_transfer_list_top'),
|
||
|
'raw_bottom_info_text' => $form->parse_html_template('sepa/bank_transfer_list_bottom', { 'show_buttons' => $open_available }),
|
||
|
'std_column_visibility' => 1,
|
||
|
'output_format' => 'HTML',
|
||
|
'title' => $form->{title},
|
||
|
'attachment_basename' => $locale->text('banktransfers') . strftime('_%Y%m%d', localtime time),
|
||
|
);
|
||
|
$report->set_options_from_form();
|
||
|
|
||
|
$report->set_columns(%column_defs);
|
||
|
$report->set_column_order(@columns);
|
||
|
$report->set_export_options('bank_transfer_list', @hidden_vars);
|
||
|
$report->set_sort_indicator($form->{sort}, $form->{sortdir});
|
||
|
|
||
|
my $edit_url = build_std_url('action=bank_transfer_edit', 'callback');
|
||
|
|
||
|
foreach my $export (@{ $exports }) {
|
||
|
my $row = { map { $_ => { 'data' => $export->{$_} } } keys %{ $export } };
|
||
|
|
||
|
map { $row->{$_}->{data} = $export->{$_} ? $locale->text('yes') : $locale->text('no') } qw(executed closed);
|
||
|
|
||
|
$row->{id}->{link} = $edit_url . '&id=' . E($export->{id});
|
||
|
|
||
|
if (!$export->{closed}) {
|
||
|
$row->{selected}->{raw_data} =
|
||
|
$cgi->hidden(-name => "exports[+].id", -value => $export->{id})
|
||
|
. $cgi->checkbox(-name => "exports[].selected", -value => 1, -label => '');
|
||
|
}
|
||
|
|
||
|
$report->add_data($row);
|
||
|
}
|
||
|
|
||
|
$report->generate_with_headers();
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_edit {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
my @ids = ();
|
||
|
if (!$form->{mode} || ($form->{mode} eq 'single')) {
|
||
|
push @ids, $form->{id};
|
||
|
} else {
|
||
|
@ids = map $_->{id}, grep { $_->{selected} } @{ $form->{exports} || [] };
|
||
|
|
||
|
if (!@ids) {
|
||
|
$form->show_generic_error($locale->text('You have not selected any export.'), 'back_button' => 1);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
my $export;
|
||
|
|
||
|
foreach my $id (@ids) {
|
||
|
my $curr_export = SL::SEPA->retrieve_export('id' => $id, 'details' => 1);
|
||
|
|
||
|
foreach my $item (@{ $curr_export->{items} }) {
|
||
|
map { $item->{"export_${_}"} = $curr_export->{$_} } grep { !ref $curr_export->{$_} } keys %{ $curr_export };
|
||
|
}
|
||
|
|
||
|
if (!$export) {
|
||
|
$export = $curr_export;
|
||
|
} else {
|
||
|
push @{ $export->{items} }, @{ $curr_export->{items} };
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if ($form->{mode} && ($form->{mode} eq 'multi')) {
|
||
|
$export->{items} = [ grep { !$_->{export_closed} && !$_->{executed} } @{ $export->{items} } ];
|
||
|
|
||
|
if (!@{ $export->{items} }) {
|
||
|
$form->show_generic_error($locale->text('All the selected exports have already been closed, or all of their items have already been executed.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
} elsif (!$export) {
|
||
|
$form->error($locale->text('That export does not exist.'));
|
||
|
}
|
||
|
|
||
|
$form->{jsscript} = 1;
|
||
|
$form->{title} = $locale->text('View SEPA export');
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('sepa/bank_transfer_edit',
|
||
|
{ 'ids' => \@ids,
|
||
|
'export' => $export,
|
||
|
'current_date' => $form->current_date(\%main::myconfig),
|
||
|
'show_post_payments_button' => any { !$_->{export_closed} && !$_->{executed} } @{ $export->{items} },
|
||
|
});
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_post_payments {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
my @items = grep { $_->{selected} } @{ $form->{items} || [] };
|
||
|
|
||
|
if (!@items) {
|
||
|
$form->show_generic_error($locale->text('You have not selected any item.'), 'back_button' => 1);
|
||
|
}
|
||
|
my @export_ids = uniq map { $_->{sepa_export_id} } @items;
|
||
|
my %exports = map { $_ => SL::SEPA->retrieve_export('id' => $_, 'details' => 1) } @export_ids;
|
||
|
my @items_to_post = ();
|
||
|
|
||
|
foreach my $item (@items) {
|
||
|
my $export = $exports{ $item->{sepa_export_id} };
|
||
|
next if (!$export || $export->{closed} || $export->{executed});
|
||
|
|
||
|
push @items_to_post, $item if (none { ($_->{id} == $item->{id}) && $_->{executed} } @{ $export->{items} });
|
||
|
}
|
||
|
|
||
|
if (!@items_to_post) {
|
||
|
$form->show_generic_error($locale->text('All the selected exports have already been closed, or all of their items have already been executed.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
if (any { !$_->{execution_date} } @items_to_post) {
|
||
|
$form->show_generic_error($locale->text('You have to specify an execution date for each antry.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
SL::SEPA->post_payment('items' => \@items_to_post);
|
||
|
|
||
|
$form->show_generic_information($locale->text('The payments have been posted.'));
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_payment_list_as_pdf {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my %myconfig = %main::myconfig;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
my @ids = @{ $form->{items} || [] };
|
||
|
my @export_ids = uniq map { $_->{export_id} } @ids;
|
||
|
|
||
|
$form->show_generic_error($locale->text('Multi mode not supported.'), 'back_button' => 1) if 1 != scalar @export_ids;
|
||
|
|
||
|
my $export = SL::SEPA->retrieve_export('id' => $export_ids[0], 'details' => 1);
|
||
|
my @items = ();
|
||
|
|
||
|
foreach my $id (@ids) {
|
||
|
my $item = first { $_->{id} == $id->{id} } @{ $export->{items} };
|
||
|
push @items, $item if $item;
|
||
|
}
|
||
|
|
||
|
$form->show_generic_error($locale->text('No transfers were executed in this export.'), 'back_button' => 1) if 1 > scalar @items;
|
||
|
|
||
|
my $report = SL::ReportGenerator->new(\%main::myconfig, $form);
|
||
|
|
||
|
my %column_defs = (
|
||
|
'invnumber' => { 'text' => $locale->text('Invoice'), },
|
||
|
'vendor_name' => { 'text' => $locale->text('Vendor'), },
|
||
|
'our_iban' => { 'text' => $locale->text('Source IBAN'), },
|
||
|
'our_bic' => { 'text' => $locale->text('Source BIC'), },
|
||
|
'vendor_iban' => { 'text' => $locale->text('Destination IBAN'), },
|
||
|
'vendor_bic' => { 'text' => $locale->text('Destination BIC'), },
|
||
|
'amount' => { 'text' => $locale->text('Amount'), },
|
||
|
'reference' => { 'text' => $locale->text('Reference'), },
|
||
|
'execution_date' => { 'text' => $locale->text('Execution date'), },
|
||
|
);
|
||
|
|
||
|
map { $column_defs{$_}->{align} = 'right' } qw(amount execution_date);
|
||
|
|
||
|
my @columns = qw(invnumber vendor_name our_iban our_bic vendor_iban vendor_bic amount reference execution_date);
|
||
|
|
||
|
$report->set_options('std_column_visibility' => 1,
|
||
|
'output_format' => 'PDF',
|
||
|
'title' => $locale->text('Bank transfer payment list for export #1', $export->{id}),
|
||
|
'attachment_basename' => $locale->text('bank_transfer_payment_list_#1', $export->{id}) . strftime('_%Y%m%d', localtime time),
|
||
|
);
|
||
|
|
||
|
$report->set_columns(%column_defs);
|
||
|
$report->set_column_order(@columns);
|
||
|
|
||
|
foreach my $item (@items) {
|
||
|
my $row = { map { $_ => { 'data' => $item->{$_} } } @columns };
|
||
|
$row->{amount}->{data} = $form->format_amount(\%myconfig, $item->{amount}, 2);
|
||
|
|
||
|
$report->add_data($row);
|
||
|
}
|
||
|
|
||
|
$report->generate_with_headers();
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_download_sepa_xml {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $myconfig = \%main::myconfig;
|
||
|
my $locale = $main::locale;
|
||
|
my $cgi = $main::cgi;
|
||
|
|
||
|
if (!$myconfig->{company}) {
|
||
|
$form->show_generic_error($locale->text('You have to enter a company name in your user preferences (see the "Program" menu, "Preferences").'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
my @ids;
|
||
|
if ($form->{mode} && ($form->{mode} eq 'multi')) {
|
||
|
@ids = map $_->{id}, grep { $_->{selected} } @{ $form->{exports} || [] };
|
||
|
|
||
|
} else {
|
||
|
@ids = ($form->{id});
|
||
|
}
|
||
|
|
||
|
if (!@ids) {
|
||
|
$form->show_generic_error($locale->text('You have not selected any export.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
my @items = ();
|
||
|
|
||
|
foreach my $id (@ids) {
|
||
|
my $export = SL::SEPA->retrieve_export('id' => $id, 'details' => 1);
|
||
|
push @items, grep { !$_->{executed} } @{ $export->{items} } if ($export && !$export->{closed});
|
||
|
}
|
||
|
|
||
|
if (!@items) {
|
||
|
$form->show_generic_error($locale->text('All the selected exports have already been closed, or all of their items have already been executed.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
my $message_id = strftime('MSG%Y%m%d%H%M%S', localtime) . sprintf('%06d', $$);
|
||
|
|
||
|
my $sepa_xml = SL::SEPA::XML->new('company' => $myconfig->{company},
|
||
|
'src_charset' => $main::dbcharset || 'ISO-8859-15',
|
||
|
'message_id' => $message_id,
|
||
|
'grouped' => 1,
|
||
|
);
|
||
|
|
||
|
foreach my $item (@items) {
|
||
|
my $requested_execution_date;
|
||
|
if ($item->{requested_execution_date}) {
|
||
|
my ($yy, $mm, $dd) = $locale->parse_date($myconfig, $item->{requested_execution_date});
|
||
|
$requested_execution_date = sprintf '%04d-%02d-%02d', $yy, $mm, $dd;
|
||
|
}
|
||
|
|
||
|
$sepa_xml->add_transaction({ 'src_iban' => $item->{our_iban},
|
||
|
'src_bic' => $item->{our_bic},
|
||
|
'dst_iban' => $item->{vendor_iban},
|
||
|
'dst_bic' => $item->{vendor_bic},
|
||
|
'recipient' => $item->{vendor_name},
|
||
|
'amount' => $item->{amount},
|
||
|
'reference' => $item->{reference},
|
||
|
'execution_date' => $requested_execution_date,
|
||
|
'end_to_end_id' => $item->{end_to_end_id} });
|
||
|
}
|
||
|
|
||
|
my $xml = $sepa_xml->to_xml();
|
||
|
|
||
|
print $cgi->header('-type' => 'application/octet-stream',
|
||
|
'-content-disposition' => 'attachment; filename="SEPA_' . $message_id . '.cct"',
|
||
|
'-content-length' => length $xml);
|
||
|
print $xml;
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_mark_as_closed_step1 {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
my @export_ids = map { $_->{id} } grep { $_->{selected} } @{ $form->{exports} || [] };
|
||
|
|
||
|
if (!@export_ids) {
|
||
|
$form->show_generic_error($locale->text('You have not selected any export.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
my @open_export_ids = ();
|
||
|
foreach my $id (@export_ids) {
|
||
|
my $export = SL::SEPA->retrieve_export('id' => $id);
|
||
|
push @open_export_ids, $id if (!$export->{closed});
|
||
|
}
|
||
|
|
||
|
if (!@open_export_ids) {
|
||
|
$form->show_generic_error($locale->text('All of the exports you have selected were already closed.'), 'back_button' => 1);
|
||
|
}
|
||
|
|
||
|
$form->{title} = $locale->text('Close SEPA exports');
|
||
|
$form->header();
|
||
|
print $form->parse_html_template('sepa/bank_transfer_mark_as_closed_step1', { 'OPEN_EXPORT_IDS' => \@open_export_ids });
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub bank_transfer_mark_as_closed_step2 {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $form = $main::form;
|
||
|
my $locale = $main::locale;
|
||
|
|
||
|
map { SL::SEPA->close_export('id' => $_); } @{ $form->{open_export_ids} || [] };
|
||
|
|
||
|
$form->{title} = $locale->text('Close SEPA exports');
|
||
|
$form->header();
|
||
|
$form->show_generic_information($locale->text('The selected exports have been closed.'));
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
}
|
||
|
|
||
|
sub dispatcher {
|
||
|
my $form = $main::form;
|
||
|
|
||
|
foreach my $action (qw(bank_transfer_create bank_transfer_edit bank_transfer_list
|
||
|
bank_transfer_post_payments bank_transfer_download_sepa_xml
|
||
|
bank_transfer_mark_as_closed_step1 bank_transfer_mark_as_closed_step2
|
||
|
bank_transfer_payment_list_as_pdf)) {
|
||
|
if ($form->{"action_${action}"}) {
|
||
|
call_sub($action);
|
||
|
return;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
$form->error($main::locale->text('No action defined.'));
|
||
|
}
|
||
|
|
||
|
1;
|
||
| locale/de/all | ||
|---|---|---|
|
'Account deleted!' => 'Konto gel?scht!',
|
||
|
'Account for fees' => 'Konto für Gebühren',
|
||
Auch abrufbar als: Unified diff
Änderungen für den SEPA-Export