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., 675 Mass Ave, Cambridge, MA 02139, USA.
22 #======================================================================
25 #======================================================================
33 use SL::DATEV::KNEFile;
35 use SL::HTML::Util ();
36 use SL::Locale::String qw(t8);
40 use Exporter qw(import);
43 use List::MoreUtils qw(any);
44 use List::Util qw(min max sum);
45 use List::UtilsBy qw(partition_by sort_by);
47 use Time::HiRes qw(gettimeofday);
52 DATEV_ET_BUCHUNGEN => $i++,
53 DATEV_ET_STAMM => $i++,
56 DATEV_FORMAT_KNE => $i++,
57 DATEV_FORMAT_OBE => $i++,
61 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE);
62 our @EXPORT_OK = (@export_constants);
63 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
70 my $obj = bless {}, $class;
72 $obj->$_($data{$_}) for keys %data;
79 $self->{exporttype} = $_[0] if @_;
80 return $self->{exporttype};
84 defined $_[0]->{exporttype};
89 $self->{format} = $_[0] if @_;
90 return $self->{format};
94 defined $_[0]->{format};
97 sub _get_export_path {
98 $main::lxdebug->enter_sub();
100 my ($a, $b) = gettimeofday();
101 my $path = _get_path_for_download_token("${a}-${b}-${$}");
103 mkpath($path) unless (-d $path);
105 $main::lxdebug->leave_sub();
110 sub _get_path_for_download_token {
111 $main::lxdebug->enter_sub();
113 my $token = shift || '';
116 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
117 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
120 $main::lxdebug->leave_sub();
125 sub _get_download_token_for_path {
126 $main::lxdebug->enter_sub();
131 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
132 $token = "${1}-${2}-${3}";
135 $main::lxdebug->leave_sub();
142 $self->{download_token} = $_[0] if @_;
143 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
149 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
154 push @{ $self->{filenames} ||= [] }, @_;
158 return @{ $_[0]{filenames} || [] };
163 push @{ $self->{errors} ||= [] }, @_;
167 return @{ $_[0]{errors} || [] };
170 sub add_net_gross_differences {
172 push @{ $self->{net_gross_differences} ||= [] }, @_;
175 sub net_gross_differences {
176 return @{ $_[0]{net_gross_differences} || [] };
179 sub sum_net_gross_differences {
180 return sum $_[0]->net_gross_differences;
187 $self->{from} = $_[0];
190 return $self->{from};
207 $self->{trans_id} = $_[0];
210 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
212 return $self->{trans_id};
219 $self->{accnofrom} = $_[0];
222 return $self->{accnofrom};
229 $self->{accnoto} = $_[0];
232 return $self->{accnoto};
240 $self->{dbh} = $_[0];
241 $self->{provided_dbh} = 1;
244 $self->{dbh} ||= SL::DB->client->dbh;
251 sub clean_temporary_directories {
252 $::lxdebug->enter_sub;
254 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
255 next unless -d $path;
257 my $mtime = (stat($path))[9];
258 next if ((time() - $mtime) < 8 * 60 * 60);
263 $::lxdebug->leave_sub;
267 $main::lxdebug->enter_sub();
269 my $text = shift // '';
270 my $field_len = shift;
271 my $fill_char = shift;
272 my $alignment = shift || 'right';
274 my $text_len = length $text;
276 if ($field_len < $text_len) {
277 $text = substr $text, 0, $field_len;
279 } elsif ($field_len > $text_len) {
280 my $filler = ($fill_char) x ($field_len - $text_len);
281 $text = $alignment eq 'right' ? $filler . $text : $text . $filler;
284 $main::lxdebug->leave_sub();
289 sub get_datev_stamm {
290 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
293 sub save_datev_stamm {
294 my ($self, $data) = @_;
296 SL::DB->client->with_transaction(sub {
297 do_query($::form, $self->dbh, 'DELETE FROM datev');
299 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
301 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
302 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
304 }) or do { die SL::DB->client->error };
311 die 'no format set!' unless $self->has_format;
313 if ($self->format == DATEV_FORMAT_KNE) {
314 $result = $self->kne_export;
315 } elsif ($self->format == DATEV_FORMAT_OBE) {
316 $result = $self->obe_export;
318 die 'unrecognized export format';
328 die 'no exporttype set!' unless $self->has_exporttype;
330 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
331 $result = $self->kne_buchungsexport;
332 } elsif ($self->exporttype == DATEV_ET_STAMM) {
333 $result = $self->kne_stammdatenexport;
334 } elsif ($self->exporttype == DATEV_ET_CSV) {
335 $result = $self->csv_export_for_tax_accountant;
337 die 'unrecognized exporttype';
344 die 'not yet implemented';
350 return unless $self->from && $self->to;
352 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
359 sub _get_transactions {
360 $main::lxdebug->enter_sub();
362 my ($self, %params) = @_;
363 my $fromto = $params{from_to};
364 my $progress_callback = $params{progress_callback} || sub {};
366 my $form = $main::form;
368 my $trans_id_filter = '';
370 if ( $self->{trans_id} ) {
371 # ignore dates when trans_id is passed so that the entire transaction is
372 # checked, not just either the initial bookings or the subsequent payments
373 # (the transdates will likely differ)
375 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
377 $fromto =~ s/transdate/ac\.transdate/g;
382 my $filter = ''; # Useful for debugging purposes
384 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');
387 qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
388 ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate, ar.itime::date,
389 ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
390 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
392 t.rate AS taxrate, t.taxdescription,
394 tc.accno AS tax_accno, tc.description AS tax_accname,
397 LEFT JOIN ar ON (ac.trans_id = ar.id)
398 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
399 LEFT JOIN chart c ON (ac.chart_id = c.id)
400 LEFT JOIN tax t ON (ac.tax_id = t.id)
401 LEFT JOIN chart tc ON (t.chart_id = tc.id)
402 WHERE (ar.id IS NOT NULL)
409 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
410 ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate, ap.itime::date,
411 ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
412 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
414 t.rate AS taxrate, t.taxdescription,
416 tc.accno AS tax_accno, tc.description AS tax_accname,
419 LEFT JOIN ap ON (ac.trans_id = ap.id)
420 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
421 LEFT JOIN chart c ON (ac.chart_id = c.id)
422 LEFT JOIN tax t ON (ac.tax_id = t.id)
423 LEFT JOIN chart tc ON (t.chart_id = tc.id)
424 WHERE (ap.id IS NOT NULL)
431 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
432 gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate, gl.itime::date,
433 gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
434 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
436 t.rate AS taxrate, t.taxdescription,
438 tc.accno AS tax_accno, tc.description AS tax_accname,
441 LEFT JOIN gl ON (ac.trans_id = gl.id)
442 LEFT JOIN chart c ON (ac.chart_id = c.id)
443 LEFT JOIN tax t ON (ac.tax_id = t.id)
444 LEFT JOIN chart tc ON (t.chart_id = tc.id)
445 WHERE (gl.id IS NOT NULL)
450 ORDER BY trans_id, acc_trans_id|;
452 my $sth = prepare_execute_query($form, $self->dbh, $query);
458 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
459 last unless $ref; # for single transactions
461 if (($counter % 500) == 0) {
462 $progress_callback->($counter);
465 my $trans = [ $ref ];
467 my $count = $ref->{amount};
470 # if the amount of a booking in a group is smaller than 0.02, any tax
471 # amounts will likely be smaller than 1 cent, so go into subcent mode
472 my $subcent = abs($count) < 0.02;
474 # records from acc_trans are ordered by trans_id and acc_trans_id
475 # first check for unbalanced ledger inside one trans_id
476 # there may be several groups inside a trans_id, e.g. the original booking and the payment
477 # each group individually should be exactly balanced and each group
478 # individually needs its own datev lines
480 # keep fetching new acc_trans lines until the end of a balanced group is reached
481 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
482 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
488 # check if trans_id of current acc_trans line is still the same as the
489 # trans_id of the first line in group, i.e. we haven't finished a 0-group
490 # before moving on to the next trans_id, error will likely be in the old
493 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
494 require SL::DB::Manager::AccTransaction;
495 if ( $trans->[0]->{trans_id} ) {
496 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
497 $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
498 $acc_trans_obj->transaction_name, $ref2->{trans_id})
504 push @{ $trans }, $ref2;
506 $count += $ref2->{amount};
510 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
511 my $ref = $trans->[$i];
512 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
513 if ( $all_taxchart_ids{$ref->{id}}
514 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
515 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
516 || $ref->{invoice})) {
520 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
521 && $ref->{is_tax} # that has "is_tax" set
522 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
523 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
524 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
529 if (scalar(@{$trans}) <= 2) {
530 push @{ $self->{DATEV} }, $trans;
534 # determine at which array position the reference value (called absumsatz) is
535 # and which amount it has
537 for my $j (0 .. (scalar(@{$trans}) - 1)) {
540 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
542 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
543 # true, instead of absumsatz use link AR/AP (there should only be one
546 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
547 # instead of absumsatz use link AR/AP (there should only be one, so jump
548 # out of search as soon as you find it )
551 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
552 # for ap/ar bookings we can always search for AR/AP in link and use that
553 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
554 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
555 $absumsatz = $trans->[$j]->{'amount'};
560 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
561 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
562 # there must be only one AR or AP chart in the booking
563 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
564 # manually pays an invoice in GL.
565 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
566 $notsplitindex = $j; # position in booking with highest amount
567 $absumsatz = $trans->[$j]->{'amount'};
572 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
573 my $rounding_error = 0;
576 # go through each line and determine if it is a tax booking or not
577 # skip all tax lines and notsplitindex line
578 # push all other accounts (e.g. income or expense) with corresponding taxkey
580 for my $j (0 .. (scalar(@{$trans}) - 1)) {
581 if ( ($j != $notsplitindex)
582 && !$trans->[$j]->{is_tax}
583 && ( $trans->[$j]->{'taxkey'} eq ""
584 || $trans->[$j]->{'taxkey'} eq "0"
585 || $trans->[$j]->{'taxkey'} eq "1"
586 || $trans->[$j]->{'taxkey'} eq "10"
587 || $trans->[$j]->{'taxkey'} eq "11")) {
589 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
591 $absumsatz += $trans->[$j]->{'amount'};
592 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
593 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
594 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
596 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
598 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
601 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
603 my $tax_rate = $trans->[$j]->{'taxrate'};
604 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
605 $new_trans{'tax_rate'} = 1 + $tax_rate;
607 if (!$trans->[$j]->{'invoice'}) {
608 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
609 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
610 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
611 $absumsatz += -1 * $new_trans{'amount'};
614 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
615 my $rounded = $form->round_amount($unrounded, 2);
617 $rounding_error = $unrounded - $rounded;
618 $new_trans{'amount'} = $rounded;
619 $new_trans{'umsatz'} = abs($rounded) * $ml;
620 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
621 $absumsatz -= $rounded;
624 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
625 push @taxed, $self->{DATEV}->[-1];
631 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
632 if ($idx >= scalar @taxed) {
633 last if (!$correction);
639 my $transaction = $taxed[$idx]->[0];
641 my $old_amount = $transaction->{amount};
642 my $old_correction = $correction;
645 if (!$transaction->{diff}) {
646 @possible_diffs = (0.01, -0.01);
648 @possible_diffs = ($transaction->{diff});
651 foreach my $diff (@possible_diffs) {
652 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
653 next if ($net_amount != $transaction->{net_amount});
655 $transaction->{diff} = $diff;
656 $transaction->{amount} += $diff;
657 $transaction->{umsatz} += $diff;
667 $absumsatz = $form->round_amount($absumsatz, 2);
668 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
669 require SL::DB::Manager::AccTransaction;
670 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
671 $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
672 $acc_trans_obj->transaction_name, $absumsatz)
674 } elsif (abs($absumsatz) >= 0.01) {
675 $self->add_net_gross_differences($absumsatz);
681 $::lxdebug->leave_sub;
684 sub make_kne_data_header {
685 $main::lxdebug->enter_sub();
687 my ($self, $form) = @_;
690 my $stamm = $self->get_datev_stamm;
692 my $jahr = $self->from ? $self->from->year : DateTime->today->year;
695 my $header = "\x1D\x181";
696 $header .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
697 $header .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
698 $header .= _fill($stamm->{dfvkz}, 2, '0');
699 $header .= _fill($stamm->{beraternr}, 7, '0');
700 $header .= _fill($stamm->{mandantennr}, 5, '0');
701 $header .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
703 $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
704 $header .= $self->to ? $self->to->strftime('%d%m%y') : '';
708 $header .= $primanota;
711 $header .= _fill($stamm->{passwort}, 4, '0');
712 $header .= " " x 16; # Anwendungsinfo
713 $header .= " " x 16; # Inputinfo
717 my $versionssatz = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
719 my $query = qq|SELECT accno FROM chart LIMIT 1|;
720 my $ref = selectfirst_hashref_query($form, $self->dbh, $query);
722 $versionssatz .= length $ref->{accno};
723 $versionssatz .= ",";
724 $versionssatz .= length $ref->{accno};
725 $versionssatz .= ",SELF" . "\x1C\x79";
727 $header .= $versionssatz;
729 $main::lxdebug->leave_sub();
735 $main::lxdebug->enter_sub();
737 my ($date, $six) = @_;
739 my ($day, $month, $year) = split(/\./, $date);
742 $day = substr($day, 1, 1);
744 if (length($month) < 2) {
745 $month = "0" . $month;
747 if (length($year) > 2) {
748 $year = substr($year, -2, 2);
752 $date = $day . $month . $year;
754 $date = $day . $month;
757 $main::lxdebug->leave_sub();
762 sub trim_leading_zeroes {
770 sub make_ed_versionset {
771 $main::lxdebug->enter_sub();
773 my ($self, $header, $filename, $blockcount) = @_;
775 my $versionset = "V" . substr($filename, 2, 5);
776 $versionset .= substr($header, 6, 22);
779 $versionset .= "0000" . substr($header, 28, 19);
781 my $datum = " " x 16;
782 $versionset .= $datum . "001" . substr($header, 28, 4);
785 $versionset .= _fill($blockcount, 5, '0');
786 $versionset .= "001";
788 $versionset .= substr($header, -12, 10) . " ";
789 $versionset .= " " x 53;
791 $main::lxdebug->leave_sub();
797 $main::lxdebug->enter_sub();
799 my ($self, $form, $fileno) = @_;
801 my $stamm = $self->get_datev_stamm;
803 my $ev_header = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
805 $ev_header .= _fill($stamm->{beraternr}, 7, ' ', 'left');
806 $ev_header .= _fill($stamm->{beratername}, 9, ' ', 'left');
808 $ev_header .= (_fill($fileno, 5, '0')) x 2;
809 $ev_header .= " " x 95;
811 $main::lxdebug->leave_sub();
816 sub kne_buchungsexport {
817 $main::lxdebug->enter_sub();
825 my $filename = "ED00000";
830 my $fromto = $self->fromto;
832 $self->_get_transactions(from_to => $fromto);
834 return if $self->errors;
838 while (scalar(@{ $self->{DATEV} || [] })) {
841 my $ed_filename = $self->export_path . $filename;
842 push(@filenames, $filename);
843 my $header = $self->make_kne_data_header($form);
845 my $kne_file = SL::DATEV::KNEFile->new();
846 $kne_file->add_block($header);
848 while (scalar(@{ $self->{DATEV} }) > 0) {
849 my $transaction = shift @{ $self->{DATEV} };
850 my $trans_lines = scalar(@{$transaction});
859 my $buchungstext = "";
861 my $datevautomatik = 0;
866 my $iconv = $::locale->{iconv_utf8};
867 my %umlaute = ($iconv->convert('ä') => 'ae',
868 $iconv->convert('ö') => 'oe',
869 $iconv->convert('ü') => 'ue',
870 $iconv->convert('Ä') => 'Ae',
871 $iconv->convert('Ö') => 'Oe',
872 $iconv->convert('Ü') => 'Ue',
873 $iconv->convert('ß') => 'sz');
874 for (my $i = 0; $i < $trans_lines; $i++) {
875 if ($trans_lines == 2) {
876 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
877 $umsatz = $transaction->[$i]->{'amount'};
880 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
881 $umsatz = $transaction->[$i]->{'umsatz'};
884 if ($transaction->[$i]->{'datevautomatik'}) {
887 if ($transaction->[$i]->{'taxkey'}) {
888 $taxkey = $transaction->[$i]->{'taxkey'};
890 if ($transaction->[$i]->{'charttax'}) {
891 $charttax = $transaction->[$i]->{'charttax'};
893 if ($transaction->[$i]->{'amount'} > 0) {
899 # Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
900 foreach my $umlaut (keys(%umlaute)) {
901 $transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
902 $transaction->[$haben]->{'name'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
905 $transaction->[$haben]->{'invnumber'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
906 $transaction->[$haben]->{'name'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
908 $transaction->[$haben]->{'invnumber'} = substr($transaction->[$haben]->{'invnumber'}, 0, 12);
909 $transaction->[$haben]->{'name'} = substr($transaction->[$haben]->{'name'}, 0, 30);
910 $transaction->[$haben]->{'invnumber'} =~ s/\ *$//;
911 $transaction->[$haben]->{'name'} =~ s/\ *$//;
913 if ($trans_lines >= 2) {
915 $gegenkonto = "a" . trim_leading_zeroes($transaction->[$haben]->{'accno'});
916 $konto = "e" . trim_leading_zeroes($transaction->[$soll]->{'accno'});
917 if ($transaction->[$haben]->{'invnumber'} ne "") {
918 $belegfeld1 = "\xBD" . $transaction->[$haben]->{'invnumber'} . "\x1C";
921 $datum .= &datetofour($transaction->[$haben]->{'transdate'}, 0);
922 $waehrung = "\xB3" . "EUR" . "\x1C";
923 if ($transaction->[$haben]->{'name'} ne "") {
924 $buchungstext = "\x1E" . $transaction->[$haben]->{'name'} . "\x1C";
926 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
927 $ustid = "\xBA" . $transaction->[$haben]->{'ustid'} . "\x1C";
929 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
930 $belegfeld2 = "\xBE" . &datetofour($transaction->[$haben]->{'duedate'}, 1) . "\x1C";
934 $umsatz = $kne_file->format_amount(abs($umsatz), 0);
935 $umsatzsumme += $umsatz;
936 $kne_file->add_block("+" . $umsatz);
938 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
939 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
940 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
941 # Skript angelegt werden.
942 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
943 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
944 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
945 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
946 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
948 if ( ( $datevautomatik || $taxkey)
949 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
950 # $kne_file->add_block("\x6C" . (!$datevautomatik ? $taxkey : "4"));
951 $kne_file->add_block("\x6C${taxkey}");
954 $kne_file->add_block($gegenkonto);
955 $kne_file->add_block($belegfeld1);
956 $kne_file->add_block($belegfeld2);
957 $kne_file->add_block($datum);
958 $kne_file->add_block($konto);
959 $kne_file->add_block($buchungstext);
960 $kne_file->add_block($ustid);
961 $kne_file->add_block($waehrung . "\x79");
964 my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
966 $kne_file->add_block($mandantenendsumme);
969 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
970 print(ED $kne_file->get_data());
973 $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
977 #Make EV Verwaltungsdatei
978 my $ev_header = $self->make_ev_header($form, $fileno);
979 my $ev_filename = $self->export_path . $evfile;
980 push(@filenames, $evfile);
981 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
982 print(EV $ev_header);
984 foreach my $file (@ed_versionset) {
990 $self->add_filenames(@filenames);
992 $main::lxdebug->leave_sub();
994 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
997 sub kne_stammdatenexport {
998 $main::lxdebug->enter_sub();
1003 $self->get_datev_stamm->{abrechnungsnr} = "99";
1007 my $filename = "ED00000";
1008 my $evfile = "EV01";
1013 my $remaining_bytes = 256;
1014 my $total_bytes = 256;
1015 my $buchungssatz = "";
1017 my $ed_filename = $self->export_path . $filename;
1018 push(@filenames, $filename);
1019 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1020 my $header = $self->make_kne_data_header($form);
1021 $remaining_bytes -= length($header);
1025 my (@where, @values) = ((), ());
1026 if ($self->accnofrom) {
1027 push @where, 'c.accno >= ?';
1028 push @values, $self->accnofrom;
1030 if ($self->accnoto) {
1031 push @where, 'c.accno <= ?';
1032 push @values, $self->accnoto;
1035 my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1037 my $query = qq|SELECT c.accno, c.description
1042 my $sth = $self->dbh->prepare($query);
1043 $sth->execute(@values) || $form->dberror($query);
1045 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1046 if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1047 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1048 $buchungssatz .= "\x00" x $fuellzeichen;
1050 $total_bytes = ($blockcount) * 256;
1052 $buchungssatz .= "t" . $ref->{'accno'};
1053 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1054 $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1055 $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1056 $ref->{'description'} =~ s/\ *$//;
1059 ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1062 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1063 $buchungssatz .= "\x00" x $fuellzeichen;
1065 $total_bytes = ($blockcount) * 256;
1067 $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1068 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1073 print(ED $buchungssatz);
1074 $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1075 my $dateiende = "\x00" x $fuellzeichen;
1077 print(ED $dateiende);
1080 #Make EV Verwaltungsdatei
1082 $self->make_ed_versionset($header, $filename, $blockcount);
1084 my $ev_header = $self->make_ev_header($form, $fileno);
1085 my $ev_filename = $self->export_path . $evfile;
1086 push(@filenames, $evfile);
1087 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1088 print(EV $ev_header);
1090 foreach my $file (@ed_versionset) {
1091 print(EV $ed_versionset[$file]);
1095 $self->add_filenames(@filenames);
1097 $main::lxdebug->leave_sub();
1099 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1104 return $accno . ('0' x (6 - min(length($accno), 6)));
1107 sub csv_export_for_tax_accountant {
1110 $self->_get_transactions(from_to => $self->fromto);
1112 foreach my $transaction (@{ $self->{DATEV} }) {
1113 foreach my $entry (@{ $transaction }) {
1114 $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1119 partition_by { $_->[0]->{table} }
1120 sort_by { $_->[0]->{sortkey} }
1121 grep { 2 == scalar(@{ $_ }) }
1122 @{ $self->{DATEV} };
1125 acc_trans_id => { 'text' => $::locale->text('ID'), },
1126 amount => { 'text' => $::locale->text('Amount'), },
1127 credit_accname => { 'text' => $::locale->text('Credit Account Name'), },
1128 credit_accno => { 'text' => $::locale->text('Credit Account'), },
1129 debit_accname => { 'text' => $::locale->text('Debit Account Name'), },
1130 debit_accno => { 'text' => $::locale->text('Debit Account'), },
1131 invnumber => { 'text' => $::locale->text('Reference'), },
1132 name => { 'text' => $::locale->text('Name'), },
1133 notes => { 'text' => $::locale->text('Notes'), },
1134 tax => { 'text' => $::locale->text('Tax'), },
1135 taxkey => { 'text' => $::locale->text('Taxkey'), },
1136 tax_accname => { 'text' => $::locale->text('Tax Account Name'), },
1137 tax_accno => { 'text' => $::locale->text('Tax Account'), },
1138 transdate => { 'text' => $::locale->text('Invoice Date'), },
1139 vcnumber => { 'text' => $::locale->text('Customer/Vendor Number'), },
1143 acc_trans_id name vcnumber
1144 transdate invnumber amount
1145 debit_accno debit_accname
1146 credit_accno credit_accname
1148 tax_accno tax_accname taxkey
1152 my %filenames_by_type = (
1153 ar => $::locale->text('AR Transactions'),
1154 ap => $::locale->text('AP Transactions'),
1155 gl => $::locale->text('GL Transactions'),
1159 foreach my $type (qw(ap ar)) {
1163 filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1164 csv => Text::CSV_XS->new({
1172 filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1173 csv => Text::CSV_XS->new({
1181 foreach my $csv (values %csvs) {
1182 $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1183 $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1185 push @filenames, $csv->{filename};
1188 foreach my $transaction (@{ $transactions{$type} }) {
1189 my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1190 my $csv = $is_payment ? $csvs{payments} : $csvs{invoices};
1192 my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1193 my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
1194 my $amount = defined($soll->{net_amount}) ? $soll : $haben;
1195 $haben->{notes} = ($haben->{memo} || $soll->{memo}) if $is_payment;
1196 $haben->{notes} //= '';
1197 $haben->{notes} = SL::HTML::Util->strip($haben->{notes});
1198 $haben->{notes} =~ s{\r}{}g;
1199 $haben->{notes} =~ s{\n+}{ }g;
1202 amount => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1203 debit_accno => _format_accno($soll->{accno}),
1204 debit_accname => $soll->{accname},
1205 credit_accno => _format_accno($haben->{accno}),
1206 credit_accname => $haben->{accname},
1207 tax => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1208 notes => $haben->{notes},
1209 (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno)),
1210 (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1213 $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1216 $_->{out}->close for values %csvs;
1219 $self->add_filenames(@filenames);
1221 return { download_token => $self->download_token, filenames => \@filenames };
1225 clean_temporary_directories();
1236 SL::DATEV - kivitendo DATEV Export module
1240 use SL::DATEV qw(:CONSTANTS);
1242 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1243 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1244 my $datev = SL::DATEV->new(
1245 exporttype => DATEV_ET_BUCHUNGEN,
1246 format => DATEV_FORMAT_KNE,
1251 # To only export transactions from a specific trans_id: (from and to are ignored)
1252 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1253 my $datev = SL::DATEV->new(
1254 exporttype => DATEV_ET_BUCHUNGEN,
1255 format => DATEV_FORMAT_KNE,
1256 trans_id => $invoice->trans_id,
1259 my $datev = SL::DATEV->new(
1260 exporttype => DATEV_ET_STAMM,
1261 format => DATEV_FORMAT_KNE,
1262 accnofrom => $start_account_number,
1263 accnoto => $end_account_number,
1266 # get or set datev stamm
1267 my $hashref = $datev->get_datev_stamm;
1268 $datev->save_datev_stamm($hashref);
1270 # manually clean up temporary directories older than 8 hours
1271 $datev->clean_temporary_directories;
1276 if ($datev->errors) {
1277 die join "\n", $datev->error;
1280 # get relevant data for saving the export:
1281 my $dl_token = $datev->download_token;
1282 my $path = $datev->export_path;
1283 my @files = $datev->filenames;
1285 # retrieving an export at a later time
1286 my $datev = SL::DATEV->new(
1287 download_token => $dl_token_from_user,
1290 my $path = $datev->export_path;
1291 my @files = glob("$path/*");
1295 This module implements the DATEV export standard. For usage see above.
1303 Generic constructor. See section attributes for information about what to pass.
1305 =item get_datev_stamm
1307 Loads DATEV Stammdaten and returns as hashref.
1309 =item save_datev_stamm HASHREF
1311 Saves DATEV Stammdaten from provided hashref.
1315 See L<CONSTANTS> for possible values
1317 =item has_exporttype
1319 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1323 Specifies the designated format of the export. Currently only KNE export is implemented.
1325 See L<CONSTANTS> for possible values
1329 Returns true if a format has been set. Without format most report functions won't work.
1331 =item download_token
1333 Returns a download token for this DATEV object.
1335 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1339 Returns an export_path for this DATEV object.
1341 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1345 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.
1347 =item net_gross_differences
1349 If there were any net gross differences during calculation they will be collected here.
1351 =item sum_net_gross_differences
1353 Sum of all differences.
1355 =item clean_temporary_directories
1357 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.
1361 Returns a list of errors that occured. If no errors occured, the export was a success.
1365 Exports data. You have to have set L<exporttype> and L<format> or an error will
1366 occur. OBE exports are currently not implemented.
1372 This is a list of attributes set in either the C<new> or a method of the same name.
1378 Set a database handle to use in the process. This allows for an export to be
1379 done on a transaction in progress without committing first.
1381 Note: If you don't want this code to commit, simply providing a dbh is not
1382 enough enymore. You'll have to wrap the call into a transaction yourself, so
1383 that the internal transaction does not commit.
1387 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1391 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1393 =item download_token
1395 Can be set on creation to retrieve a prior export for download.
1401 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1402 set for the export to work.
1406 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1407 L<from> and L<to> are currently still needed for the query to be assembled
1414 Set boundary account numbers for the export. Only useful for a stammdaten export.
1420 =head2 Supplied to L<exporttype>
1424 =item DATEV_ET_BUCHUNGEN
1426 =item DATEV_ET_STAMM
1430 =head2 Supplied to L<format>.
1434 =item DATEV_FORMAT_KNE
1436 =item DATEV_FORMAT_OBE
1440 =head1 ERROR HANDLING
1442 This module will die in the following cases:
1448 No or unrecognized exporttype or format was provided for an export
1452 OBE export was called, which is not yet implemented.
1460 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1466 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1470 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1471 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1475 =head1 BUGS AND CAVEATS
1481 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1485 OBE export is currently not implemented.
1491 - handling of export_path and download token is a bit dodgy, clean that up.
1495 L<SL::DATEV::KNEFile>
1499 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1501 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1503 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1505 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1507 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,