Projekt

Allgemein

Profil

Herunterladen (47,5 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/DATEV.pm @ 63410aa6

d319704a Moritz Bunkus
#=====================================================================
008c2e15 Moritz Bunkus
# kivitendo ERP
d319704a Moritz Bunkus
# Copyright (c) 2004
#
# Author: Philip Reetz
# Email: p.reetz@linet-services.de
# Web: http://www.lx-office.org
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
f7b15d43 Christian Wittmer
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1335, USA.
d319704a Moritz Bunkus
#======================================================================
#
# Datev export module
#======================================================================

631b4c04 Sven Schöling
package SL::DATEV;
d319704a Moritz Bunkus
05c6840d Moritz Bunkus
use utf8;
use strict;
e20f3f0d Moritz Bunkus
032e5fcd Moritz Bunkus
use SL::DBUtils;
40d52f50 Moritz Bunkus
use SL::DATEV::KNEFile;
040aa711 Sven Schöling
use SL::DB;
00b6dc22 Sven Schöling
use SL::HTML::Util ();
28fc2476 Sven Schöling
use SL::Locale::String qw(t8);
032e5fcd Moritz Bunkus
d319704a Moritz Bunkus
use Data::Dumper;
631b4c04 Sven Schöling
use DateTime;
use Exporter qw(import);
f8138d17 Moritz Bunkus
use File::Path;
00b6dc22 Sven Schöling
use IO::File;
use List::MoreUtils qw(any);
use List::Util qw(min max sum);
use List::UtilsBy qw(partition_by sort_by);
use Text::CSV_XS;
f8138d17 Moritz Bunkus
use Time::HiRes qw(gettimeofday);

631b4c04 Sven Schöling
{
my $i = 0;
use constant {
DATEV_ET_BUCHUNGEN => $i++,
DATEV_ET_STAMM => $i++,
00b6dc22 Sven Schöling
DATEV_ET_CSV => $i++,
631b4c04 Sven Schöling
DATEV_FORMAT_KNE => $i++,
DATEV_FORMAT_OBE => $i++,
b14b1780 Geoffrey Richardson
DATEV_FORMAT_CSV => $i++,
631b4c04 Sven Schöling
};
}

b14b1780 Geoffrey Richardson
my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV);
631b4c04 Sven Schöling
our @EXPORT_OK = (@export_constants);
our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);


sub new {
my $class = shift;
my %data = @_;

my $obj = bless {}, $class;

$obj->$_($data{$_}) for keys %data;

$obj;
}

sub exporttype {
my $self = shift;
$self->{exporttype} = $_[0] if @_;
return $self->{exporttype};
}

sub has_exporttype {
defined $_[0]->{exporttype};
}

sub format {
my $self = shift;
$self->{format} = $_[0] if @_;
return $self->{format};
}

sub has_format {
defined $_[0]->{format};
}

f8138d17 Moritz Bunkus
sub _get_export_path {
$main::lxdebug->enter_sub();

my ($a, $b) = gettimeofday();
631b4c04 Sven Schöling
my $path = _get_path_for_download_token("${a}-${b}-${$}");
f8138d17 Moritz Bunkus
mkpath($path) unless (-d $path);

$main::lxdebug->leave_sub();

return $path;
}

631b4c04 Sven Schöling
sub _get_path_for_download_token {
f8138d17 Moritz Bunkus
$main::lxdebug->enter_sub();

631b4c04 Sven Schöling
my $token = shift || '';
f8138d17 Moritz Bunkus
my $path;

if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
631b4c04 Sven Schöling
$path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
f8138d17 Moritz Bunkus
}

$main::lxdebug->leave_sub();

return $path;
}

631b4c04 Sven Schöling
sub _get_download_token_for_path {
f8138d17 Moritz Bunkus
$main::lxdebug->enter_sub();

my $path = shift;
my $token;

if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
$token = "${1}-${2}-${3}";
}

$main::lxdebug->leave_sub();

return $token;
}

631b4c04 Sven Schöling
sub download_token {
my $self = shift;
$self->{download_token} = $_[0] if @_;
return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
}

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

return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
}

sub add_filenames {
my $self = shift;
push @{ $self->{filenames} ||= [] }, @_;
}

sub filenames {
return @{ $_[0]{filenames} || [] };
}

sub add_error {
my $self = shift;
push @{ $self->{errors} ||= [] }, @_;
}

sub errors {
return @{ $_[0]{errors} || [] };
}

sub add_net_gross_differences {
my $self = shift;
push @{ $self->{net_gross_differences} ||= [] }, @_;
}

sub net_gross_differences {
return @{ $_[0]{net_gross_differences} || [] };
}

sub sum_net_gross_differences {
return sum $_[0]->net_gross_differences;
}

sub from {
my $self = shift;

if (@_) {
$self->{from} = $_[0];
}

return $self->{from};
}

sub to {
my $self = shift;

if (@_) {
$self->{to} = $_[0];
}

return $self->{to};
}

e04c32d3 Niclas Zimmermann
sub trans_id {
my $self = shift;

if (@_) {
$self->{trans_id} = $_[0];
}

6a349447 Geoffrey Richardson
die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;

e04c32d3 Niclas Zimmermann
return $self->{trans_id};
}

631b4c04 Sven Schöling
sub accnofrom {
my $self = shift;

if (@_) {
$self->{accnofrom} = $_[0];
}

return $self->{accnofrom};
}

sub accnoto {
my $self = shift;

if (@_) {
$self->{accnoto} = $_[0];
}

return $self->{accnoto};
}


sub dbh {
my $self = shift;

if (@_) {
$self->{dbh} = $_[0];
$self->{provided_dbh} = 1;
}

040aa711 Sven Schöling
$self->{dbh} ||= SL::DB->client->dbh;
631b4c04 Sven Schöling
}

sub provided_dbh {
$_[0]{provided_dbh};
}

f8138d17 Moritz Bunkus
sub clean_temporary_directories {
631b4c04 Sven Schöling
$::lxdebug->enter_sub;
f8138d17 Moritz Bunkus
8cd05ad6 Moritz Bunkus
foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
631b4c04 Sven Schöling
next unless -d $path;
f8138d17 Moritz Bunkus
my $mtime = (stat($path))[9];
next if ((time() - $mtime) < 8 * 60 * 60);

rmtree $path;
}

631b4c04 Sven Schöling
$::lxdebug->leave_sub;
f8138d17 Moritz Bunkus
}
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
sub _fill {
$main::lxdebug->enter_sub();

f95864a1 Moritz Bunkus
my $text = shift // '';
7b31116b Moritz Bunkus
my $field_len = shift;
my $fill_char = shift;
my $alignment = shift || 'right';

f95864a1 Moritz Bunkus
my $text_len = length $text;
7b31116b Moritz Bunkus
if ($field_len < $text_len) {
$text = substr $text, 0, $field_len;

} elsif ($field_len > $text_len) {
my $filler = ($fill_char) x ($field_len - $text_len);
$text = $alignment eq 'right' ? $filler . $text : $text . $filler;
}

$main::lxdebug->leave_sub();

return $text;
}

