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;
38 use Exporter qw(import);
40 use List::Util qw(max sum);
41 use Time::HiRes qw(gettimeofday);
46 DATEV_ET_BUCHUNGEN => $i++,
47 DATEV_ET_STAMM => $i++,
49 DATEV_FORMAT_KNE => $i++,
50 DATEV_FORMAT_OBE => $i++,
54 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_FORMAT_KNE DATEV_FORMAT_OBE);
55 our @EXPORT_OK = (@export_constants);
56 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
63 my $obj = bless {}, $class;
65 $obj->$_($data{$_}) for keys %data;
72 $self->{exporttype} = $_[0] if @_;
73 return $self->{exporttype};
77 defined $_[0]->{exporttype};
82 $self->{format} = $_[0] if @_;
83 return $self->{format};
87 defined $_[0]->{format};
90 sub _get_export_path {
91 $main::lxdebug->enter_sub();
93 my ($a, $b) = gettimeofday();
94 my $path = _get_path_for_download_token("${a}-${b}-${$}");
96 mkpath($path) unless (-d $path);
98 $main::lxdebug->leave_sub();
103 sub _get_path_for_download_token {
104 $main::lxdebug->enter_sub();
106 my $token = shift || '';
109 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
110 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
113 $main::lxdebug->leave_sub();
118 sub _get_download_token_for_path {
119 $main::lxdebug->enter_sub();
124 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
125 $token = "${1}-${2}-${3}";
128 $main::lxdebug->leave_sub();
135 $self->{download_token} = $_[0] if @_;
136 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
142 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
147 push @{ $self->{filenames} ||= [] }, @_;
151 return @{ $_[0]{filenames} || [] };
156 push @{ $self->{errors} ||= [] }, @_;
160 return @{ $_[0]{errors} || [] };
163 sub add_net_gross_differences {
165 push @{ $self->{net_gross_differences} ||= [] }, @_;
168 sub net_gross_differences {
169 return @{ $_[0]{net_gross_differences} || [] };
172 sub sum_net_gross_differences {
173 return sum $_[0]->net_gross_differences;
180 $self->{from} = $_[0];
183 return $self->{from};
200 $self->{trans_id} = $_[0];
203 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
205 return $self->{trans_id};
212 $self->{accnofrom} = $_[0];
215 return $self->{accnofrom};
222 $self->{accnoto} = $_[0];
225 return $self->{accnoto};
233 $self->{dbh} = $_[0];
234 $self->{provided_dbh} = 1;
237 $self->{dbh} ||= SL::DB->client->dbh;
244 sub clean_temporary_directories {
245 $::lxdebug->enter_sub;
247 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
248 next unless -d $path;
250 my $mtime = (stat($path))[9];
251 next if ((time() - $mtime) < 8 * 60 * 60);
256 $::lxdebug->leave_sub;
260 $main::lxdebug->enter_sub();
262 my $text = shift // '';
263 my $field_len = shift;
264 my $fill_char = shift;
265 my $alignment = shift || 'right';
267 my $text_len = length $text;
269 if ($field_len < $text_len) {
270 $text = substr $text, 0, $field_len;
272 } elsif ($field_len > $text_len) {
273 my $filler = ($fill_char) x ($field_len - $text_len);
274 $text = $alignment eq 'right' ? $filler . $text : $text . $filler;
277 $main::lxdebug->leave_sub();
282 sub get_datev_stamm {
283 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
286 sub save_datev_stamm {
287 my ($self, $data) = @_;
289 SL::DB->client->with_transaction(sub {
290 do_query($::form, $self->dbh, 'DELETE FROM datev');
292 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
294 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
295 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
303 die 'no format set!' unless $self->has_format;
305 if ($self->format == DATEV_FORMAT_KNE) {
306 $result = $self->kne_export;
307 } elsif ($self->format == DATEV_FORMAT_OBE) {
308 $result = $self->obe_export;
310 die 'unrecognized export format';
320 die 'no exporttype set!' unless $self->has_exporttype;
322 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
323 $result = $self->kne_buchungsexport;
324 } elsif ($self->exporttype == DATEV_ET_STAMM) {
325 $result = $self->kne_stammdatenexport;
327 die 'unrecognized exporttype';
334 die 'not yet implemented';
340 return unless $self->from && $self->to;
342 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
349 sub _get_transactions {
350 $main::lxdebug->enter_sub();
353 my $progress_callback = shift || sub {};
355 my $form = $main::form;
357 my $trans_id_filter = '';
359 if ( $self->{trans_id} ) {
360 # ignore dates when trans_id is passed so that the entire transaction is
361 # checked, not just either the initial bookings or the subsequent payments
362 # (the transdates will likely differ)
364 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
366 $fromto =~ s/transdate/ac\.transdate/g;
371 my $filter = ''; # Useful for debugging purposes
373 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');
376 qq|SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey,
377 ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate,
379 c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
384 LEFT JOIN ar ON (ac.trans_id = ar.id)
385 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
386 LEFT JOIN chart c ON (ac.chart_id = c.id)
387 LEFT JOIN tax t ON (ac.tax_id = t.id)
388 WHERE (ar.id IS NOT NULL)
395 SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey,
396 ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate,
398 c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
403 LEFT JOIN ap ON (ac.trans_id = ap.id)
404 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
405 LEFT JOIN chart c ON (ac.chart_id = c.id)
406 LEFT JOIN tax t ON (ac.tax_id = t.id)
407 WHERE (ap.id IS NOT NULL)
414 SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey,
415 gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate,
416 gl.description AS name, NULL as ustid,
417 c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
422 LEFT JOIN gl ON (ac.trans_id = gl.id)
423 LEFT JOIN chart c ON (ac.chart_id = c.id)
424 LEFT JOIN tax t ON (ac.tax_id = t.id)
425 WHERE (gl.id IS NOT NULL)
430 ORDER BY trans_id, acc_trans_id|;
432 my $sth = prepare_execute_query($form, $self->dbh, $query);
438 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
439 last unless $ref; # for single transactions
441 if (($counter % 500) == 0) {
442 $progress_callback->($counter);
445 my $trans = [ $ref ];
447 my $count = $ref->{amount};
450 # if the amount of a booking in a group is smaller than 0.02, any tax
451 # amounts will likely be smaller than 1 cent, so go into subcent mode
452 my $subcent = abs($count) < 0.02;
454 # records from acc_trans are ordered by trans_id and acc_trans_id
455 # first check for unbalanced ledger inside one trans_id
456 # there may be several groups inside a trans_id, e.g. the original booking and the payment
457 # each group individually should be exactly balanced and each group
458 # individually needs its own datev lines
460 # keep fetching new acc_trans lines until the end of a balanced group is reached
461 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
462 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
468 # check if trans_id of current acc_trans line is still the same as the
469 # trans_id of the first line in group, i.e. we haven't finished a 0-group
470 # before moving on to the next trans_id, error will likely be in the old
473 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
474 require SL::DB::Manager::AccTransaction;
475 if ( $trans->[0]->{trans_id} ) {
476 my $acc_trans_old_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
477 $self->add_error("Unbalanced ledger! Old: " . $acc_trans_old_obj->transaction_name) if ref($acc_trans_old_obj);
479 if ( $ref2->{trans_id} ) {
480 my $acc_trans_curr_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $ref2->{trans_id} ]);
481 $self->add_error("Unbalanced ledger! New:" . $acc_trans_curr_obj->transaction_name) if ref($acc_trans_curr_obj);
483 $self->add_error("count: $count");
487 push @{ $trans }, $ref2;
489 $count += $ref2->{amount};
493 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
494 my $ref = $trans->[$i];
495 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
496 if ( $all_taxchart_ids{$ref->{id}}
497 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
498 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
499 || $ref->{invoice})) {
503 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
504 && $ref->{is_tax} # that has "is_tax" set
505 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
506 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
507 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
512 if (scalar(@{$trans}) <= 2) {
513 push @{ $self->{DATEV} }, $trans;
517 # determine at which array position the reference value (called absumsatz) is
518 # and which amount it has
520 for my $j (0 .. (scalar(@{$trans}) - 1)) {
523 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
525 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
526 # true, instead of absumsatz use link AR/AP (there should only be one
529 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
530 # instead of absumsatz use link AR/AP (there should only be one, so jump
531 # out of search as soon as you find it )
534 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
535 # for ap/ar bookings we can always search for AR/AP in link and use that
536 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
537 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
538 $absumsatz = $trans->[$j]->{'amount'};
543 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
544 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
545 # there must be only one AR or AP chart in the booking
546 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
547 # manually pays an invoice in GL.
548 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
549 $notsplitindex = $j; # position in booking with highest amount
550 $absumsatz = $trans->[$j]->{'amount'};
555 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
556 my $rounding_error = 0;
559 # go through each line and determine if it is a tax booking or not
560 # skip all tax lines and notsplitindex line
561 # push all other accounts (e.g. income or expense) with corresponding taxkey
563 for my $j (0 .. (scalar(@{$trans}) - 1)) {
564 if ( ($j != $notsplitindex)
565 && !$trans->[$j]->{is_tax}
566 && ( $trans->[$j]->{'taxkey'} eq ""
567 || $trans->[$j]->{'taxkey'} eq "0"
568 || $trans->[$j]->{'taxkey'} eq "1"
569 || $trans->[$j]->{'taxkey'} eq "10"
570 || $trans->[$j]->{'taxkey'} eq "11")) {
572 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
574 $absumsatz += $trans->[$j]->{'amount'};
575 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
576 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
577 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
579 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
581 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
584 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
586 my $tax_rate = $trans->[$j]->{'taxrate'};
587 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
588 $new_trans{'tax_rate'} = 1 + $tax_rate;
590 if (!$trans->[$j]->{'invoice'}) {
591 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
592 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
593 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
594 $absumsatz += -1 * $new_trans{'amount'};
597 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
598 my $rounded = $form->round_amount($unrounded, 2);
600 $rounding_error = $unrounded - $rounded;
601 $new_trans{'amount'} = $rounded;
602 $new_trans{'umsatz'} = abs($rounded) * $ml;
603 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
604 $absumsatz -= $rounded;
607 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
608 push @taxed, $self->{DATEV}->[-1];
614 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
615 if ($idx >= scalar @taxed) {
616 last if (!$correction);
622 my $transaction = $taxed[$idx]->[0];
624 my $old_amount = $transaction->{amount};
625 my $old_correction = $correction;
628 if (!$transaction->{diff}) {
629 @possible_diffs = (0.01, -0.01);
631 @possible_diffs = ($transaction->{diff});
634 foreach my $diff (@possible_diffs) {
635 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
636 next if ($net_amount != $transaction->{net_amount});
638 $transaction->{diff} = $diff;
639 $transaction->{amount} += $diff;
640 $transaction->{umsatz} += $diff;
650 $absumsatz = $form->round_amount($absumsatz, 2);
651 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
652 require SL::DB::Manager::AccTransaction;
653 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
654 $self->add_error("Datev-Export fehlgeschlagen! Bei Transaktion " . $acc_trans_obj->transaction_name . " ($absumsatz)");
656 } elsif (abs($absumsatz) >= 0.01) {
657 $self->add_net_gross_differences($absumsatz);
663 $::lxdebug->leave_sub;
666 sub make_kne_data_header {
667 $main::lxdebug->enter_sub();
669 my ($self, $form) = @_;
672 my $stamm = $self->get_datev_stamm;
674 my $jahr = $self->from ? $self->from->year : DateTime->today->year;
677 my $header = "\x1D\x181";
678 $header .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
679 $header .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
680 $header .= _fill($stamm->{dfvkz}, 2, '0');
681 $header .= _fill($stamm->{beraternr}, 7, '0');
682 $header .= _fill($stamm->{mandantennr}, 5, '0');
683 $header .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
685 $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
686 $header .= $self->to ? $self->to->strftime('%d%m%y') : '';
690 $header .= $primanota;
693 $header .= _fill($stamm->{passwort}, 4, '0');
694 $header .= " " x 16; # Anwendungsinfo
695 $header .= " " x 16; # Inputinfo
699 my $versionssatz = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
701 my $query = qq|SELECT accno FROM chart LIMIT 1|;
702 my $ref = selectfirst_hashref_query($form, $self->dbh, $query);
704 $versionssatz .= length $ref->{accno};
705 $versionssatz .= ",";
706 $versionssatz .= length $ref->{accno};
707 $versionssatz .= ",SELF" . "\x1C\x79";
709 $header .= $versionssatz;
711 $main::lxdebug->leave_sub();
717 $main::lxdebug->enter_sub();
719 my ($date, $six) = @_;
721 my ($day, $month, $year) = split(/\./, $date);
724 $day = substr($day, 1, 1);
726 if (length($month) < 2) {
727 $month = "0" . $month;
729 if (length($year) > 2) {
730 $year = substr($year, -2, 2);
734 $date = $day . $month . $year;
736 $date = $day . $month;
739 $main::lxdebug->leave_sub();
744 sub trim_leading_zeroes {
752 sub make_ed_versionset {
753 $main::lxdebug->enter_sub();
755 my ($self, $header, $filename, $blockcount) = @_;
757 my $versionset = "V" . substr($filename, 2, 5);
758 $versionset .= substr($header, 6, 22);
761 $versionset .= "0000" . substr($header, 28, 19);
763 my $datum = " " x 16;
764 $versionset .= $datum . "001" . substr($header, 28, 4);
767 $versionset .= _fill($blockcount, 5, '0');
768 $versionset .= "001";
770 $versionset .= substr($header, -12, 10) . " ";
771 $versionset .= " " x 53;
773 $main::lxdebug->leave_sub();
779 $main::lxdebug->enter_sub();
781 my ($self, $form, $fileno) = @_;
783 my $stamm = $self->get_datev_stamm;
785 my $ev_header = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
787 $ev_header .= _fill($stamm->{beraternr}, 7, ' ', 'left');
788 $ev_header .= _fill($stamm->{beratername}, 9, ' ', 'left');
790 $ev_header .= (_fill($fileno, 5, '0')) x 2;
791 $ev_header .= " " x 95;
793 $main::lxdebug->leave_sub();
798 sub kne_buchungsexport {
799 $main::lxdebug->enter_sub();
807 my $filename = "ED00000";
812 my $fromto = $self->fromto;
814 $self->_get_transactions($fromto);
816 return if $self->errors;
820 while (scalar(@{ $self->{DATEV} || [] })) {
823 my $ed_filename = $self->export_path . $filename;
824 push(@filenames, $filename);
825 my $header = $self->make_kne_data_header($form);
827 my $kne_file = SL::DATEV::KNEFile->new();
828 $kne_file->add_block($header);
830 while (scalar(@{ $self->{DATEV} }) > 0) {
831 my $transaction = shift @{ $self->{DATEV} };
832 my $trans_lines = scalar(@{$transaction});
841 my $buchungstext = "";
843 my $datevautomatik = 0;
848 my $iconv = $::locale->{iconv_utf8};
849 my %umlaute = ($iconv->convert('ä') => 'ae',
850 $iconv->convert('ö') => 'oe',
851 $iconv->convert('ü') => 'ue',
852 $iconv->convert('Ä') => 'Ae',
853 $iconv->convert('Ö') => 'Oe',
854 $iconv->convert('Ü') => 'Ue',
855 $iconv->convert('ß') => 'sz');
856 for (my $i = 0; $i < $trans_lines; $i++) {
857 if ($trans_lines == 2) {
858 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
859 $umsatz = $transaction->[$i]->{'amount'};
862 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
863 $umsatz = $transaction->[$i]->{'umsatz'};
866 if ($transaction->[$i]->{'datevautomatik'}) {
869 if ($transaction->[$i]->{'taxkey'}) {
870 $taxkey = $transaction->[$i]->{'taxkey'};
872 if ($transaction->[$i]->{'charttax'}) {
873 $charttax = $transaction->[$i]->{'charttax'};
875 if ($transaction->[$i]->{'amount'} > 0) {
881 # Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
882 foreach my $umlaut (keys(%umlaute)) {
883 $transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
884 $transaction->[$haben]->{'name'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
887 $transaction->[$haben]->{'invnumber'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
888 $transaction->[$haben]->{'name'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
890 $transaction->[$haben]->{'invnumber'} = substr($transaction->[$haben]->{'invnumber'}, 0, 12);
891 $transaction->[$haben]->{'name'} = substr($transaction->[$haben]->{'name'}, 0, 30);
892 $transaction->[$haben]->{'invnumber'} =~ s/\ *$//;
893 $transaction->[$haben]->{'name'} =~ s/\ *$//;
895 if ($trans_lines >= 2) {
897 $gegenkonto = "a" . trim_leading_zeroes($transaction->[$haben]->{'accno'});
898 $konto = "e" . trim_leading_zeroes($transaction->[$soll]->{'accno'});
899 if ($transaction->[$haben]->{'invnumber'} ne "") {
900 $belegfeld1 = "\xBD" . $transaction->[$haben]->{'invnumber'} . "\x1C";
903 $datum .= &datetofour($transaction->[$haben]->{'transdate'}, 0);
904 $waehrung = "\xB3" . "EUR" . "\x1C";
905 if ($transaction->[$haben]->{'name'} ne "") {
906 $buchungstext = "\x1E" . $transaction->[$haben]->{'name'} . "\x1C";
908 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
909 $ustid = "\xBA" . $transaction->[$haben]->{'ustid'} . "\x1C";
911 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
912 $belegfeld2 = "\xBE" . &datetofour($transaction->[$haben]->{'duedate'}, 1) . "\x1C";
916 $umsatz = $kne_file->format_amount(abs($umsatz), 0);
917 $umsatzsumme += $umsatz;
918 $kne_file->add_block("+" . $umsatz);
920 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
921 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
922 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
923 # Skript angelegt werden.
924 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
925 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
926 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
927 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
928 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
930 if ( ( $datevautomatik || $taxkey)
931 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
932 # $kne_file->add_block("\x6C" . (!$datevautomatik ? $taxkey : "4"));
933 $kne_file->add_block("\x6C${taxkey}");
936 $kne_file->add_block($gegenkonto);
937 $kne_file->add_block($belegfeld1);
938 $kne_file->add_block($belegfeld2);
939 $kne_file->add_block($datum);
940 $kne_file->add_block($konto);
941 $kne_file->add_block($buchungstext);
942 $kne_file->add_block($ustid);
943 $kne_file->add_block($waehrung . "\x79");
946 my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
948 $kne_file->add_block($mandantenendsumme);
951 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
952 print(ED $kne_file->get_data());
955 $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
959 #Make EV Verwaltungsdatei
960 my $ev_header = $self->make_ev_header($form, $fileno);
961 my $ev_filename = $self->export_path . $evfile;
962 push(@filenames, $evfile);
963 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
964 print(EV $ev_header);
966 foreach my $file (@ed_versionset) {
972 $self->add_filenames(@filenames);
974 $main::lxdebug->leave_sub();
976 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
979 sub kne_stammdatenexport {
980 $main::lxdebug->enter_sub();
985 $self->get_datev_stamm->{abrechnungsnr} = "99";
989 my $filename = "ED00000";
995 my $remaining_bytes = 256;
996 my $total_bytes = 256;
997 my $buchungssatz = "";
999 my $ed_filename = $self->export_path . $filename;
1000 push(@filenames, $filename);
1001 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1002 my $header = $self->make_kne_data_header($form);
1003 $remaining_bytes -= length($header);
1007 my (@where, @values) = ((), ());
1008 if ($self->accnofrom) {
1009 push @where, 'c.accno >= ?';
1010 push @values, $self->accnofrom;
1012 if ($self->accnoto) {
1013 push @where, 'c.accno <= ?';
1014 push @values, $self->accnoto;
1017 my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1019 my $query = qq|SELECT c.accno, c.description
1024 my $sth = $self->dbh->prepare($query);
1025 $sth->execute(@values) || $form->dberror($query);
1027 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1028 if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1029 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1030 $buchungssatz .= "\x00" x $fuellzeichen;
1032 $total_bytes = ($blockcount) * 256;
1034 $buchungssatz .= "t" . $ref->{'accno'};
1035 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1036 $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1037 $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1038 $ref->{'description'} =~ s/\ *$//;
1041 ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1044 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1045 $buchungssatz .= "\x00" x $fuellzeichen;
1047 $total_bytes = ($blockcount) * 256;
1049 $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1050 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1055 print(ED $buchungssatz);
1056 $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1057 my $dateiende = "\x00" x $fuellzeichen;
1059 print(ED $dateiende);
1062 #Make EV Verwaltungsdatei
1064 $self->make_ed_versionset($header, $filename, $blockcount);
1066 my $ev_header = $self->make_ev_header($form, $fileno);
1067 my $ev_filename = $self->export_path . $evfile;
1068 push(@filenames, $evfile);
1069 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1070 print(EV $ev_header);
1072 foreach my $file (@ed_versionset) {
1073 print(EV $ed_versionset[$file]);
1077 $self->add_filenames(@filenames);
1079 $main::lxdebug->leave_sub();
1081 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1085 clean_temporary_directories();
1096 SL::DATEV - kivitendo DATEV Export module
1100 use SL::DATEV qw(:CONSTANTS);
1102 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1103 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1104 my $datev = SL::DATEV->new(
1105 exporttype => DATEV_ET_BUCHUNGEN,
1106 format => DATEV_FORMAT_KNE,
1111 # To only export transactions from a specific trans_id: (from and to are ignored)
1112 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1113 my $datev = SL::DATEV->new(
1114 exporttype => DATEV_ET_BUCHUNGEN,
1115 format => DATEV_FORMAT_KNE,
1116 trans_id => $invoice->trans_id,
1119 my $datev = SL::DATEV->new(
1120 exporttype => DATEV_ET_STAMM,
1121 format => DATEV_FORMAT_KNE,
1122 accnofrom => $start_account_number,
1123 accnoto => $end_account_number,
1126 # get or set datev stamm
1127 my $hashref = $datev->get_datev_stamm;
1128 $datev->save_datev_stamm($hashref);
1130 # manually clean up temporary directories older than 8 hours
1131 $datev->clean_temporary_directories;
1136 if ($datev->errors) {
1137 die join "\n", $datev->error;
1140 # get relevant data for saving the export:
1141 my $dl_token = $datev->download_token;
1142 my $path = $datev->export_path;
1143 my @files = $datev->filenames;
1145 # retrieving an export at a later time
1146 my $datev = SL::DATEV->new(
1147 download_token => $dl_token_from_user,
1150 my $path = $datev->export_path;
1151 my @files = glob("$path/*");
1155 This module implements the DATEV export standard. For usage see above.
1163 Generic constructor. See section attributes for information about what to pass.
1165 =item get_datev_stamm
1167 Loads DATEV Stammdaten and returns as hashref.
1169 =item save_datev_stamm HASHREF
1171 Saves DATEV Stammdaten from provided hashref.
1175 See L<CONSTANTS> for possible values
1177 =item has_exporttype
1179 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1183 Specifies the designated format of the export. Currently only KNE export is implemented.
1185 See L<CONSTANTS> for possible values
1189 Returns true if a format has been set. Without format most report functions won't work.
1191 =item download_token
1193 Returns a download token for this DATEV object.
1195 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1199 Returns an export_path for this DATEV object.
1201 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1205 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.
1207 =item net_gross_differences
1209 If there were any net gross differences during calculation they will be collected here.
1211 =item sum_net_gross_differences
1213 Sum of all differences.
1215 =item clean_temporary_directories
1217 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.
1221 Returns a list of errors that occured. If no errors occured, the export was a success.
1225 Exports data. You have to have set L<exporttype> and L<format> or an error will
1226 occur. OBE exports are currently not implemented.
1232 This is a list of attributes set in either the C<new> or a method of the same name.
1238 Set a database handle to use in the process. This allows for an export to be
1239 done on a transaction in progress without committing first.
1241 Note: If you don't want this code to commit, simply providing a dbh is not
1242 enough enymore. You'll have to wrap the call into a transaction yourself, so
1243 that the internal transaction does not commit.
1247 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1251 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1253 =item download_token
1255 Can be set on creation to retrieve a prior export for download.
1261 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1262 set for the export to work.
1266 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1267 L<from> and L<to> are currently still needed for the query to be assembled
1274 Set boundary account numbers for the export. Only useful for a stammdaten export.
1280 =head2 Supplied to L<exporttype>
1284 =item DATEV_ET_BUCHUNGEN
1286 =item DATEV_ET_STAMM
1290 =head2 Supplied to L<format>.
1294 =item DATEV_FORMAT_KNE
1296 =item DATEV_FORMAT_OBE
1300 =head1 ERROR HANDLING
1302 This module will die in the following cases:
1308 No or unrecognized exporttype or format was provided for an export
1312 OBE export was called, which is not yet implemented.
1320 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1326 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1330 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1331 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1335 =head1 BUGS AND CAVEATS
1341 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1345 OBE export is currently not implemented.
1351 - handling of export_path and download token is a bit dodgy, clean that up.
1355 L<SL::DATEV::KNEFile>
1359 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1361 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1363 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1365 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1367 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,