Projekt

Allgemein

Profil

Herunterladen (27,7 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/DATEV.pm @ 450a0e2f

d319704a Moritz Bunkus
#=====================================================================
# Lx-Office ERP
# 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
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#======================================================================
#
# Datev export module
#======================================================================

package DATEV;

e20f3f0d Moritz Bunkus
use List::Util qw(max);

032e5fcd Moritz Bunkus
use SL::DBUtils;
40d52f50 Moritz Bunkus
use SL::DATEV::KNEFile;
e20f3f0d Moritz Bunkus
use SL::Taxkeys;
032e5fcd Moritz Bunkus
d319704a Moritz Bunkus
use Data::Dumper;
f8138d17 Moritz Bunkus
use File::Path;
use Time::HiRes qw(gettimeofday);

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

my ($a, $b) = gettimeofday();
my $path = get_path_for_download_token("${a}-${b}-${$}");

mkpath($path) unless (-d $path);

$main::lxdebug->leave_sub();

return $path;
}

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

my $token = shift;
my $path;

if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
$path = "${main::userspath}/datev-export-${1}-${2}-${3}";
}

$main::lxdebug->leave_sub();

return $path;
}

sub get_download_token_for_path {
$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;
}

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

foreach my $path (glob "${main::userspath}/datev-export-*") {
next unless (-d $path);

my $mtime = (stat($path))[9];
next if ((time() - $mtime) < 8 * 60 * 60);

rmtree $path;
}

$main::lxdebug->leave_sub();
}
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
sub _fill {
$main::lxdebug->enter_sub();

my $text = shift;
my $field_len = shift;
my $fill_char = shift;
my $alignment = shift || 'right';

my $text_len = length $text;

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 {
$main::lxdebug->enter_sub();

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

# connect to database
my $dbh = $form->dbconnect($myconfig);

$query = qq|SELECT * FROM datev|;
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);

my $ref = $sth->fetchrow_hashref(NAME_lc);

map { $form->{$_} = $ref->{$_} } keys %$ref;

$sth->finish;
$dbh->disconnect;
$main::lxdebug->leave_sub();
}

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

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

# connect to database
my $dbh = $form->dbconnect_noauto($myconfig);

$query = qq|DELETE FROM datev|;
$dbh->do($query) || $form->dberror($query);

$query = qq|INSERT INTO datev
(beraternr, beratername, dfvkz, mandantennr, datentraegernr, abrechnungsnr) VALUES
(|
. $dbh->quote($form->{beraternr}) . qq|,|
. $dbh->quote($form->{beratername}) . qq|,|
. $dbh->quote($form->{dfvkz}) . qq|,
|
. $dbh->quote($form->{mandantennr}) . qq|,|
. $dbh->quote($form->{datentraegernr}) . qq|,|
. $dbh->quote($form->{abrechnungsnr}) . qq|)|;
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
$sth->finish;

$dbh->commit;
$dbh->disconnect;
$main::lxdebug->leave_sub();
}

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

my ($self, $myconfig, $form) = @_;
f8138d17 Moritz Bunkus
my $result;
d319704a Moritz Bunkus
if ($form->{exporttype} == 0) {
f8138d17 Moritz Bunkus
$result = kne_buchungsexport($myconfig, $form);
d319704a Moritz Bunkus
} else {
f8138d17 Moritz Bunkus
$result = kne_stammdatenexport($myconfig, $form);
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();

f8138d17 Moritz Bunkus
return $result;
d319704a Moritz Bunkus
}

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

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

# connect to database
my $dbh = $form->dbconnect_noauto($myconfig);
$dbh->commit;
$dbh->disconnect;
$main::lxdebug->leave_sub();
}

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

my ($zeitraum, $monat, $quartal, $transdatefrom, $transdateto) = @_;

$fromto = "transdate >= ";