d319704a Moritz Bunkus
sub get_datev_stamm {
631b4c04 Sven Schöling
return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
}
d319704a Moritz Bunkus
631b4c04 Sven Schöling
sub save_datev_stamm {
my ($self, $data) = @_;
d319704a Moritz Bunkus
040aa711 Sven Schöling
SL::DB->client->with_transaction(sub {
do_query($::form, $self->dbh, 'DELETE FROM datev');
d319704a Moritz Bunkus
040aa711 Sven Schöling
my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
d319704a Moritz Bunkus
040aa711 Sven Schöling
my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
6b23fb21 Sven Schöling
1;
}) or do { die SL::DB->client->error };
d319704a Moritz Bunkus
}

631b4c04 Sven Schöling
sub export {
my ($self) = @_;
my $result;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
die 'no format set!' unless $self->has_format;
d319704a Moritz Bunkus
61894a27 Geoffrey Richardson
if ($self->format == DATEV_FORMAT_CSV) {
b14b1780 Geoffrey Richardson
$result = $self->csv_export;
} elsif ($self->format == DATEV_FORMAT_KNE) {
631b4c04 Sven Schöling
$result = $self->kne_export;
} elsif ($self->format == DATEV_FORMAT_OBE) {
$result = $self->obe_export;
} else {
die 'unrecognized export format';
}

return $result;
d319704a Moritz Bunkus
}

sub kne_export {
631b4c04 Sven Schöling
my ($self) = @_;
f8138d17 Moritz Bunkus
my $result;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
die 'no exporttype set!' unless $self->has_exporttype;

if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
$result = $self->kne_buchungsexport;
} elsif ($self->exporttype == DATEV_ET_STAMM) {
$result = $self->kne_stammdatenexport;
00b6dc22 Sven Schöling
} elsif ($self->exporttype == DATEV_ET_CSV) {
$result = $self->csv_export_for_tax_accountant;
d319704a Moritz Bunkus
} else {
631b4c04 Sven Schöling
die 'unrecognized exporttype';
d319704a Moritz Bunkus
}

f8138d17 Moritz Bunkus
return $result;
d319704a Moritz Bunkus
}

b14b1780 Geoffrey Richardson
sub csv_export {
die 'not yet implemented';
}

d319704a Moritz Bunkus
sub obe_export {
631b4c04 Sven Schöling
die 'not yet implemented';
d319704a Moritz Bunkus
}

631b4c04 Sven Schöling
sub fromto {
my ($self) = @_;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
return unless $self->from && $self->to;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
d319704a Moritz Bunkus
}

e20f3f0d Moritz Bunkus
sub _sign {
631b4c04 Sven Schöling
$_[0] <=> 0;
e20f3f0d Moritz Bunkus
}

8b8570b3 Geoffrey Richardson
sub generate_datev_data {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();
00b6dc22 Sven Schöling
my ($self, %params) = @_;
975304c7 Sven Schöling
my $fromto = $params{from_to} // '';
00b6dc22 Sven Schöling
my $progress_callback = $params{progress_callback} || sub {};
d319704a Moritz Bunkus
ea711360 Moritz Bunkus
my $form = $main::form;
d319704a Moritz Bunkus
e04c32d3 Niclas Zimmermann
my $trans_id_filter = '';
975304c7 Sven Schöling
my $ar_department_id_filter = '';
my $ap_department_id_filter = '';
my $gl_department_id_filter = '';
c0f873c1 Geoffrey Richardson
if ( $form->{department_id} ) {
$ar_department_id_filter = " AND ar.department_id = ? ";
$ap_department_id_filter = " AND ap.department_id = ? ";
$gl_department_id_filter = " AND gl.department_id = ? ";
}
e04c32d3 Niclas Zimmermann
1a3b9961 Geoffrey Richardson
my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter);
if ( $form->{gldatefrom} ) {
$gl_itime_filter = " AND gl.itime >= ? ";
$ar_itime_filter = " AND ar.itime >= ? ";
$ap_itime_filter = " AND ap.itime >= ? ";
}

6a349447 Geoffrey Richardson
if ( $self->{trans_id} ) {
# ignore dates when trans_id is passed so that the entire transaction is
# checked, not just either the initial bookings or the subsequent payments
# (the transdates will likely differ)
$fromto = '';
$trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
} else {
$fromto =~ s/transdate/ac\.transdate/g;
};
e04c32d3 Niclas Zimmermann
c510d88b Sven Schöling
my ($notsplitindex);
a3501388 Moritz Bunkus
e20f3f0d Moritz Bunkus
my $filter = ''; # Useful for debugging purposes

631b4c04 Sven Schöling
my %all_taxchart_ids = selectall_as_map($form, $self->dbh, qq|SELECT DISTINCT chart_id, TRUE AS is_set FROM tax|, 'chart_id', 'is_set');
ea711360 Moritz Bunkus
my $query =
39fc1390 Sven Schöling
qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
470cd722 Sven Schöling
ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate, ar.itime::date,
00b6dc22 Sven Schöling
ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
9d2d867c Niclas Zimmermann
ar.invoice,
0e1c16fd Sven Schöling
t.rate AS taxrate, t.taxdescription,
ae278b58 Sven Schöling
'ar' as table,
00b6dc22 Sven Schöling
tc.accno AS tax_accno, tc.description AS tax_accname,
c0f873c1 Geoffrey Richardson
ar.department_id,
00b6dc22 Sven Schöling
ar.notes
e20f3f0d Moritz Bunkus
FROM acc_trans ac
LEFT JOIN ar ON (ac.trans_id = ar.id)
LEFT JOIN customer ct ON (ar.customer_id = ct.id)
LEFT JOIN chart c ON (ac.chart_id = c.id)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (ac.tax_id = t.id)
00b6dc22 Sven Schöling
LEFT JOIN chart tc ON (t.chart_id = tc.id)
e20f3f0d Moritz Bunkus
WHERE (ar.id IS NOT NULL)
AND $fromto
e04c32d3 Niclas Zimmermann
$trans_id_filter
1a3b9961 Geoffrey Richardson
$ar_itime_filter
c0f873c1 Geoffrey Richardson
$ar_department_id_filter
e20f3f0d Moritz Bunkus
$filter
032e5fcd Moritz Bunkus
UNION ALL

