1 #=====================================================================
6 # Email: p.reetz@linet-services.de
7 # Web: http://www.lx-office.org
10 # This program is free software; you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 2 of the License, or
13 # (at your option) any later version.
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
23 #======================================================================
26 #======================================================================
34 use SL::DATEV::KNEFile;
36 use SL::HTML::Util ();
37 use SL::Locale::String qw(t8);
41 use Exporter qw(import);
44 use List::MoreUtils qw(any);
45 use List::Util qw(min max sum);
46 use List::UtilsBy qw(partition_by sort_by);
48 use Time::HiRes qw(gettimeofday);
53 DATEV_ET_BUCHUNGEN => $i++,
54 DATEV_ET_STAMM => $i++,
57 DATEV_FORMAT_KNE => $i++,
58 DATEV_FORMAT_OBE => $i++,
62 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE);
63 our @EXPORT_OK = (@export_constants);
64 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
71 my $obj = bless {}, $class;
73 $obj->$_($data{$_}) for keys %data;
80 $self->{exporttype} = $_[0] if @_;
81 return $self->{exporttype};
85 defined $_[0]->{exporttype};
90 $self->{format} = $_[0] if @_;
91 return $self->{format};
95 defined $_[0]->{format};
98 sub _get_export_path {
99 $main::lxdebug->enter_sub();
101 my ($a, $b) = gettimeofday();
102 my $path = _get_path_for_download_token("${a}-${b}-${$}");
104 mkpath($path) unless (-d $path);
106 $main::lxdebug->leave_sub();
111 sub _get_path_for_download_token {
112 $main::lxdebug->enter_sub();
114 my $token = shift || '';
117 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
118 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
121 $main::lxdebug->leave_sub();
126 sub _get_download_token_for_path {
127 $main::lxdebug->enter_sub();
132 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
133 $token = "${1}-${2}-${3}";
136 $main::lxdebug->leave_sub();
143 $self->{download_token} = $_[0] if @_;
144 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
150 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
155 push @{ $self->{filenames} ||= [] }, @_;
159 return @{ $_[0]{filenames} || [] };
164 push @{ $self->{errors} ||= [] }, @_;
168 return @{ $_[0]{errors} || [] };
171 sub add_net_gross_differences {
173 push @{ $self->{net_gross_differences} ||= [] }, @_;
176 sub net_gross_differences {
177 return @{ $_[0]{net_gross_differences} || [] };
180 sub sum_net_gross_differences {
181 return sum $_[0]->net_gross_differences;
188 $self->{from} = $_[0];
191 return $self->{from};
208 $self->{trans_id} = $_[0];
211 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
213 return $self->{trans_id};
220 $self->{accnofrom} = $_[0];
223 return $self->{accnofrom};
230 $self->{accnoto} = $_[0];
233 return $self->{accnoto};
241 $self->{dbh} = $_[0];
242 $self->{provided_dbh} = 1;
245 $self->{dbh} ||= SL::DB->client->dbh;
252 sub clean_temporary_directories {
253 $::lxdebug->enter_sub;
255 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
256 next unless -d $path;
258 my $mtime = (stat($path))[9];
259 next if ((time() - $mtime) < 8 * 60 * 60);
264 $::lxdebug->leave_sub;
268 $main::lxdebug->enter_sub();
270 my $text = shift // '';
271 my $field_len = shift;
272 my $fill_char = shift;
273 my $alignment = shift || 'right';
275 my $text_len = length $text;
277 if ($field_len < $text_len) {
278 $text = substr $text, 0, $field_len;
280 } elsif ($field_len > $text_len) {
281 my $filler = ($fill_char) x ($field_len - $text_len);
282 $text = $alignment eq 'right' ? $filler . $text : $text . $filler;
285 $main::lxdebug->leave_sub();
290 sub get_datev_stamm {
291 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
294 sub save_datev_stamm {
295 my ($self, $data) = @_;
297 SL::DB->client->with_transaction(sub {
298 do_query($::form, $self->dbh, 'DELETE FROM datev');
300 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
302 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
303 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
305 }) or do { die SL::DB->client->error };
312 die 'no format set!' unless $self->has_format;
314 if ($self->format == DATEV_FORMAT_KNE) {
315 $result = $self->kne_export;
316 } elsif ($self->format == DATEV_FORMAT_OBE) {
317 $result = $self->obe_export;
319 die 'unrecognized export format';
329 die 'no exporttype set!' unless $self->has_exporttype;
331 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
332 $result = $self->kne_buchungsexport;
333 } elsif ($self->exporttype == DATEV_ET_STAMM) {
334 $result = $self->kne_stammdatenexport;
335 } elsif ($self->exporttype == DATEV_ET_CSV) {
336 $result = $self->csv_export_for_tax_accountant;
338 die 'unrecognized exporttype';
345 die 'not yet implemented';
351 return unless $self->from && $self->to;
353 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
360 sub _get_transactions {
361 $main::lxdebug->enter_sub();
363 my ($self, %params) = @_;
364 my $fromto = $params{from_to};
365 my $progress_callback = $params{progress_callback} || sub {};
367 my $form = $main::form;
369 my $trans_id_filter = '';
371 if ( $self->{trans_id} ) {
372 # ignore dates when trans_id is passed so that the entire transaction is
373 # checked, not just either the initial bookings or the subsequent payments
374 # (the transdates will likely differ)
376 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
378 $fromto =~ s/transdate/ac\.transdate/g;
383 my $filter = ''; # Useful for debugging purposes
385 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');
388 qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
389 ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate, ar.itime::date,
390 ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
391 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
393 t.rate AS taxrate, t.taxdescription,
395 tc.accno AS tax_accno, tc.description AS tax_accname,
398 LEFT JOIN ar ON (ac.trans_id = ar.id)
399 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
400 LEFT JOIN chart c ON (ac.chart_id = c.id)
401 LEFT JOIN tax t ON (ac.tax_id = t.id)
402 LEFT JOIN chart tc ON (t.chart_id = tc.id)
403 WHERE (ar.id IS NOT NULL)
410 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
411 ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate, ap.itime::date,
412 ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
413 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
415 t.rate AS taxrate, t.taxdescription,
417 tc.accno AS tax_accno, tc.description AS tax_accname,
420 LEFT JOIN ap ON (ac.trans_id = ap.id)
421 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
422 LEFT JOIN chart c ON (ac.chart_id = c.id)
423 LEFT JOIN tax t ON (ac.tax_id = t.id)
424 LEFT JOIN chart tc ON (t.chart_id = tc.id)
425 WHERE (ap.id IS NOT NULL)
432 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
433 gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate, gl.itime::date,
434 gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
435 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
437 t.rate AS taxrate, t.taxdescription,
439 tc.accno AS tax_accno, tc.description AS tax_accname,
442 LEFT JOIN gl ON (ac.trans_id = gl.id)
443 LEFT JOIN chart c ON (ac.chart_id = c.id)
444 LEFT JOIN tax t ON (ac.tax_id = t.id)
445 LEFT JOIN chart tc ON (t.chart_id = tc.id)
446 WHERE (gl.id IS NOT NULL)
451 ORDER BY trans_id, acc_trans_id|;
453 my $sth = prepare_execute_query($form, $self->dbh, $query);
459 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
460 last unless $ref; # for single transactions
462 if (($counter % 500) == 0) {
463 $progress_callback->($counter);
466 my $trans = [ $ref ];
468 my $count = $ref->{amount};
471 # if the amount of a booking in a group is smaller than 0.02, any tax
472 # amounts will likely be smaller than 1 cent, so go into subcent mode
473 my $subcent = abs($count) < 0.02;
475 # records from acc_trans are ordered by trans_id and acc_trans_id
476 # first check for unbalanced ledger inside one trans_id
477 # there may be several groups inside a trans_id, e.g. the original booking and the payment
478 # each group individually should be exactly balanced and each group
479 # individually needs its own datev lines
481 # keep fetching new acc_trans lines until the end of a balanced group is reached
482 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
483 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
489 # check if trans_id of current acc_trans line is still the same as the
490 # trans_id of the first line in group, i.e. we haven't finished a 0-group
491 # before moving on to the next trans_id, error will likely be in the old
494 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
495 require SL::DB::Manager::AccTransaction;
496 if ( $trans->[0]->{trans_id} ) {
497 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
498 $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
499 $acc_trans_obj->transaction_name, $ref2->{trans_id})
505 push @{ $trans }, $ref2;
507 $count += $ref2->{amount};
511 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
512 my $ref = $trans->[$i];
513 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
514 if ( $all_taxchart_ids{$ref->{id}}
515 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
516 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
517 || $ref->{invoice})) {
521 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
522 && $ref->{is_tax} # that has "is_tax" set
523 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
524 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
525 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
530 if (scalar(@{$trans}) <= 2) {
531 push @{ $self->{DATEV} }, $trans;
535 # determine at which array position the reference value (called absumsatz) is
536 # and which amount it has
538 for my $j (0 .. (scalar(@{$trans}) - 1)) {
541 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
543 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
544 # true, instead of absumsatz use link AR/AP (there should only be one
547 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
548 # instead of absumsatz use link AR/AP (there should only be one, so jump
549 # out of search as soon as you find it )
552 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
553 # for ap/ar bookings we can always search for AR/AP in link and use that
554 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
555 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
556 $absumsatz = $trans->[$j]->{'amount'};
561 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
562 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
563 # there must be only one AR or AP chart in the booking
564 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
565 # manually pays an invoice in GL.
566 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
567 $notsplitindex = $j; # position in booking with highest amount
568 $absumsatz = $trans->[$j]->{'amount'};
573 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
574 my $rounding_error = 0;
577 # go through each line and determine if it is a tax booking or not
578 # skip all tax lines and notsplitindex line
579 # push all other accounts (e.g. income or expense) with corresponding taxkey
581 for my $j (0 .. (scalar(@{$trans}) - 1)) {
582 if ( ($j != $notsplitindex)
583 && !$trans->[$j]->{is_tax}
584 && ( $trans->[$j]->{'taxkey'} eq ""
585 || $trans->[$j]->{'taxkey'} eq "0"
586 || $trans->[$j]->{'taxkey'} eq "1"
587 || $trans->[$j]->{'taxkey'} eq "10"
588 || $trans->[$j]->{'taxkey'} eq "11")) {
590 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
592 $absumsatz += $trans->[$j]->{'amount'};
593 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
594 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
595 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
597 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
599 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
602 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
604 my $tax_rate = $trans->[$j]->{'taxrate'};
605 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
606 $new_trans{'tax_rate'} = 1 + $tax_rate;
608 if (!$trans->[$j]->{'invoice'}) {
609 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
610 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
611 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
612 $absumsatz += -1 * $new_trans{'amount'};
615 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
616 my $rounded = $form->round_amount($unrounded, 2);
618 $rounding_error = $unrounded - $rounded;
619 $new_trans{'amount'} = $rounded;
620 $new_trans{'umsatz'} = abs($rounded) * $ml;
621 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
622 $absumsatz -= $rounded;
625 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
626 push @taxed, $self->{DATEV}->[-1];
632 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
633 if ($idx >= scalar @taxed) {
634 last if (!$correction);
640 my $transaction = $taxed[$idx]->[0];
642 my $old_amount = $transaction->{amount};
643 my $old_correction = $correction;
646 if (!$transaction->{diff}) {
647 @possible_diffs = (0.01, -0.01);
649 @possible_diffs = ($transaction->{diff});
652 foreach my $diff (@possible_diffs) {
653 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
654 next if ($net_amount != $transaction->{net_amount});
656 $transaction->{diff} = $diff;
657 $transaction->{amount} += $diff;
658 $transaction->{umsatz} += $diff;
668 $absumsatz = $form->round_amount($absumsatz, 2);
669 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
670 require SL::DB::Manager::AccTransaction;
671 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
672 $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
673 $acc_trans_obj->transaction_name, $absumsatz)
675 } elsif (abs($absumsatz) >= 0.01) {
676 $self->add_net_gross_differences($absumsatz);
682 $::lxdebug->leave_sub;
685 sub make_kne_data_header {
686 $main::lxdebug->enter_sub();
688 my ($self, $form) = @_;
691 my $stamm = $self->get_datev_stamm;
693 my $jahr = $self->from ? $self->from->year : DateTime->today->year;
696 my $header = "\x1D\x181";
697 $header .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
698 $header .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
699 $header .= _fill($stamm->{dfvkz}, 2, '0');
700 $header .= _fill($stamm->{beraternr}, 7, '0');
701 $header .= _fill($stamm->{mandantennr}, 5, '0');
702 $header .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
704 $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
705 $header .= $self->to ? $self->to->strftime('%d%m%y') : '';
709 $header .= $primanota;
712 $header .= _fill($stamm->{passwort}, 4, '0');
713 $header .= " " x 16; # Anwendungsinfo
714 $header .= " " x 16; # Inputinfo
718 my $versionssatz = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
720 my $query = qq|SELECT accno FROM chart LIMIT 1|;
721 my $ref = selectfirst_hashref_query($form, $self->dbh, $query);
723 $versionssatz .= length $ref->{accno};
724 $versionssatz .= ",";
725 $versionssatz .= length $ref->{accno};
726 $versionssatz .= ",SELF" . "\x1C\x79";
728 $header .= $versionssatz;
730 $main::lxdebug->leave_sub();
736 $main::lxdebug->enter_sub();
738 my ($date, $six) = @_;
740 my ($day, $month, $year) = split(/\./, $date);
743 $day = substr($day, 1, 1);
745 if (length($month) < 2) {
746 $month = "0" . $month;
748 if (length($year) > 2) {
749 $year = substr($year, -2, 2);
753 $date = $day . $month . $year;
755 $date = $day . $month;
758 $main::lxdebug->leave_sub();
763 sub trim_leading_zeroes {
771 sub make_ed_versionset {
772 $main::lxdebug->enter_sub();
774 my ($self, $header, $filename, $blockcount) = @_;
776 my $versionset = "V" . substr($filename, 2, 5);
777 $versionset .= substr($header, 6, 22);
780 $versionset .= "0000" . substr($header, 28, 19);
782 my $datum = " " x 16;
783 $versionset .= $datum . "001" . substr($header, 28, 4);
786 $versionset .= _fill($blockcount, 5, '0');
787 $versionset .= "001";
789 $versionset .= substr($header, -12, 10) . " ";
790 $versionset .= " " x 53;
792 $main::lxdebug->leave_sub();
798 $main::lxdebug->enter_sub();
800 my ($self, $form, $fileno) = @_;
802 my $stamm = $self->get_datev_stamm;
804 my $ev_header = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
806 $ev_header .= _fill($stamm->{beraternr}, 7, ' ', 'left');
807 $ev_header .= _fill($stamm->{beratername}, 9, ' ', 'left');
809 $ev_header .= (_fill($fileno, 5, '0')) x 2;
810 $ev_header .= " " x 95;
812 $main::lxdebug->leave_sub();
817 sub kne_buchungsexport {
818 $main::lxdebug->enter_sub();
826 my $filename = "ED00000";
831 my $fromto = $self->fromto;
833 $self->_get_transactions(from_to => $fromto);
835 return if $self->errors;
839 while (scalar(@{ $self->{DATEV} || [] })) {
842 my $ed_filename = $self->export_path . $filename;
843 push(@filenames, $filename);
845 # transform $self->{DATEV} into an array of hashrefs containing all the
846 # necessary information for the actual DATEV export, storing it in @kne_lines.
848 while (scalar(@{ $self->{DATEV} }) > 0) {
850 my $transaction = shift @{ $self->{DATEV} };
851 my $trans_lines = scalar(@{$transaction});
860 my $buchungstext = "";
862 my $datevautomatik = 0;
867 for (my $i = 0; $i < $trans_lines; $i++) {
868 if ($trans_lines == 2) {
869 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
870 $umsatz = $transaction->[$i]->{'amount'};
873 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
874 $umsatz = $transaction->[$i]->{'umsatz'};
877 if ($transaction->[$i]->{'datevautomatik'}) {
880 if ($transaction->[$i]->{'taxkey'}) {
881 $taxkey = $transaction->[$i]->{'taxkey'};
883 if ($transaction->[$i]->{'charttax'}) {
884 $charttax = $transaction->[$i]->{'charttax'};
886 if ($transaction->[$i]->{'amount'} > 0) {
893 if ($trans_lines >= 2) {
895 $kne_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
896 $kne_data{'konto'} = $transaction->[$soll]->{'accno'};
897 if ($transaction->[$haben]->{'invnumber'} ne "") {
898 $kne_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
900 $kne_data{datum} = $transaction->[$haben]->{'transdate'};
901 $kne_data{waehrung} = 'EUR';
903 if ($transaction->[$haben]->{'name'} ne "") {
904 $kne_data{buchungstext} = $transaction->[$haben]->{'name'};
906 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
907 $kne_data{ustid} = $transaction->[$haben]->{'ustid'};
909 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
910 $kne_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
914 $kne_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
915 $umsatzsumme += $kne_data{umsatz}; #umsatz; # add the abs amount
917 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
918 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
919 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
920 # Skript angelegt werden.
921 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
922 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
923 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
924 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
925 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
928 # only set buchungsschluessel if the following conditions are met:
929 if ( ( $datevautomatik || $taxkey)
930 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
931 # $kne_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
932 $kne_data{buchungsschluessel} = $taxkey;
935 push(@kne_lines, \%kne_data);
938 # the data in @kne_lines is now ready to be transformed to a kne file, or even to csv
940 my $iconv = $::locale->{iconv_utf8};
941 my %umlaute = ($iconv->convert('ä') => 'ae',
942 $iconv->convert('ö') => 'oe',
943 $iconv->convert('ü') => 'ue',
944 $iconv->convert('Ä') => 'Ae',
945 $iconv->convert('Ö') => 'Oe',
946 $iconv->convert('Ü') => 'Ue',
947 $iconv->convert('ß') => 'sz');
949 my $header = $self->make_kne_data_header($form);
951 my $kne_file = SL::DATEV::KNEFile->new();
952 $kne_file->add_block($header);
953 # add the data from @kne_lines to the kne_file, formatting as needed
954 foreach my $kne (@kne_lines) {
956 $kne_file->add_block("+" . $kne_file->format_amount(abs($kne->{umsatz}), 0));
958 # only add buchungsschluessel if it was previously defined
959 $kne_file->add_block("\x6C" . $kne->{buchungsschluessel}) if defined $kne->{buchungsschluessel};
961 # ($kne->{gegenkonto}) = $kne->{gegenkonto} =~ /^(\d+)/;
962 $kne_file->add_block("a" . trim_leading_zeroes($kne->{gegenkonto}));
964 if ( $kne->{belegfeld1} ) {
965 my $invnumber = $kne->{belegfeld1};
966 foreach my $umlaut (keys(%umlaute)) {
967 $invnumber =~ s/${umlaut}/${umlaute{$umlaut}}/g;
969 $invnumber =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
970 $invnumber = substr($invnumber, 0, 12);
971 $invnumber =~ s/\ *$//;
972 $kne_file->add_block("\xBD" . $invnumber . "\x1C");
975 $kne_file->add_block("\xBE" . &datetofour($kne->{belegfeld2},1) . "\x1C");
977 $kne_file->add_block("d" . &datetofour($kne->{datum},0));
979 # ($kne->{konto}) = $kne->{konto} =~ /^(\d+)/;
980 $kne_file->add_block("e" . trim_leading_zeroes($kne->{konto}));
982 my $name = $kne->{buchungstext};
983 foreach my $umlaut (keys(%umlaute)) {
984 $name =~ s/${umlaut}/${umlaute{$umlaut}}/g;
986 $name =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
987 $name = substr($name, 0, 30);
989 $kne_file->add_block("\x1E" . $name . "\x1C");
991 $kne_file->add_block("\xBA" . $kne->{'ustid'} . "\x1C") if $kne->{'ustid'};
993 $kne_file->add_block("\xB3" . $kne->{'waehrung'} . "\x1C" . "\x79");
996 $umsatzsumme = $kne_file->format_amount(abs($umsatzsumme), 0);
997 my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
999 $kne_file->add_block($mandantenendsumme);
1002 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1003 print(ED $kne_file->get_data());
1006 $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
1010 #Make EV Verwaltungsdatei
1011 my $ev_header = $self->make_ev_header($form, $fileno);
1012 my $ev_filename = $self->export_path . $evfile;
1013 push(@filenames, $evfile);
1014 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1015 print(EV $ev_header);
1017 foreach my $file (@ed_versionset) {
1023 $self->add_filenames(@filenames);
1025 $main::lxdebug->leave_sub();
1027 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1030 sub kne_stammdatenexport {
1031 $main::lxdebug->enter_sub();
1036 $self->get_datev_stamm->{abrechnungsnr} = "99";
1040 my $filename = "ED00000";
1041 my $evfile = "EV01";
1046 my $remaining_bytes = 256;
1047 my $total_bytes = 256;
1048 my $buchungssatz = "";
1050 my $ed_filename = $self->export_path . $filename;
1051 push(@filenames, $filename);
1052 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1053 my $header = $self->make_kne_data_header($form);
1054 $remaining_bytes -= length($header);
1058 my (@where, @values) = ((), ());
1059 if ($self->accnofrom) {
1060 push @where, 'c.accno >= ?';
1061 push @values, $self->accnofrom;
1063 if ($self->accnoto) {
1064 push @where, 'c.accno <= ?';
1065 push @values, $self->accnoto;
1068 my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1070 my $query = qq|SELECT c.accno, c.description
1075 my $sth = $self->dbh->prepare($query);
1076 $sth->execute(@values) || $form->dberror($query);
1078 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1079 if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1080 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1081 $buchungssatz .= "\x00" x $fuellzeichen;
1083 $total_bytes = ($blockcount) * 256;
1085 $buchungssatz .= "t" . $ref->{'accno'};
1086 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1087 $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1088 $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1089 $ref->{'description'} =~ s/\ *$//;
1092 ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1095 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1096 $buchungssatz .= "\x00" x $fuellzeichen;
1098 $total_bytes = ($blockcount) * 256;
1100 $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1101 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1106 print(ED $buchungssatz);
1107 $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1108 my $dateiende = "\x00" x $fuellzeichen;
1110 print(ED $dateiende);
1113 #Make EV Verwaltungsdatei
1115 $self->make_ed_versionset($header, $filename, $blockcount);
1117 my $ev_header = $self->make_ev_header($form, $fileno);
1118 my $ev_filename = $self->export_path . $evfile;
1119 push(@filenames, $evfile);
1120 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1121 print(EV $ev_header);
1123 foreach my $file (@ed_versionset) {
1124 print(EV $ed_versionset[$file]);
1128 $self->add_filenames(@filenames);
1130 $main::lxdebug->leave_sub();
1132 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1137 return $accno . ('0' x (6 - min(length($accno), 6)));
1140 sub csv_export_for_tax_accountant {
1143 $self->_get_transactions(from_to => $self->fromto);
1145 foreach my $transaction (@{ $self->{DATEV} }) {
1146 foreach my $entry (@{ $transaction }) {
1147 $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1152 partition_by { $_->[0]->{table} }
1153 sort_by { $_->[0]->{sortkey} }
1154 grep { 2 == scalar(@{ $_ }) }
1155 @{ $self->{DATEV} };
1158 acc_trans_id => { 'text' => $::locale->text('ID'), },
1159 amount => { 'text' => $::locale->text('Amount'), },
1160 credit_accname => { 'text' => $::locale->text('Credit Account Name'), },
1161 credit_accno => { 'text' => $::locale->text('Credit Account'), },
1162 debit_accname => { 'text' => $::locale->text('Debit Account Name'), },
1163 debit_accno => { 'text' => $::locale->text('Debit Account'), },
1164 invnumber => { 'text' => $::locale->text('Reference'), },
1165 name => { 'text' => $::locale->text('Name'), },
1166 notes => { 'text' => $::locale->text('Notes'), },
1167 tax => { 'text' => $::locale->text('Tax'), },
1168 taxkey => { 'text' => $::locale->text('Taxkey'), },
1169 tax_accname => { 'text' => $::locale->text('Tax Account Name'), },
1170 tax_accno => { 'text' => $::locale->text('Tax Account'), },
1171 transdate => { 'text' => $::locale->text('Invoice Date'), },
1172 vcnumber => { 'text' => $::locale->text('Customer/Vendor Number'), },
1176 acc_trans_id name vcnumber
1177 transdate invnumber amount
1178 debit_accno debit_accname
1179 credit_accno credit_accname
1181 tax_accno tax_accname taxkey
1185 my %filenames_by_type = (
1186 ar => $::locale->text('AR Transactions'),
1187 ap => $::locale->text('AP Transactions'),
1188 gl => $::locale->text('GL Transactions'),
1192 foreach my $type (qw(ap ar)) {
1196 filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1197 csv => Text::CSV_XS->new({
1205 filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1206 csv => Text::CSV_XS->new({
1214 foreach my $csv (values %csvs) {
1215 $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1216 $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1218 push @filenames, $csv->{filename};
1221 foreach my $transaction (@{ $transactions{$type} }) {
1222 my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1223 my $csv = $is_payment ? $csvs{payments} : $csvs{invoices};
1225 my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1226 my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
1227 my $amount = defined($soll->{net_amount}) ? $soll : $haben;
1228 $haben->{notes} = ($haben->{memo} || $soll->{memo}) if $is_payment;
1229 $haben->{notes} //= '';
1230 $haben->{notes} = SL::HTML::Util->strip($haben->{notes});
1231 $haben->{notes} =~ s{\r}{}g;
1232 $haben->{notes} =~ s{\n+}{ }g;
1235 amount => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1236 debit_accno => _format_accno($soll->{accno}),
1237 debit_accname => $soll->{accname},
1238 credit_accno => _format_accno($haben->{accno}),
1239 credit_accname => $haben->{accname},
1240 tax => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1241 notes => $haben->{notes},
1242 (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno)),
1243 (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1246 $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1249 $_->{out}->close for values %csvs;
1252 $self->add_filenames(@filenames);
1254 return { download_token => $self->download_token, filenames => \@filenames };
1258 clean_temporary_directories();
1269 SL::DATEV - kivitendo DATEV Export module
1273 use SL::DATEV qw(:CONSTANTS);
1275 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1276 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1277 my $datev = SL::DATEV->new(
1278 exporttype => DATEV_ET_BUCHUNGEN,
1279 format => DATEV_FORMAT_KNE,
1284 # To only export transactions from a specific trans_id: (from and to are ignored)
1285 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1286 my $datev = SL::DATEV->new(
1287 exporttype => DATEV_ET_BUCHUNGEN,
1288 format => DATEV_FORMAT_KNE,
1289 trans_id => $invoice->trans_id,
1292 my $datev = SL::DATEV->new(
1293 exporttype => DATEV_ET_STAMM,
1294 format => DATEV_FORMAT_KNE,
1295 accnofrom => $start_account_number,
1296 accnoto => $end_account_number,
1299 # get or set datev stamm
1300 my $hashref = $datev->get_datev_stamm;
1301 $datev->save_datev_stamm($hashref);
1303 # manually clean up temporary directories older than 8 hours
1304 $datev->clean_temporary_directories;
1309 if ($datev->errors) {
1310 die join "\n", $datev->error;
1313 # get relevant data for saving the export:
1314 my $dl_token = $datev->download_token;
1315 my $path = $datev->export_path;
1316 my @files = $datev->filenames;
1318 # retrieving an export at a later time
1319 my $datev = SL::DATEV->new(
1320 download_token => $dl_token_from_user,
1323 my $path = $datev->export_path;
1324 my @files = glob("$path/*");
1328 This module implements the DATEV export standard. For usage see above.
1336 Generic constructor. See section attributes for information about what to pass.
1338 =item get_datev_stamm
1340 Loads DATEV Stammdaten and returns as hashref.
1342 =item save_datev_stamm HASHREF
1344 Saves DATEV Stammdaten from provided hashref.
1348 See L<CONSTANTS> for possible values
1350 =item has_exporttype
1352 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1356 Specifies the designated format of the export. Currently only KNE export is implemented.
1358 See L<CONSTANTS> for possible values
1362 Returns true if a format has been set. Without format most report functions won't work.
1364 =item download_token
1366 Returns a download token for this DATEV object.
1368 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1372 Returns an export_path for this DATEV object.
1374 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1378 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.
1380 =item net_gross_differences
1382 If there were any net gross differences during calculation they will be collected here.
1384 =item sum_net_gross_differences
1386 Sum of all differences.
1388 =item clean_temporary_directories
1390 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.
1394 Returns a list of errors that occured. If no errors occured, the export was a success.
1398 Exports data. You have to have set L<exporttype> and L<format> or an error will
1399 occur. OBE exports are currently not implemented.
1405 This is a list of attributes set in either the C<new> or a method of the same name.
1411 Set a database handle to use in the process. This allows for an export to be
1412 done on a transaction in progress without committing first.
1414 Note: If you don't want this code to commit, simply providing a dbh is not
1415 enough enymore. You'll have to wrap the call into a transaction yourself, so
1416 that the internal transaction does not commit.
1420 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1424 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1426 =item download_token
1428 Can be set on creation to retrieve a prior export for download.
1434 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1435 set for the export to work.
1439 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1440 L<from> and L<to> are currently still needed for the query to be assembled
1447 Set boundary account numbers for the export. Only useful for a stammdaten export.
1453 =head2 Supplied to L<exporttype>
1457 =item DATEV_ET_BUCHUNGEN
1459 =item DATEV_ET_STAMM
1463 =head2 Supplied to L<format>.
1467 =item DATEV_FORMAT_KNE
1469 =item DATEV_FORMAT_OBE
1473 =head1 ERROR HANDLING
1475 This module will die in the following cases:
1481 No or unrecognized exporttype or format was provided for an export
1485 OBE export was called, which is not yet implemented.
1493 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1499 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1503 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1504 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1508 =head1 BUGS AND CAVEATS
1514 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1518 OBE export is currently not implemented.
1524 - handling of export_path and download token is a bit dodgy, clean that up.
1528 L<SL::DATEV::KNEFile>
1532 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1534 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1536 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1538 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1540 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,