my @a = localtime;
$a[5] += 1900;
$jahr = $a[5];
if ($zeitraum eq "monat") {
SWITCH: {
$monat eq "1" && do {
$form->{fromdate} = "1.1.$jahr";
$form->{todate} = "31.1.$jahr";
last SWITCH;
};
$monat eq "2" && do {
$form->{fromdate} = "1.2.$jahr";

#this works from 1901 to 2099, 1900 and 2100 fail.
$leap = ($jahr % 4 == 0) ? "29" : "28";
$form->{todate} = "$leap.2.$jahr";
last SWITCH;
};
$monat eq "3" && do {
$form->{fromdate} = "1.3.$jahr";
$form->{todate} = "31.3.$jahr";
last SWITCH;
};
$monat eq "4" && do {
$form->{fromdate} = "1.4.$jahr";
$form->{todate} = "30.4.$jahr";
last SWITCH;
};
$monat eq "5" && do {
$form->{fromdate} = "1.5.$jahr";
$form->{todate} = "31.5.$jahr";
last SWITCH;
};
$monat eq "6" && do {
$form->{fromdate} = "1.6.$jahr";
$form->{todate} = "30.6.$jahr";
last SWITCH;
};
$monat eq "7" && do {
$form->{fromdate} = "1.7.$jahr";
$form->{todate} = "31.7.$jahr";
last SWITCH;
};
$monat eq "8" && do {
$form->{fromdate} = "1.8.$jahr";
$form->{todate} = "31.8.$jahr";
last SWITCH;
};
$monat eq "9" && do {
$form->{fromdate} = "1.9.$jahr";
$form->{todate} = "30.9.$jahr";
last SWITCH;
};
$monat eq "10" && do {
$form->{fromdate} = "1.10.$jahr";
$form->{todate} = "31.10.$jahr";
last SWITCH;
};
$monat eq "11" && do {
$form->{fromdate} = "1.11.$jahr";
$form->{todate} = "30.11.$jahr";
last SWITCH;
};
$monat eq "12" && do {
$form->{fromdate} = "1.12.$jahr";
$form->{todate} = "31.12.$jahr";
last SWITCH;
};
}
$fromto .=
"'" . $form->{fromdate} . "' and transdate <= '" . $form->{todate} . "'";
}

elsif ($zeitraum eq "quartal") {
if ($quartal == 1) {
$fromto .=
"'01.01." . $jahr . "' and transdate <= '31.03." . $jahr . "'";
} elsif ($quartal == 2) {
$fromto .=
"'01.04." . $jahr . "' and transdate <= '30.06." . $jahr . "'";
} elsif ($quartal == 3) {
$fromto .=
"'01.07." . $jahr . "' and transdate <= '30.09." . $jahr . "'";
} elsif ($quartal == 4) {
$fromto .=
"'01.10." . $jahr . "' and transdate <= '31.12." . $jahr . "'";
}
}

elsif ($zeitraum eq "zeit") {
5ad3a4a5 Moritz Bunkus
$fromto .= "'" . $transdatefrom . "' and transdate <= '" . $transdateto . "'";
my ($yy, $mm, $dd) = $main::locale->parse_date(\%main::myconfig, $transdatefrom);
$jahr = $yy;
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();

5ad3a4a5 Moritz Bunkus
return ($fromto, $jahr);
d319704a Moritz Bunkus
}

e20f3f0d Moritz Bunkus
sub _sign {
my $value = shift;

return $value < 0 ? -1
: $value > 0 ? 1
: 0;
}