39fc1390 Sven Schöling
SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
470cd722 Sven Schöling
ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate, ap.itime::date,
00b6dc22 Sven Schöling
ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
9d2d867c Niclas Zimmermann
ap.invoice,
0e1c16fd Sven Schöling
t.rate AS taxrate, t.taxdescription,
ae278b58 Sven Schöling
'ap' as table,
00b6dc22 Sven Schöling
tc.accno AS tax_accno, tc.description AS tax_accname,
c0f873c1 Geoffrey Richardson
ap.department_id,
00b6dc22 Sven Schöling
ap.notes
e20f3f0d Moritz Bunkus
FROM acc_trans ac
LEFT JOIN ap ON (ac.trans_id = ap.id)
LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
LEFT JOIN chart c ON (ac.chart_id = c.id)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (ac.tax_id = t.id)
00b6dc22 Sven Schöling
LEFT JOIN chart tc ON (t.chart_id = tc.id)
e20f3f0d Moritz Bunkus
WHERE (ap.id IS NOT NULL)
AND $fromto
e04c32d3 Niclas Zimmermann
$trans_id_filter
1a3b9961 Geoffrey Richardson
$ap_itime_filter
c0f873c1 Geoffrey Richardson
$ap_department_id_filter
e20f3f0d Moritz Bunkus
$filter
032e5fcd Moritz Bunkus
UNION ALL

39fc1390 Sven Schöling
SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
470cd722 Sven Schöling
gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate, gl.itime::date,
00b6dc22 Sven Schöling
gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
9d2d867c Niclas Zimmermann
FALSE AS invoice,
0e1c16fd Sven Schöling
t.rate AS taxrate, t.taxdescription,
ae278b58 Sven Schöling
'gl' as table,
00b6dc22 Sven Schöling
tc.accno AS tax_accno, tc.description AS tax_accname,
c0f873c1 Geoffrey Richardson
gl.department_id,
00b6dc22 Sven Schöling
gl.notes
e20f3f0d Moritz Bunkus
FROM acc_trans ac
LEFT JOIN gl ON (ac.trans_id = gl.id)
LEFT JOIN chart c ON (ac.chart_id = c.id)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (ac.tax_id = t.id)
00b6dc22 Sven Schöling
LEFT JOIN chart tc ON (t.chart_id = tc.id)
e20f3f0d Moritz Bunkus
WHERE (gl.id IS NOT NULL)
AND $fromto
e04c32d3 Niclas Zimmermann
$trans_id_filter
1a3b9961 Geoffrey Richardson
$gl_itime_filter
c0f873c1 Geoffrey Richardson
$gl_department_id_filter
e20f3f0d Moritz Bunkus
$filter
032e5fcd Moritz Bunkus
6ff01fdb Moritz Bunkus
ORDER BY trans_id, acc_trans_id|;
032e5fcd Moritz Bunkus
c0f873c1 Geoffrey Richardson
my @query_args;
1a3b9961 Geoffrey Richardson
if ( $form->{gldatefrom} or $form->{department_id} ) {

for ( 1 .. 3 ) {
if ( $form->{gldatefrom} ) {
my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom});
die "illegal data" unless ref($glfromdate) eq 'DateTime';
push(@query_args, $glfromdate);
}
if ( $form->{department_id} ) {
push(@query_args, $form->{department_id});
}
}
c0f873c1 Geoffrey Richardson
}

my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
631b4c04 Sven Schöling
$self->{DATEV} = [];
d319704a Moritz Bunkus
bbd8da97 Moritz Bunkus
my $counter = 0;
6a349447 Geoffrey Richardson
my $continue = 1; #
my $name;
while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
last unless $ref; # for single transactions
43550a3d Stephan Köhler
$counter++;
if (($counter % 500) == 0) {
631b4c04 Sven Schöling
$progress_callback->($counter);
43550a3d Stephan Köhler
}

aea509f8 Moritz Bunkus
my $trans = [ $ref ];
ea711360 Moritz Bunkus
my $count = $ref->{amount};
my $firstrun = 1;
49db7a8e Geoffrey Richardson
# if the amount of a booking in a group is smaller than 0.02, any tax
# amounts will likely be smaller than 1 cent, so go into subcent mode
0802cc15 Sven Schöling
my $subcent = abs($count) < 0.02;
ea711360 Moritz Bunkus
49db7a8e Geoffrey Richardson
# records from acc_trans are ordered by trans_id and acc_trans_id
# first check for unbalanced ledger inside one trans_id
# there may be several groups inside a trans_id, e.g. the original booking and the payment
# each group individually should be exactly balanced and each group
# individually needs its own datev lines

# keep fetching new acc_trans lines until the end of a balanced group is reached
1071846d Sven Schöling
while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
c510d88b Sven Schöling
my $ref2 = $sth->fetchrow_hashref("NAME_lc");
6a349447 Geoffrey Richardson
unless ( $ref2 ) {
$continue = 0;
last;
};
ea711360 Moritz Bunkus
49db7a8e Geoffrey Richardson
# check if trans_id of current acc_trans line is still the same as the
6a349447 Geoffrey Richardson
# trans_id of the first line in group, i.e. we haven't finished a 0-group
# before moving on to the next trans_id, error will likely be in the old
# trans_id.
49db7a8e Geoffrey Richardson
e20f3f0d Moritz Bunkus
if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
6a349447 Geoffrey Richardson
require SL::DB::Manager::AccTransaction;
if ( $trans->[0]->{trans_id} ) {
28fc2476 Sven Schöling
my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
$self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
$acc_trans_obj->transaction_name, $ref2->{trans_id})
);
6a349447 Geoffrey Richardson
};
631b4c04 Sven Schöling
return;
e20f3f0d Moritz Bunkus
}

aea509f8 Moritz Bunkus
push @{ $trans }, $ref2;
ea711360 Moritz Bunkus
$count += $ref2->{amount};
$firstrun = 0;
d319704a Moritz Bunkus
}
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
foreach my $i (0 .. scalar(@{ $trans }) - 1) {
my $ref = $trans->[$i];
my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
if ( $all_taxchart_ids{$ref->{id}}
&& ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
&& ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
|| $ref->{invoice})) {
$ref->{is_tax} = 1;
}

1422e28a Geoffrey Richardson
if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
&& $ref->{is_tax} # that has "is_tax" set
&& !($prev_ref->{is_tax}) # previous line wasn't is_tax
c1f307ca Jan Büren
&& (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
e20f3f0d Moritz Bunkus
$trans->[$i - 1]->{tax_amount} = $ref->{amount};
}
}

ea711360 Moritz Bunkus
my $absumsatz = 0;
aea509f8 Moritz Bunkus
if (scalar(@{$trans}) <= 2) {
631b4c04 Sven Schöling
push @{ $self->{DATEV} }, $trans;
ea711360 Moritz Bunkus
next;
}

