/SL/DATEV.pm - Annotieren - projekt kivitendo - wissen

| Zweig: | Markierung: | Revision:

kivitendo/SL/DATEV.pm @ 2746ccd0

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;

05c6840d	Moritz Bunkus	use utf8;
		use strict;
e20f3f0d	Moritz Bunkus
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;
05c6840d	Moritz Bunkus	use List::Util qw(max);
f8138d17	Moritz Bunkus	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+)$\|) {
8cd05ad6	Moritz Bunkus	$path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}";
f8138d17	Moritz Bunkus	}

		$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();

8cd05ad6	Moritz Bunkus	foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
f8138d17	Moritz Bunkus	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);

c510d88b	Sven Schöling	my $query = qq\|SELECT * FROM datev\|;
		my $sth = $dbh->prepare($query);
d319704a	Moritz Bunkus	$sth->execute \|\| $form->dberror($query);

c510d88b	Sven Schöling	my $ref = $sth->fetchrow_hashref("NAME_lc");
d319704a	Moritz Bunkus
		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);

c510d88b	Sven Schöling	my $query = qq\|DELETE FROM datev\|;
d319704a	Moritz Bunkus	$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\|)\|;
c510d88b	Sven Schöling	my $sth = $dbh->prepare($query);
d319704a	Moritz Bunkus	$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) = @_;
c510d88b	Sven Schöling	my ($fromto, $jahr, $leap);

		my $form = $main::form;
d319704a	Moritz Bunkus
		$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
c510d88b	Sven Schöling	my ($notsplitindex);
6683b7fb	Moritz Bunkus	my @errors = ();

a3501388	Moritz Bunkus	$form->{net_gross_differences} = [];
		$form->{sum_net_gross_differences} = 0;

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 =
6ff01fdb	Moritz Bunkus	qq\|SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey,
032e5fcd	Moritz Bunkus	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

6ff01fdb	Moritz Bunkus	SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey,
032e5fcd	Moritz Bunkus	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

6ff01fdb	Moritz Bunkus	SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey,
032e5fcd	Moritz Bunkus	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
6ff01fdb	Moritz Bunkus	ORDER BY trans_id, acc_trans_id\|;
032e5fcd	Moritz Bunkus
e20f3f0d	Moritz Bunkus	my $sth = prepare_execute_query($form, $dbh, $query);
5b94129b	Moritz Bunkus	$form->{DATEV} = [];
d319704a	Moritz Bunkus
bbd8da97	Moritz Bunkus	my $counter = 0;
c510d88b	Sven Schöling	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;
0802cc15	Sven Schöling	my $subcent = abs($count) < 0.02;
ea711360	Moritz Bunkus
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");
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");
b2945bf6	Sven Schöling	::end_of_request();
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
		&& (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) # and sign same as previous sign
		{
e20f3f0d	Moritz Bunkus	$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)) {
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	}
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
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 {
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	}

		push @{ $form->{DATEV} }, [ \%new_trans, $trans->[$j] ];
bf3b6966	Moritz Bunkus	push @taxed, $form->{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))) {
		push @errors, "Datev-Export fehlgeschlagen! Bei Transaktion $trans->[0]->{trans_id} ($absumsatz)\n";

		} elsif (abs($absumsatz) >= 0.01) {
		push @{ $form->{net_gross_differences} }, $absumsatz;
		$form->{sum_net_gross_differences} += $absumsatz;
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) = @_;
c510d88b	Sven Schöling	my ($primanota);
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) = @_;

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();

		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 {
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();

		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";
c510d88b	Sven Schöling	my @ed_versionset;
d319704a	Moritz Bunkus	my $fileno = 0;
081a4f97	Moritz Bunkus
43550a3d	Stephan Köhler	$form->header;
		print qq\|
		<html>
		<body>Export in Bearbeitung<br>
		Buchungssätze verarbeitet:
		\|;
d319704a	Moritz Bunkus
c510d88b	Sven Schöling	my ($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);
c510d88b	Sven Schöling	my $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) {
c510d88b	Sven Schöling	my $transaction = shift @{ $form->{DATEV} };
		my $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;
c510d88b	Sven Schöling	my ($haben, $soll);
05c6840d	Moritz Bunkus	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');
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
c510d88b	Sven Schöling	foreach my $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
05e6d940	Jan Büren	# 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?
		#
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();

7274f9c8	Sven Schöling	open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
40d52f50	Moritz Bunkus	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
c510d88b	Sven Schöling	my $ev_header = &make_ev_header($form, $fileno);
		my $ev_filename = $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);
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";
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++;
		my $ed_filename = $export_path . $filename;
39f3d12c	Moritz Bunkus	push(@filenames, $filename);
7274f9c8	Sven Schöling	open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
c510d88b	Sven Schöling	my $header = &make_kne_data_header($myconfig, $form, "");
d319704a	Moritz Bunkus	$remaining_bytes -= length($header);

c510d88b	Sven Schöling	my $fuellzeichen;
		our $fromto;

d319704a	Moritz Bunkus	# 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};
		}

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

		my $sth = $dbh->prepare($query);
		$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] =
		&make_ed_versionset($header, $filename, $blockcount, $fromto);

c510d88b	Sven Schöling	my $ev_header = &make_ev_header($form, $fileno);
		my $ev_filename = $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);

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

Projekt

Allgemein

Profil

projekt kivitendo