ea711360 Moritz Bunkus
sub _get_transactions {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();

ea711360 Moritz Bunkus
my $fromto = shift;
d319704a Moritz Bunkus
ea711360 Moritz Bunkus
my $myconfig = \%main::myconfig;
my $form = $main::form;
d319704a Moritz Bunkus
ea711360 Moritz Bunkus
my $dbh = $form->get_standard_dbh($myconfig);
032e5fcd Moritz Bunkus
6683b7fb Moritz Bunkus
my @errors = ();

ea711360 Moritz Bunkus
$fromto =~ s/transdate/ac\.transdate/g;

e20f3f0d Moritz Bunkus
my $taxkeys = Taxkeys->new();
my $filter = ''; # Useful for debugging purposes

my %all_taxchart_ids = selectall_as_map($form, $dbh, qq|SELECT DISTINCT chart_id, TRUE AS is_set FROM tax|, 'chart_id', 'is_set');
ea711360 Moritz Bunkus
my $query =
032e5fcd Moritz Bunkus
qq|SELECT ac.oid, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey,
ar.invnumber, ar.duedate, ar.amount as umsatz,
ct.name,
e20f3f0d Moritz Bunkus
c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, c.link,
ar.invoice
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)
WHERE (ar.id IS NOT NULL)
AND $fromto
$filter
032e5fcd Moritz Bunkus
UNION ALL

SELECT ac.oid, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey,
ap.invnumber, ap.duedate, ap.amount as umsatz,
ct.name,
e20f3f0d Moritz Bunkus
c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, c.link,
ap.invoice
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)
WHERE (ap.id IS NOT NULL)
AND $fromto
$filter
032e5fcd Moritz Bunkus
UNION ALL

SELECT ac.oid, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey,
gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz,
gl.description AS name,
e20f3f0d Moritz Bunkus
c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, c.link,
FALSE AS invoice
FROM acc_trans ac
LEFT JOIN gl ON (ac.trans_id = gl.id)
LEFT JOIN chart c ON (ac.chart_id = c.id)
WHERE (gl.id IS NOT NULL)
AND $fromto
$filter
032e5fcd Moritz Bunkus
ORDER BY trans_id, oid|;

e20f3f0d Moritz Bunkus
my $sth = prepare_execute_query($form, $dbh, $query);
d319704a Moritz Bunkus
bbd8da97 Moritz Bunkus
my $counter = 0;
d319704a Moritz Bunkus
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
43550a3d Stephan Köhler
$counter++;
if (($counter % 500) == 0) {
print("$counter ");
}

aea509f8 Moritz Bunkus
my $trans = [ $ref ];
ea711360 Moritz Bunkus
my $count = $ref->{amount};
my $firstrun = 1;

d319704a Moritz Bunkus
while (abs($count) > 0.01 || $firstrun) {
ea711360 Moritz Bunkus
my $ref2 = $sth->fetchrow_hashref(NAME_lc);
d319704a Moritz Bunkus
last unless ($ref2);
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
$form->error("Unbalanced ledger! old trans_id " . $trans->[0]->{trans_id} . " new trans_id " . $ref2->{trans_id} . " count $count");
exit 1;
}

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;
}

if ( !$ref->{invoice}
&& $ref->{is_tax}
&& !($prev_ref->{is_tax})
&& (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) {
$trans->[$i - 1]->{tax_amount} = $ref->{amount};
}
}

da72a663 Philip Reetz
my %taxid_taxkeys = ();
ea711360 Moritz Bunkus
my $absumsatz = 0;
aea509f8 Moritz Bunkus
if (scalar(@{$trans}) <= 2) {
push @{ $form->{DATEV} }, $trans;
ea711360 Moritz Bunkus
next;
}