c2796317 Bernd Bleßmann
# determine at which array position the reference value (called absumsatz) is
49db7a8e Geoffrey Richardson
# and which amount it has

aea509f8 Moritz Bunkus
for my $j (0 .. (scalar(@{$trans}) - 1)) {
c2796317 Bernd Bleßmann
49db7a8e Geoffrey Richardson
# Three cases:
# 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed

# 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
# true, instead of absumsatz use link AR/AP (there should only be one
# entry)

# 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
# instead of absumsatz use link AR/AP (there should only be one, so jump
# out of search as soon as you find it )

# case 1 and 2
1422e28a Geoffrey Richardson
# for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
# for ap/ar bookings we can always search for AR/AP in link and use that
if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
aea509f8 Moritz Bunkus
$absumsatz = $trans->[$j]->{'amount'};
ea711360 Moritz Bunkus
$notsplitindex = $j;
d319704a Moritz Bunkus
}
49db7a8e Geoffrey Richardson
# case 3
# Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
# for AR and AP transaction exit the loop as soon as an AR or AP account is found
# there must be only one AR or AP chart in the booking
dd48c9b7 Sven Schöling
# since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
# manually pays an invoice in GL.
if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
49db7a8e Geoffrey Richardson
$notsplitindex = $j; # position in booking with highest amount
$absumsatz = $trans->[$j]->{'amount'};
last;
};
ea711360 Moritz Bunkus
}
bbd8da97 Moritz Bunkus
e20f3f0d Moritz Bunkus
my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
my $rounding_error = 0;
bf3b6966 Moritz Bunkus
my @taxed;
e20f3f0d Moritz Bunkus
49db7a8e Geoffrey Richardson
# go through each line and determine if it is a tax booking or not
# skip all tax lines and notsplitindex line
# push all other accounts (e.g. income or expense) with corresponding taxkey

aea509f8 Moritz Bunkus
for my $j (0 .. (scalar(@{$trans}) - 1)) {
ea711360 Moritz Bunkus
if ( ($j != $notsplitindex)
e20f3f0d Moritz Bunkus
&& !$trans->[$j]->{is_tax}
aea509f8 Moritz Bunkus
&& ( $trans->[$j]->{'taxkey'} eq ""
|| $trans->[$j]->{'taxkey'} eq "0"
|| $trans->[$j]->{'taxkey'} eq "1"
|| $trans->[$j]->{'taxkey'} eq "10"
|| $trans->[$j]->{'taxkey'} eq "11")) {
4c5ca4c0 Moritz Bunkus
my %new_trans = ();
map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
ea711360 Moritz Bunkus
aea509f8 Moritz Bunkus
$absumsatz += $trans->[$j]->{'amount'};
bbd8da97 Moritz Bunkus
$new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
$new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
aea509f8 Moritz Bunkus
$trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
ea711360 Moritz Bunkus
631b4c04 Sven Schöling
push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
} elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
ea711360 Moritz Bunkus
4c5ca4c0 Moritz Bunkus
my %new_trans = ();
map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
ea711360 Moritz Bunkus
9d2d867c Niclas Zimmermann
my $tax_rate = $trans->[$j]->{'taxrate'};
e20f3f0d Moritz Bunkus
$new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
$new_trans{'tax_rate'} = 1 + $tax_rate;
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
if (!$trans->[$j]->{'invoice'}) {
$new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
$new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
$trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
$absumsatz += -1 * $new_trans{'amount'};

} else {
474247d8 Moritz Bunkus
my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
e20f3f0d Moritz Bunkus
my $rounded = $form->round_amount($unrounded, 2);
474247d8 Moritz Bunkus
$rounding_error = $unrounded - $rounded;
e20f3f0d Moritz Bunkus
$new_trans{'amount'} = $rounded;
474247d8 Moritz Bunkus
$new_trans{'umsatz'} = abs($rounded) * $ml;
$trans->[$j]->{'umsatz'} = $new_trans{umsatz};
$absumsatz -= $rounded;
e20f3f0d Moritz Bunkus
}

631b4c04 Sven Schöling
push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
push @taxed, $self->{DATEV}->[-1];
e20f3f0d Moritz Bunkus
}
}

my $idx = 0;
my $correction = 0;
bf3b6966 Moritz Bunkus
while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
e20f3f0d Moritz Bunkus
if ($idx >= scalar @taxed) {
last if (!$correction);

$correction = 0;
$idx = 0;
d319704a Moritz Bunkus
}
e20f3f0d Moritz Bunkus
my $transaction = $taxed[$idx]->[0];

my $old_amount = $transaction->{amount};
my $old_correction = $correction;
my @possible_diffs;

if (!$transaction->{diff}) {
@possible_diffs = (0.01, -0.01);
} else {
@possible_diffs = ($transaction->{diff});
}

foreach my $diff (@possible_diffs) {
my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
next if ($net_amount != $transaction->{net_amount});

$transaction->{diff} = $diff;
$transaction->{amount} += $diff;
$transaction->{umsatz} += $diff;
$absumsatz -= $diff;
$correction = 1;

last;
}

$idx++;
d319704a Moritz Bunkus
}
ea711360 Moritz Bunkus
a3501388 Moritz Bunkus
$absumsatz = $form->round_amount($absumsatz, 2);
if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
6a349447 Geoffrey Richardson
require SL::DB::Manager::AccTransaction;
my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
28fc2476 Sven Schöling
$self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
$acc_trans_obj->transaction_name, $absumsatz)
);
a3501388 Moritz Bunkus
} elsif (abs($absumsatz) >= 0.01) {
631b4c04 Sven Schöling
$self->add_net_gross_differences($absumsatz);
ea711360 Moritz Bunkus
}
d319704a Moritz Bunkus
}
6683b7fb Moritz Bunkus
$sth->finish();

631b4c04 Sven Schöling
$::lxdebug->leave_sub;
d319704a Moritz Bunkus
}

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

631b4c04 Sven Schöling
my ($self, $form) = @_;
c510d88b Sven Schöling
my ($primanota);
d319704a Moritz Bunkus
631b4c04 Sven Schöling
my $stamm = $self->get_datev_stamm;

my $jahr = $self->from ? $self->from->year : DateTime->today->year;
d319704a Moritz Bunkus
#Header
7b31116b Moritz Bunkus
my $header = "\x1D\x181";
631b4c04 Sven Schöling
$header .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
$header .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
$header .= _fill($stamm->{dfvkz}, 2, '0');
$header .= _fill($stamm->{beraternr}, 7, '0');
$header .= _fill($stamm->{mandantennr}, 5, '0');
f95864a1 Moritz Bunkus
$header .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
d319704a Moritz Bunkus
631b4c04 Sven Schöling
$header .= $self->from ? $self->from->strftime('%d%m%y') : '';
$header .= $self->to ? $self->to->strftime('%d%m%y') : '';
d319704a Moritz Bunkus
631b4c04 Sven Schöling
if ($self->fromto) {
7b31116b Moritz Bunkus
$primanota = "001";
d319704a Moritz Bunkus
$header .= $primanota;
}

631b4c04 Sven Schöling
$header .= _fill($stamm->{passwort}, 4, '0');
7b31116b Moritz Bunkus
$header .= " " x 16; # Anwendungsinfo
$header .= " " x 16; # Inputinfo
d319704a Moritz Bunkus
$header .= "\x79";

#Versionssatz
631b4c04 Sven Schöling
my $versionssatz = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
my $query = qq|SELECT accno FROM chart LIMIT 1|;
631b4c04 Sven Schöling
my $ref = selectfirst_hashref_query($form, $self->dbh, $query);
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
$versionssatz .= length $ref->{accno};
$versionssatz .= ",";
$versionssatz .= length $ref->{accno};
$versionssatz .= ",SELF" . "\x1C\x79";
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
$header .= $versionssatz;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $header;
}

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

my ($date, $six) = @_;

c510d88b Sven Schöling
my ($day, $month, $year) = split(/\./, $date);
d319704a Moritz Bunkus
if ($day =~ /^0/) {
$day = substr($day, 1, 1);
}
if (length($month) < 2) {
$month = "0" . $month;
}
if (length($year) > 2) {
$year = substr($year, -2, 2);
}

if ($six) {
$date = $day . $month . $year;
} else {
$date = $day . $month;
}

$main::lxdebug->leave_sub();

return $date;
}

40d52f50 Moritz Bunkus
sub trim_leading_zeroes {
my $str = shift;
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
$str =~ s/^0+//g;
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
return $str;
d319704a Moritz Bunkus
}

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

631b4c04 Sven Schöling
my ($self, $header, $filename, $blockcount) = @_;
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
my $versionset = "V" . substr($filename, 2, 5);
$versionset .= substr($header, 6, 22);

631b4c04 Sven Schöling
if ($self->fromto) {
d319704a Moritz Bunkus
$versionset .= "0000" . substr($header, 28, 19);
} else {
c510d88b Sven Schöling
my $datum = " " x 16;
d319704a Moritz Bunkus
$versionset .= $datum . "001" . substr($header, 28, 4);
}
7b31116b Moritz Bunkus
$versionset .= _fill($blockcount, 5, '0');
d319704a Moritz Bunkus
$versionset .= "001";
7b31116b Moritz Bunkus
$versionset .= " 1";
d319704a Moritz Bunkus
$versionset .= substr($header, -12, 10) . " ";
7b31116b Moritz Bunkus
$versionset .= " " x 53;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $versionset;
}

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

631b4c04 Sven Schöling
my ($self, $form, $fileno) = @_;

my $stamm = $self->get_datev_stamm;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
my $ev_header = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
7b31116b Moritz Bunkus
$ev_header .= " ";
631b4c04 Sven Schöling
$ev_header .= _fill($stamm->{beraternr}, 7, ' ', 'left');
$ev_header .= _fill($stamm->{beratername}, 9, ' ', 'left');
7b31116b Moritz Bunkus
$ev_header .= " ";
$ev_header .= (_fill($fileno, 5, '0')) x 2;
$ev_header .= " " x 95;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $ev_header;
}