aea509f8 Moritz Bunkus
for my $j (0 .. (scalar(@{$trans}) - 1)) {
if (abs($trans->[$j]->{'amount'}) > abs($absumsatz)) {
$absumsatz = $trans->[$j]->{'amount'};
ea711360 Moritz Bunkus
$notsplitindex = $j;
d319704a Moritz Bunkus
}
ea711360 Moritz Bunkus
}
bbd8da97 Moritz Bunkus
e20f3f0d Moritz Bunkus
my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
my $rounding_error = 0;

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
e20f3f0d Moritz Bunkus
push @{ $form->{DATEV} }, [ \%new_trans, $trans->[$j] ];
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
} elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
my %tax_info = $taxkeys->get_full_tax_info('transdate' => $trans->[$j]->{transdate});
ea711360 Moritz Bunkus
4c5ca4c0 Moritz Bunkus
my %new_trans = ();
map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
ea711360 Moritz Bunkus
e20f3f0d Moritz Bunkus
my $tax_rate = $tax_info{taxkeys}->{ $trans->[$j]->{'taxkey'} }->{taxrate};
$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 {
my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1; # + $rounding_error;
my $rounded = $form->round_amount($unrounded, 2);
$rounding_error += $unrounded - $rounded;
$new_trans{'amount'} = $rounded;
$new_trans{'umsatz'} = abs($form->round_amount(($trans->[$j]->{'amount'} * (1 + $tax_rate)), 2)) * $ml;
$trans->[$j]->{'umsatz'} = abs($form->round_amount(($trans->[$j]->{'amount'} * (1 + $tax_rate)), 2)) * $ml;
$absumsatz += $form->round_amount($trans->[$j]->{'amount'} + $trans->[$j]->{'amount'} * $tax_rate, 2);
}

push @{ $form->{DATEV} }, [ \%new_trans, $trans->[$j] ];
}
}

my $idx = 0;
my $correction = 0;
while (abs($absumsatz) >= 0.01) {
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
e20f3f0d Moritz Bunkus
if (abs($absumsatz) >= 0.01) {
push @errors, "Datev-Export fehlgeschlagen! Bei Transaktion $trans->[0]->{trans_id} ($absumsatz, Rundungsfehler $rounding_error)\n";
ea711360 Moritz Bunkus
}
d319704a Moritz Bunkus
}
6683b7fb Moritz Bunkus
$sth->finish();

$form->error(join("<br>\n", @errors)) if (@errors);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

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

5ad3a4a5 Moritz Bunkus
my ($myconfig, $form, $fromto, $start_jahr) = @_;
d319704a Moritz Bunkus
5ad3a4a5 Moritz Bunkus
my $jahr = $start_jahr;
if (!$jahr) {
my @a = localtime;
$jahr = $a[5];
}
d319704a Moritz Bunkus
#Header
7b31116b Moritz Bunkus
my $header = "\x1D\x181";
e20f3f0d Moritz Bunkus
$header .= _fill($form->{datentraegernr}, 3, ' ', 'left');
7b31116b Moritz Bunkus
$header .= ($fromto) ? "11" : "13"; # Anwendungsnummer
$header .= _fill($form->{dfvkz}, 2, '0');
$header .= _fill($form->{beraternr}, 7, '0');
$header .= _fill($form->{mandantennr}, 5, '0');
$header .= _fill($form->{abrechnungsnr} . $jahr, 6, '0');

$fromto =~ s/transdate|>=|and|\'|<=//g;
my ($from, $to) = split / /, $fromto;
$from =~ s/ //g;
$to =~ s/ //g;
d319704a Moritz Bunkus
if ($from ne "") {
386994b1 Moritz Bunkus
my ($fday, $fmonth, $fyear) = split(/\./, $from);
d319704a Moritz Bunkus
if (length($fmonth) < 2) {
$fmonth = "0" . $fmonth;
}
if (length($fday) < 2) {
$fday = "0" . $fday;
}
$from = $fday . $fmonth . substr($fyear, -2, 2);
} else {
$from = "";
}

$header .= $from;

if ($to ne "") {
386994b1 Moritz Bunkus
my ($tday, $tmonth, $tyear) = split(/\./, $to);
d319704a Moritz Bunkus
if (length($tmonth) < 2) {
$tmonth = "0" . $tmonth;
}
if (length($tday) < 2) {
$tday = "0" . $tday;
}
$to = $tday . $tmonth . substr($tyear, -2, 2);
} else {
$to = "";
}
$header .= $to;
7b31116b Moritz Bunkus
d319704a Moritz Bunkus
if ($fromto ne "") {
7b31116b Moritz Bunkus
$primanota = "001";
d319704a Moritz Bunkus
$header .= $primanota;
}