8b8570b3 Geoffrey Richardson
sub generate_datev_lines {
631b4c04 Sven Schöling
my ($self) = @_;

8b8570b3 Geoffrey Richardson
my @datev_lines = ();

foreach my $transaction ( @{ $self->{DATEV} } ) {

# each $transaction entry contains data from several acc_trans entries
# belonging to the same trans_id

my %datev_data = (); # data for one transaction
my $trans_lines = scalar(@{$transaction});

my $umsatz = 0;
my $gegenkonto = "";
my $konto = "";
my $belegfeld1 = "";
my $datum = "";
my $waehrung = "";
my $buchungstext = "";
my $belegfeld2 = "";
my $datevautomatik = 0;
my $taxkey = 0;
my $charttax = 0;
my $ustid ="";
my ($haben, $soll);
for (my $i = 0; $i < $trans_lines; $i++) {
if ($trans_lines == 2) {
if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
$umsatz = $transaction->[$i]->{'amount'};
d319704a Moritz Bunkus
}
8b8570b3 Geoffrey Richardson
} else {
if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
$umsatz = $transaction->[$i]->{'umsatz'};
d319704a Moritz Bunkus
}
}
8b8570b3 Geoffrey Richardson
if ($transaction->[$i]->{'datevautomatik'}) {
$datevautomatik = 1;
}
if ($transaction->[$i]->{'taxkey'}) {
$taxkey = $transaction->[$i]->{'taxkey'};
}
if ($transaction->[$i]->{'charttax'}) {
$charttax = $transaction->[$i]->{'charttax'};
}
if ($transaction->[$i]->{'amount'} > 0) {
$haben = $i;
} else {
$soll = $i;
}
}
d319704a Moritz Bunkus
8b8570b3 Geoffrey Richardson
if ($trans_lines >= 2) {
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
$datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
$datev_data{'konto'} = $transaction->[$soll]->{'accno'};
if ($transaction->[$haben]->{'invnumber'} ne "") {
$datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
d319704a Moritz Bunkus
}
8b8570b3 Geoffrey Richardson
$datev_data{datum} = $transaction->[$haben]->{'transdate'};
$datev_data{waehrung} = 'EUR';
d319704a Moritz Bunkus
8b8570b3 Geoffrey Richardson
if ($transaction->[$haben]->{'name'} ne "") {
$datev_data{buchungstext} = $transaction->[$haben]->{'name'};
}
if (($transaction->[$haben]->{'ustid'} // '') ne "") {
$datev_data{ustid} = $transaction->[$haben]->{'ustid'};
d319704a Moritz Bunkus
}
8b8570b3 Geoffrey Richardson
if (($transaction->[$haben]->{'duedate'} // '') ne "") {
$datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
}
}
d319704a Moritz Bunkus
8b8570b3 Geoffrey Richardson
$datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???

# Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
# Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
# wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
# Skript angelegt werden.
# Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
# Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
# von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
# DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
# acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
#

# only set buchungsschluessel if the following conditions are met:
if ( ( $datevautomatik || $taxkey)
&& (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
# $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
$datev_data{buchungsschluessel} = $taxkey;
d319704a Moritz Bunkus
}

8b8570b3 Geoffrey Richardson
push(@datev_lines, \%datev_data);
}
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
# example of modifying export data:
# foreach my $datev_line ( @datev_lines ) {
# if ( $datev_line{"konto"} eq '1234' ) {
# $datev_line{"konto"} = '9999';
# }
# }
#
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
return \@datev_lines;
}
3c147670 Geoffrey Richardson

8b8570b3 Geoffrey Richardson
sub kne_buchungsexport {
$main::lxdebug->enter_sub();
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
my ($self) = @_;
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
my $form = $::form;
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
my @filenames;

my $filename = "ED00001";
my $evfile = "EV01";
my @ed_versionset;
my $fileno = 1;
my $ed_filename = $self->export_path . $filename;
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
my $fromto = $self->fromto;

$self->generate_datev_data(from_to => $self->fromto); # fetches data from db, transforms data and fills $self->{DATEV}
return if $self->errors;
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
my @datev_lines = @{ $self->generate_datev_lines };
3c147670 Geoffrey Richardson

8b8570b3 Geoffrey Richardson
my $umsatzsumme = sum map { $_->{umsatz} } @datev_lines;

# prepare kne file, everything gets stored in ED00001
my $header = $self->make_kne_data_header($form);
my $kne_file = SL::DATEV::KNEFile->new();
$kne_file->add_block($header);

my $iconv = $::locale->{iconv_utf8};
my %umlaute = ($iconv->convert('ä') => 'ae',
$iconv->convert('ö') => 'oe',
$iconv->convert('ü') => 'ue',
$iconv->convert('Ä') => 'Ae',
$iconv->convert('Ö') => 'Oe',
$iconv->convert('Ü') => 'Ue',
$iconv->convert('ß') => 'sz');

# add the data from @datev_lines to the kne_file, formatting as needed
foreach my $kne ( @datev_lines ) {
$kne_file->add_block("+" . $kne_file->format_amount(abs($kne->{umsatz}), 0));

# only add buchungsschluessel if it was previously defined
$kne_file->add_block("\x6C" . $kne->{buchungsschluessel}) if defined $kne->{buchungsschluessel};

# ($kne->{gegenkonto}) = $kne->{gegenkonto} =~ /^(\d+)/;
$kne_file->add_block("a" . trim_leading_zeroes($kne->{gegenkonto}));

if ( $kne->{belegfeld1} ) {
my $invnumber = $kne->{belegfeld1};
3c147670 Geoffrey Richardson
foreach my $umlaut (keys(%umlaute)) {
8b8570b3 Geoffrey Richardson
$invnumber =~ s/${umlaut}/${umlaute{$umlaut}}/g;
3c147670 Geoffrey Richardson
}
8b8570b3 Geoffrey Richardson
$invnumber =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
$invnumber = substr($invnumber, 0, 12);
$invnumber =~ s/\ *$//;
$kne_file->add_block("\xBD" . $invnumber . "\x1C");
}
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
$kne_file->add_block("\xBE" . &datetofour($kne->{belegfeld2},1) . "\x1C");
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
$kne_file->add_block("d" . &datetofour($kne->{datum},0));
3c147670 Geoffrey Richardson
8b8570b3 Geoffrey Richardson
# ($kne->{konto}) = $kne->{konto} =~ /^(\d+)/;
$kne_file->add_block("e" . trim_leading_zeroes($kne->{konto}));
40d52f50 Moritz Bunkus
8b8570b3 Geoffrey Richardson
my $name = $kne->{buchungstext};
foreach my $umlaut (keys(%umlaute)) {
$name =~ s/${umlaut}/${umlaute{$umlaut}}/g;
}
$name =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
$name = substr($name, 0, 30);
$name =~ s/\ *$//;
$kne_file->add_block("\x1E" . $name . "\x1C");
40d52f50 Moritz Bunkus
8b8570b3 Geoffrey Richardson
$kne_file->add_block("\xBA" . $kne->{'ustid'} . "\x1C") if $kne->{'ustid'};
d319704a Moritz Bunkus
8b8570b3 Geoffrey Richardson
$kne_file->add_block("\xB3" . $kne->{'waehrung'} . "\x1C" . "\x79");
};

$umsatzsumme = $kne_file->format_amount(abs($umsatzsumme), 0);
my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";

$kne_file->add_block($mandantenendsumme);
$kne_file->flush();

open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
print(ED $kne_file->get_data());
close(ED);

$ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
d319704a Moritz Bunkus
#Make EV Verwaltungsdatei
8b8570b3 Geoffrey Richardson
my $ev_header = $self->make_ev_header($form, $fileno);
631b4c04 Sven Schöling
my $ev_filename = $self->export_path . $evfile;
39f3d12c Moritz Bunkus
push(@filenames, $evfile);
7274f9c8 Sven Schöling
open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
d319704a Moritz Bunkus
print(EV $ev_header);

c510d88b Sven Schöling
foreach my $file (@ed_versionset) {
c02626dc Moritz Bunkus
print(EV $file);
d319704a Moritz Bunkus
}
close(EV);
###
631b4c04 Sven Schöling
$self->add_filenames(@filenames);

d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
39f3d12c Moritz Bunkus
631b4c04 Sven Schöling
return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
d319704a Moritz Bunkus
}

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

631b4c04 Sven Schöling
my ($self) = @_;
my $form = $::form;
d319704a Moritz Bunkus
631b4c04 Sven Schöling
$self->get_datev_stamm->{abrechnungsnr} = "99";
39f3d12c Moritz Bunkus
my @filenames;

d319704a Moritz Bunkus
my $filename = "ED00000";
my $evfile = "EV01";
c510d88b Sven Schöling
my @ed_versionset;
d319704a Moritz Bunkus
my $fileno = 1;
my $i = 0;
my $blockcount = 1;
my $remaining_bytes = 256;
my $total_bytes = 256;
my $buchungssatz = "";
$filename++;
631b4c04 Sven Schöling
my $ed_filename = $self->export_path . $filename;
39f3d12c Moritz Bunkus
push(@filenames, $filename);
7274f9c8 Sven Schöling
open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
631b4c04 Sven Schöling
my $header = $self->make_kne_data_header($form);
d319704a Moritz Bunkus
$remaining_bytes -= length($header);

c510d88b Sven Schöling
my $fuellzeichen;
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
my (@where, @values) = ((), ());
631b4c04 Sven Schöling
if ($self->accnofrom) {
40d52f50 Moritz Bunkus
push @where, 'c.accno >= ?';
631b4c04 Sven Schöling
push @values, $self->accnofrom;
40d52f50 Moritz Bunkus
}
631b4c04 Sven Schöling
if ($self->accnoto) {
40d52f50 Moritz Bunkus
push @where, 'c.accno <= ?';
631b4c04 Sven Schöling
push @values, $self->accnoto;
40d52f50 Moritz Bunkus
}

74fca575 Sven Schöling
my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
my $query = qq|SELECT c.accno, c.description
FROM chart c
$where_str
ORDER BY c.accno|;

631b4c04 Sven Schöling
my $sth = $self->dbh->prepare($query);
40d52f50 Moritz Bunkus
$sth->execute(@values) || $form->dberror($query);
d319704a Moritz Bunkus
c510d88b Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
d319704a Moritz Bunkus
if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
$fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
$buchungssatz .= "\x00" x $fuellzeichen;
$blockcount++;
$total_bytes = ($blockcount) * 256;
}
$buchungssatz .= "t" . $ref->{'accno'};
$remaining_bytes = $total_bytes - length($buchungssatz . $header);
$ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
$ref->{'description'} = substr($ref->{'description'}, 0, 40);
$ref->{'description'} =~ s/\ *$//;