7b31116b Moritz Bunkus
$header .= _fill($form->{passwort}, 4, '0');
$header .= " " x 16; # Anwendungsinfo
$header .= " " x 16; # Inputinfo
d319704a Moritz Bunkus
$header .= "\x79";

#Versionssatz
7b31116b Moritz Bunkus
my $versionssatz = $form->{exporttype} == 0 ? "\xB5" . "1," : "\xB6" . "1,";
d319704a Moritz Bunkus
7b31116b Moritz Bunkus
my $dbh = $form->get_standard_dbh($myconfig);
my $query = qq|SELECT accno FROM chart LIMIT 1|;
my $ref = selectfirst_hashref_query($form, $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) = @_;

386994b1 Moritz Bunkus
($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();

my ($header, $filename, $blockcount, $fromto) = @_;

7b31116b Moritz Bunkus
my $versionset = "V" . substr($filename, 2, 5);
$versionset .= substr($header, 6, 22);

d319704a Moritz Bunkus
if ($fromto ne "") {
$versionset .= "0000" . substr($header, 28, 19);
} else {
7b31116b Moritz Bunkus
$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();

my ($form, $fileno) = @_;

7b31116b Moritz Bunkus
my $ev_header = _fill($form->{datentraegernr}, 3, ' ', 'left');
$ev_header .= " ";
$ev_header .= _fill($form->{beraternr}, 7, ' ', 'left');
$ev_header .= _fill($form->{beratername}, 9, ' ', 'left');
$ev_header .= " ";
$ev_header .= (_fill($fileno, 5, '0')) x 2;
$ev_header .= " " x 95;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $ev_header;
}

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

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

39f3d12c Moritz Bunkus
my @filenames;

f8138d17 Moritz Bunkus
my $export_path = _get_export_path() . "/";
d319704a Moritz Bunkus
my $filename = "ED00000";
my $evfile = "EV01";
my @ed_versionsets;
my $fileno = 0;
081a4f97 Moritz Bunkus
43550a3d Stephan Köhler
$form->header;
print qq|
<html>
<body>Export in Bearbeitung<br>
Buchungss&auml;tze verarbeitet:
|;
d319704a Moritz Bunkus
5ad3a4a5 Moritz Bunkus
($fromto, $start_jahr) =
d319704a Moritz Bunkus
&get_dates($form->{zeitraum}, $form->{monat},
$form->{quartal}, $form->{transdatefrom},
$form->{transdateto});
ea711360 Moritz Bunkus
_get_transactions($fromto);
43550a3d Stephan Köhler
my $counter = 0;
print qq|<br>2. Durchlauf:|;
d319704a Moritz Bunkus
while (scalar(@{ $form->{DATEV} })) {
40d52f50 Moritz Bunkus
my $umsatzsumme = 0;
d319704a Moritz Bunkus
$filename++;
my $ed_filename = $export_path . $filename;
39f3d12c Moritz Bunkus
push(@filenames, $filename);
5ad3a4a5 Moritz Bunkus
$header = &make_kne_data_header($myconfig, $form, $fromto, $start_jahr);
40d52f50 Moritz Bunkus
my $kne_file = SL::DATEV::KNEFile->new();
$kne_file->add_block($header);
d319704a Moritz Bunkus
while (scalar(@{ $form->{DATEV} }) > 0) {
081a4f97 Moritz Bunkus
$transaction = shift @{ $form->{DATEV} };
$trans_lines = scalar(@{$transaction});
43550a3d Stephan Köhler
$counter++;
if (($counter % 500) == 0) {
print("$counter ");
}

40d52f50 Moritz Bunkus
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;
e20f3f0d Moritz Bunkus
my $iconv = $main::locale->{iconv_iso8859};
my %umlaute = ($iconv->convert('?') => 'ae',
$iconv->convert('?') => 'oe',
$iconv->convert('?') => 'ue',
$iconv->convert('?') => 'Ae',
$iconv->convert('?') => 'Oe',
$iconv->convert('?') => 'Ue',
$iconv->convert('?') => 'sz');
d319704a Moritz Bunkus
for (my $i = 0; $i < $trans_lines; $i++) {
d1731f0c Stephan Köhler
if ($trans_lines == 2) {
if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
$umsatz = $transaction->[$i]->{'amount'};
}
} else {
if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
$umsatz = $transaction->[$i]->{'umsatz'};
}
d319704a Moritz Bunkus
}
if ($transaction->[$i]->{'datevautomatik'}) {
$datevautomatik = 1;
}
if ($transaction->[$i]->{'taxkey'}) {
$taxkey = $transaction->[$i]->{'taxkey'};
}
if ($transaction->[$i]->{'charttax'}) {
$charttax = $transaction->[$i]->{'charttax'};
}
e20f3f0d Moritz Bunkus
if ($transaction->[$i]->{'amount'} > 0) {
d319704a Moritz Bunkus
$haben = $i;
40d52f50 Moritz Bunkus
} else {
d319704a Moritz Bunkus
$soll = $i;
}
}

# Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
foreach $umlaut (keys(%umlaute)) {
40d52f50 Moritz Bunkus
$transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
$transaction->[$haben]->{'name'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
d319704a Moritz Bunkus
}

$transaction->[$haben]->{'invnumber'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
40d52f50 Moritz Bunkus
$transaction->[$haben]->{'name'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
$transaction->[$haben]->{'invnumber'} = substr($transaction->[$haben]->{'invnumber'}, 0, 12);
$transaction->[$haben]->{'name'} = substr($transaction->[$haben]->{'name'}, 0, 30);
d319704a Moritz Bunkus
$transaction->[$haben]->{'invnumber'} =~ s/\ *$//;
$transaction->[$haben]->{'name'} =~ s/\ *$//;

if ($trans_lines >= 2) {

40d52f50 Moritz Bunkus
$gegenkonto = "a" . trim_leading_zeroes($transaction->[$haben]->{'accno'});
$konto = "e" . trim_leading_zeroes($transaction->[$soll]->{'accno'});
d319704a Moritz Bunkus
if ($transaction->[$haben]->{'invnumber'} ne "") {
40d52f50 Moritz Bunkus
$belegfeld1 = "\xBD" . $transaction->[$haben]->{'invnumber'} . "\x1C";
d319704a Moritz Bunkus
}
$datum = "d";
$datum .= &datetofour($transaction->[$haben]->{'transdate'}, 0);
$waehrung = "\xB3" . "EUR" . "\x1C";
if ($transaction->[$haben]->{'name'} ne "") {
$buchungstext = "\x1E" . $transaction->[$haben]->{'name'} . "\x1C";
}
if ($transaction->[$haben]->{'duedate'} ne "") {
40d52f50 Moritz Bunkus
$belegfeld2 = "\xBE" . &datetofour($transaction->[$haben]->{'duedate'}, 1) . "\x1C";
d319704a Moritz Bunkus
}
}

40d52f50 Moritz Bunkus
$umsatz = $kne_file->format_amount(abs($umsatz), 0);
$umsatzsumme += $umsatz;
$kne_file->add_block("+" . $umsatz);
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
if ( ( $datevautomatik || $taxkey)
&& (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
e20f3f0d Moritz Bunkus
# $kne_file->add_block("\x6C" . (!$datevautomatik ? $taxkey : "4"));
$kne_file->add_block("\x6C${taxkey}");
d319704a Moritz Bunkus
}

40d52f50 Moritz Bunkus
$kne_file->add_block($gegenkonto);
$kne_file->add_block($belegfeld1);
$kne_file->add_block($belegfeld2);
$kne_file->add_block($datum);
$kne_file->add_block($konto);
$kne_file->add_block($buchungstext);
$kne_file->add_block($waehrung . "\x79");
d319704a Moritz Bunkus
}

40d52f50 Moritz Bunkus
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());
d319704a Moritz Bunkus
close(ED);

40d52f50 Moritz Bunkus
$ed_versionset[$fileno] = &make_ed_versionset($header, $filename, $kne_file->get_block_count(), $fromto);
d319704a Moritz Bunkus
$fileno++;
}

#Make EV Verwaltungsdatei
$ev_header = &make_ev_header($form, $fileno);
$ev_filename = $export_path . $evfile;
39f3d12c Moritz Bunkus
push(@filenames, $evfile);
d319704a Moritz Bunkus
open(EV, "> $ev_filename") or die "can't open outputfile: EV01\n";
print(EV $ev_header);

foreach $file (@ed_versionset) {
print(EV $ed_versionset[$file]);
}
close(EV);
39f3d12c Moritz Bunkus
print qq|<br>Done. <br>
43550a3d Stephan Köhler
|;
d319704a Moritz Bunkus
###
$main::lxdebug->leave_sub();
39f3d12c Moritz Bunkus
f8138d17 Moritz Bunkus
return { 'download_token' => get_download_token_for_path($export_path), 'filenames' => \@filenames };
d319704a Moritz Bunkus
}

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

my ($myconfig, $form) = @_;
$form->{abrechnungsnr} = "99";

39f3d12c Moritz Bunkus
$form->header;
print qq|
<html>
<body>Export in Bearbeitung<br>
|;

my @filenames;

f8138d17 Moritz Bunkus
my $export_path = _get_export_path() . "/";
d319704a Moritz Bunkus
my $filename = "ED00000";
my $evfile = "EV01";
my @ed_versionsets;
my $fileno = 1;
my $i = 0;
my $blockcount = 1;
my $remaining_bytes = 256;
my $total_bytes = 256;
my $buchungssatz = "";
$filename++;
my $ed_filename = $export_path . $filename;
39f3d12c Moritz Bunkus
push(@filenames, $filename);
d319704a Moritz Bunkus
open(ED, "> $ed_filename") or die "can't open outputfile: $!\n";
$header = &make_kne_data_header($myconfig, $form, "");
$remaining_bytes -= length($header);

# connect to database
my $dbh = $form->dbconnect($myconfig);

40d52f50 Moritz Bunkus
my (@where, @values) = ((), ());
if ($form->{accnofrom}) {
push @where, 'c.accno >= ?';
push @values, $form->{accnofrom};
}
if ($form->{accnoto}) {
push @where, 'c.accno <= ?';
push @values, $form->{accnoto};
}

my $where_str = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (scalar @where);
d319704a Moritz Bunkus
40d52f50 Moritz Bunkus
my $query = qq|SELECT c.accno, c.description
FROM chart c
$where_str
ORDER BY c.accno|;

my $sth = $dbh->prepare($query);
$sth->execute(@values) || $form->dberror($query);
d319704a Moritz Bunkus
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
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);
$dateiende = "\x00" x $fuellzeichen;
print(ED "z");
print(ED $dateiende);
close(ED);

#Make EV Verwaltungsdatei
$ed_versionset[0] =
&make_ed_versionset($header, $filename, $blockcount, $fromto);

$ev_header = &make_ev_header($form, $fileno);
$ev_filename = $export_path . $evfile;
39f3d12c Moritz Bunkus
push(@filenames, $evfile);
d319704a Moritz Bunkus
open(EV, "> $ev_filename") or die "can't open outputfile: EV01\n";
print(EV $ev_header);

foreach $file (@ed_versionset) {
print(EV $ed_versionset[$file]);
}
close(EV);

$dbh->disconnect;
###

39f3d12c Moritz Bunkus
print qq|<br>Done. <br>
|;

d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
39f3d12c Moritz Bunkus
f8138d17 Moritz Bunkus
return { 'download_token' => get_download_token_for_path($export_path), 'filenames' => \@filenames };
d319704a Moritz Bunkus
}

1;