if (
($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
) <= 6
) {
$fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
$buchungssatz .= "\x00" x $fuellzeichen;
$blockcount++;
$total_bytes = ($blockcount) * 256;
}
$buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
$remaining_bytes = $total_bytes - length($buchungssatz . $header);
}

$sth->finish;
print(ED $header);
print(ED $buchungssatz);
$fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
c510d88b Sven Schöling
my $dateiende = "\x00" x $fuellzeichen;
d319704a Moritz Bunkus
print(ED "z");
print(ED $dateiende);
close(ED);

#Make EV Verwaltungsdatei
$ed_versionset[0] =
631b4c04 Sven Schöling
$self->make_ed_versionset($header, $filename, $blockcount);
d319704a Moritz Bunkus
631b4c04 Sven Schöling
my $ev_header = $self->make_ev_header($form, $fileno);
my $ev_filename = $self->export_path . $evfile;
39f3d12c Moritz Bunkus
push(@filenames, $evfile);
7274f9c8 Sven Schöling
open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
d319704a Moritz Bunkus
print(EV $ev_header);

c510d88b Sven Schöling
foreach my $file (@ed_versionset) {
d319704a Moritz Bunkus
print(EV $ed_versionset[$file]);
}
close(EV);

631b4c04 Sven Schöling
$self->add_filenames(@filenames);
39f3d12c Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
39f3d12c Moritz Bunkus
631b4c04 Sven Schöling
return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
}

00b6dc22 Sven Schöling
sub _format_accno {
my ($accno) = @_;
return $accno . ('0' x (6 - min(length($accno), 6)));
}

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

2bc33284 Geoffrey Richardson
$self->generate_datev_data(from_to => $self->fromto);
00b6dc22 Sven Schöling
foreach my $transaction (@{ $self->{DATEV} }) {
foreach my $entry (@{ $transaction }) {
$entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
}
}

my %transactions =
partition_by { $_->[0]->{table} }
sort_by { $_->[0]->{sortkey} }
grep { 2 == scalar(@{ $_ }) }
@{ $self->{DATEV} };

my %column_defs = (
acc_trans_id => { 'text' => $::locale->text('ID'), },
amount => { 'text' => $::locale->text('Amount'), },
credit_accname => { 'text' => $::locale->text('Credit Account Name'), },
credit_accno => { 'text' => $::locale->text('Credit Account'), },
debit_accname => { 'text' => $::locale->text('Debit Account Name'), },
debit_accno => { 'text' => $::locale->text('Debit Account'), },
invnumber => { 'text' => $::locale->text('Reference'), },
name => { 'text' => $::locale->text('Name'), },
notes => { 'text' => $::locale->text('Notes'), },
tax => { 'text' => $::locale->text('Tax'), },
taxkey => { 'text' => $::locale->text('Taxkey'), },
tax_accname => { 'text' => $::locale->text('Tax Account Name'), },
tax_accno => { 'text' => $::locale->text('Tax Account'), },
0070a250 Andreas Rudin
transdate => { 'text' => $::locale->text('Transdate'), },
00b6dc22 Sven Schöling
vcnumber => { 'text' => $::locale->text('Customer/Vendor Number'), },
);

my @columns = qw(
acc_trans_id name vcnumber
transdate invnumber amount
debit_accno debit_accname
credit_accno credit_accname
tax
tax_accno tax_accname taxkey
notes
);

my %filenames_by_type = (
ar => $::locale->text('AR Transactions'),
ap => $::locale->text('AP Transactions'),
gl => $::locale->text('GL Transactions'),
);

my @filenames;
foreach my $type (qw(ap ar)) {
my %csvs = (
invoices => {
content => '',
filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
csv => Text::CSV_XS->new({
binary => 1,
eol => "\n",
sep_char => ";",
}),
},
payments => {
content => '',
filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
csv => Text::CSV_XS->new({
binary => 1,
eol => "\n",
sep_char => ";",
}),
},
);

foreach my $csv (values %csvs) {
$csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
$csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);

push @filenames, $csv->{filename};
}

foreach my $transaction (@{ $transactions{$type} }) {
my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
my $csv = $is_payment ? $csvs{payments} : $csvs{invoices};

my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
my $amount = defined($soll->{net_amount}) ? $soll : $haben;
$haben->{notes} = ($haben->{memo} || $soll->{memo}) if $is_payment;
$haben->{notes} //= '';
$haben->{notes} = SL::HTML::Util->strip($haben->{notes});
$haben->{notes} =~ s{\r}{}g;
$haben->{notes} =~ s{\n+}{ }g;

my %row = (
amount => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
debit_accno => _format_accno($soll->{accno}),
debit_accname => $soll->{accname},
credit_accno => _format_accno($haben->{accno}),
credit_accname => $haben->{accname},
tax => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
notes => $haben->{notes},
(map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno)),
(map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
);

$csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
}

$_->{out}->close for values %csvs;
}

$self->add_filenames(@filenames);

return { download_token => $self->download_token, filenames => \@filenames };
}

631b4c04 Sven Schöling
sub DESTROY {
clean_temporary_directories();
d319704a Moritz Bunkus
}

1;
631b4c04 Sven Schöling
__END__

=encoding utf-8

=head1 NAME

008c2e15 Moritz Bunkus
SL::DATEV - kivitendo DATEV Export module
631b4c04 Sven Schöling
=head1 SYNOPSIS

use SL::DATEV qw(:CONSTANTS);

6a349447 Geoffrey Richardson
my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
631b4c04 Sven Schöling
my $datev = SL::DATEV->new(
exporttype => DATEV_ET_BUCHUNGEN,
format => DATEV_FORMAT_KNE,
from => $startdate,
to => $enddate,
);

6a349447 Geoffrey Richardson
# To only export transactions from a specific trans_id: (from and to are ignored)
my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
my $datev = SL::DATEV->new(
exporttype => DATEV_ET_BUCHUNGEN,
format => DATEV_FORMAT_KNE,
trans_id => $invoice->trans_id,
);

631b4c04 Sven Schöling
my $datev = SL::DATEV->new(
exporttype => DATEV_ET_STAMM,
format => DATEV_FORMAT_KNE,
accnofrom => $start_account_number,
accnoto => $end_account_number,
);

# get or set datev stamm
my $hashref = $datev->get_datev_stamm;
$datev->save_datev_stamm($hashref);

6a349447 Geoffrey Richardson
# manually clean up temporary directories older than 8 hours
631b4c04 Sven Schöling
$datev->clean_temporary_directories;

# export
$datev->export;

if ($datev->errors) {
die join "\n", $datev->error;
}

# get relevant data for saving the export:
my $dl_token = $datev->download_token;
my $path = $datev->export_path;
my @files = $datev->filenames;

# retrieving an export at a later time
my $datev = SL::DATEV->new(
download_token => $dl_token_from_user,
);

my $path = $datev->export_path;
my @files = glob("$path/*");

8b8570b3 Geoffrey Richardson
# Only test the datev data of a specific trans_id, without generating an
# export file, but filling $datev->errors if errors exist

my $datev = SL::DATEV->new(
trans_id => $invoice->trans_id,
);
$datev->generate_datev_data;
# if ($datev->errors) { ...


631b4c04 Sven Schöling
=head1 DESCRIPTION

This module implements the DATEV export standard. For usage see above.

=head1 FUNCTIONS

=over 4

=item new PARAMS

6a349447 Geoffrey Richardson
Generic constructor. See section attributes for information about what to pass.
631b4c04 Sven Schöling
8b8570b3 Geoffrey Richardson
=item generate_datev_data

Fetches all transactions from the database (via a trans_id or a date range),
and does an initial transformation (e.g. filters out tax, determines
the brutto amount, checks split transactions ...) and stores this data in
$self->{DATEV}.

If any errors are found these are collected in $self->errors.

This function is needed for all the exports, but can be also called
independently in order to check transactions for DATEV compatibility.

=item generate_datev_lines

Parse the data in $self->{DATEV} and transform it into a format that can be
used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...

The transformed data is returned as an arrayref, which is ready to be converted
to a DATEV data format, e.g. KNE, OBE, CSV, ...

At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
entries with datevautomatik have an empty taxkey, as the taxkey is already
determined by the chart.

631b4c04 Sven Schöling
=item get_datev_stamm

Loads DATEV Stammdaten and returns as hashref.

=item save_datev_stamm HASHREF

Saves DATEV Stammdaten from provided hashref.

=item exporttype

See L<CONSTANTS> for possible values

=item has_exporttype

Returns true if an exporttype has been set. Without exporttype most report functions won't work.

=item format

Specifies the designated format of the export. Currently only KNE export is implemented.

See L<CONSTANTS> for possible values

=item has_format

Returns true if a format has been set. Without format most report functions won't work.

=item download_token

Returns a download token for this DATEV object.

Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.

=item export_path

Returns an export_path for this DATEV object.

Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.

=item filenames

6a349447 Geoffrey Richardson
Returns a list of filenames generated by this DATEV object. This only works if the files were generated during its lifetime, not if the object was created from a download_token.
631b4c04 Sven Schöling
=item net_gross_differences

If there were any net gross differences during calculation they will be collected here.

=item sum_net_gross_differences

Sum of all differences.

=item clean_temporary_directories

Forces a garbage collection on previous exports which will delete all exports that are older than 8 hours. It will be automatically called on destruction of the object, but is advised to be called manually before delivering results of an export to the user.

=item errors

Returns a list of errors that occured. If no errors occured, the export was a success.

=item export

Exports data. You have to have set L<exporttype> and L<format> or an error will
occur. OBE exports are currently not implemented.

be4e1d78 Geoffrey Richardson
=item csv_export_for_tax_accountant

Generates up to four downloadable csv files containing data about sales and
purchase invoices, and their respective payments:

Example:
my $startdate = DateTime->new(year => 2012, month => 1, day => 1);
my $enddate = DateTime->new(year => 2012, month => 12, day => 31);
SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
# {
# 'download_token' => '1488551625-815654-22430',
# 'filenames' => [
# 'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
# 'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
# 'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
# 'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
# ]
# };

631b4c04 Sven Schöling
=back

=head1 ATTRIBUTES

This is a list of attributes set in either the C<new> or a method of the same name.

=over 4

=item dbh

Set a database handle to use in the process. This allows for an export to be
done on a transaction in progress without committing first.

040aa711 Sven Schöling
Note: If you don't want this code to commit, simply providing a dbh is not
enough enymore. You'll have to wrap the call into a transaction yourself, so
that the internal transaction does not commit.

631b4c04 Sven Schöling
=item exporttype

See L<CONSTANTS> for possible values. This MUST be set before export is called.

=item format

See L<CONSTANTS> for possible values. This MUST be set before export is called.

=item download_token

Can be set on creation to retrieve a prior export for download.

=item from

=item to

6a349447 Geoffrey Richardson
Set boundary dates for the export. Unless a trans_id is passed these MUST be
set for the export to work.

=item trans_id

To check only one gl/ar/ap transaction, pass the trans_id. The attributes
L<from> and L<to> are currently still needed for the query to be assembled
correctly.
631b4c04 Sven Schöling
=item accnofrom

=item accnoto

Set boundary account numbers for the export. Only useful for a stammdaten export.

=back

=head1 CONSTANTS

=head2 Supplied to L<exporttype>

=over 4

=item DATEV_ET_BUCHUNGEN

=item DATEV_ET_STAMM

=back

=head2 Supplied to L<format>.

=over 4

=item DATEV_FORMAT_KNE

=item DATEV_FORMAT_OBE

=back

=head1 ERROR HANDLING

This module will die in the following cases:

=over 4

=item *

No or unrecognized exporttype or format was provided for an export

=item *

6a349447 Geoffrey Richardson
OBE export was called, which is not yet implemented.
631b4c04 Sven Schöling
=item *

general I/O errors

=back

Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:

=over 4

=item *

C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.

=item *

C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
6a349447 Geoffrey Richardson
transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
631b4c04 Sven Schöling
=back

=head1 BUGS AND CAVEATS

=over 4

=item *

6a349447 Geoffrey Richardson
Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
631b4c04 Sven Schöling
=item *

OBE export is currently not implemented.

=back

=head1 TODO

- handling of export_path and download token is a bit dodgy, clean that up.

=head1 SEE ALSO

L<SL::DATEV::KNEFile>

=head1 AUTHORS

Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,

Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,

Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,

Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,

Stephan Köhler

=cut