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);
844 my $header = $self->make_kne_data_header($form);
846 my $kne_file = SL::DATEV::KNEFile->new();
847 $kne_file->add_block($header);
849 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 my $iconv = $::locale->{iconv_utf8};
868 my %umlaute = ($iconv->convert('ä') => 'ae',
869 $iconv->convert('ö') => 'oe',
870 $iconv->convert('ü') => 'ue',
871 $iconv->convert('Ä') => 'Ae',
872 $iconv->convert('Ö') => 'Oe',
873 $iconv->convert('Ü') => 'Ue',
874 $iconv->convert('ß') => 'sz');
875 for (my $i = 0; $i < $trans_lines; $i++) {
876 if ($trans_lines == 2) {
877 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
878 $umsatz = $transaction->[$i]->{'amount'};
881 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
882 $umsatz = $transaction->[$i]->{'umsatz'};
885 if ($transaction->[$i]->{'datevautomatik'}) {
888 if ($transaction->[$i]->{'taxkey'}) {
889 $taxkey = $transaction->[$i]->{'taxkey'};
891 if ($transaction->[$i]->{'charttax'}) {
892 $charttax = $transaction->[$i]->{'charttax'};
894 if ($transaction->[$i]->{'amount'} > 0) {
900 # Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
901 foreach my $umlaut (keys(%umlaute)) {
902 $transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
903 $transaction->[$haben]->{'name'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
906 $transaction->[$haben]->{'invnumber'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
907 $transaction->[$haben]->{'name'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
909 $transaction->[$haben]->{'invnumber'} = substr($transaction->[$haben]->{'invnumber'}, 0, 12);
910 $transaction->[$haben]->{'name'} = substr($transaction->[$haben]->{'name'}, 0, 30);
911 $transaction->[$haben]->{'invnumber'} =~ s/\ *$//;
912 $transaction->[$haben]->{'name'} =~ s/\ *$//;
914 if ($trans_lines >= 2) {
916 $gegenkonto = "a" . trim_leading_zeroes($transaction->[$haben]->{'accno'});
917 $konto = "e" . trim_leading_zeroes($transaction->[$soll]->{'accno'});
918 if ($transaction->[$haben]->{'invnumber'} ne "") {
919 $belegfeld1 = "\xBD" . $transaction->[$haben]->{'invnumber'} . "\x1C";
922 $datum .= &datetofour($transaction->[$haben]->{'transdate'}, 0);
923 $waehrung = "\xB3" . "EUR" . "\x1C";
924 if ($transaction->[$haben]->{'name'} ne "") {
925 $buchungstext = "\x1E" . $transaction->[$haben]->{'name'} . "\x1C";
927 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
928 $ustid = "\xBA" . $transaction->[$haben]->{'ustid'} . "\x1C";
930 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
931 $belegfeld2 = "\xBE" . &datetofour($transaction->[$haben]->{'duedate'}, 1) . "\x1C";
935 $umsatz = $kne_file->format_amount(abs($umsatz), 0);
936 $umsatzsumme += $umsatz;
937 $kne_file->add_block("+" . $umsatz);
939 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
940 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
941 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
942 # Skript angelegt werden.
943 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
944 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
945 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
946 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
947 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
949 if ( ( $datevautomatik || $taxkey)
950 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
951 # $kne_file->add_block("\x6C" . (!$datevautomatik ? $taxkey : "4"));
952 $kne_file->add_block("\x6C${taxkey}");
955 $kne_file->add_block($gegenkonto);
956 $kne_file->add_block($belegfeld1);
957 $kne_file->add_block($belegfeld2);
958 $kne_file->add_block($datum);
959 $kne_file->add_block($konto);
960 $kne_file->add_block($buchungstext);
961 $kne_file->add_block($ustid);
962 $kne_file->add_block($waehrung . "\x79");
965 my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
967 $kne_file->add_block($mandantenendsumme);
970 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
971 print(ED $kne_file->get_data());
974 $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
978 #Make EV Verwaltungsdatei
979 my $ev_header = $self->make_ev_header($form, $fileno);
980 my $ev_filename = $self->export_path . $evfile;
981 push(@filenames, $evfile);
982 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
983 print(EV $ev_header);
985 foreach my $file (@ed_versionset) {
991 $self->add_filenames(@filenames);
993 $main::lxdebug->leave_sub();
995 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
998 sub kne_stammdatenexport {
999 $main::lxdebug->enter_sub();
1004 $self->get_datev_stamm->{abrechnungsnr} = "99";
1008 my $filename = "ED00000";
1009 my $evfile = "EV01";
1014 my $remaining_bytes = 256;
1015 my $total_bytes = 256;
1016 my $buchungssatz = "";
1018 my $ed_filename = $self->export_path . $filename;
1019 push(@filenames, $filename);
1020 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1021 my $header = $self->make_kne_data_header($form);
1022 $remaining_bytes -= length($header);
1026 my (@where, @values) = ((), ());
1027 if ($self->accnofrom) {
1028 push @where, 'c.accno >= ?';
1029 push @values, $self->accnofrom;
1031 if ($self->accnoto) {
1032 push @where, 'c.accno <= ?';
1033 push @values, $self->accnoto;
1036 my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1038 my $query = qq|SELECT c.accno, c.description
1043 my $sth = $self->dbh->prepare($query);
1044 $sth->execute(@values) || $form->dberror($query);
1046 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1047 if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1048 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1049 $buchungssatz .= "\x00" x $fuellzeichen;
1051 $total_bytes = ($blockcount) * 256;
1053 $buchungssatz .= "t" . $ref->{'accno'};
1054 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1055 $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1056 $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1057 $ref->{'description'} =~ s/\ *$//;
1060 ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1063 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1064 $buchungssatz .= "\x00" x $fuellzeichen;
1066 $total_bytes = ($blockcount) * 256;
1068 $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1069 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1074 print(ED $buchungssatz);
1075 $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1076 my $dateiende = "\x00" x $fuellzeichen;
1078 print(ED $dateiende);
1081 #Make EV Verwaltungsdatei
1083 $self->make_ed_versionset($header, $filename, $blockcount);
1085 my $ev_header = $self->make_ev_header($form, $fileno);
1086 my $ev_filename = $self->export_path . $evfile;
1087 push(@filenames, $evfile);
1088 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1089 print(EV $ev_header);
1091 foreach my $file (@ed_versionset) {
1092 print(EV $ed_versionset[$file]);
1096 $self->add_filenames(@filenames);
1098 $main::lxdebug->leave_sub();
1100 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1105 return $accno . ('0' x (6 - min(length($accno), 6)));
1108 sub csv_export_for_tax_accountant {
1111 $self->_get_transactions(from_to => $self->fromto);
1113 foreach my $transaction (@{ $self->{DATEV} }) {
1114 foreach my $entry (@{ $transaction }) {
1115 $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1120 partition_by { $_->[0]->{table} }
1121 sort_by { $_->[0]->{sortkey} }
1122 grep { 2 == scalar(@{ $_ }) }
1123 @{ $self->{DATEV} };
1126 acc_trans_id => { 'text' => $::locale->text('ID'), },
1127 amount => { 'text' => $::locale->text('Amount'), },
1128 credit_accname => { 'text' => $::locale->text('Credit Account Name'), },
1129 credit_accno => { 'text' => $::locale->text('Credit Account'), },
1130 debit_accname => { 'text' => $::locale->text('Debit Account Name'), },
1131 debit_accno => { 'text' => $::locale->text('Debit Account'), },
1132 invnumber => { 'text' => $::locale->text('Reference'), },
1133 name => { 'text' => $::locale->text('Name'), },
1134 notes => { 'text' => $::locale->text('Notes'), },
1135 tax => { 'text' => $::locale->text('Tax'), },
1136 taxkey => { 'text' => $::locale->text('Taxkey'), },
1137 tax_accname => { 'text' => $::locale->text('Tax Account Name'), },
1138 tax_accno => { 'text' => $::locale->text('Tax Account'), },
1139 transdate => { 'text' => $::locale->text('Invoice Date'), },
1140 vcnumber => { 'text' => $::locale->text('Customer/Vendor Number'), },
1144 acc_trans_id name vcnumber
1145 transdate invnumber amount
1146 debit_accno debit_accname
1147 credit_accno credit_accname
1149 tax_accno tax_accname taxkey
1153 my %filenames_by_type = (
1154 ar => $::locale->text('AR Transactions'),
1155 ap => $::locale->text('AP Transactions'),
1156 gl => $::locale->text('GL Transactions'),
1160 foreach my $type (qw(ap ar)) {
1164 filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1165 csv => Text::CSV_XS->new({
1173 filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1174 csv => Text::CSV_XS->new({
1182 foreach my $csv (values %csvs) {
1183 $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1184 $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1186 push @filenames, $csv->{filename};
1189 foreach my $transaction (@{ $transactions{$type} }) {
1190 my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1191 my $csv = $is_payment ? $csvs{payments} : $csvs{invoices};
1193 my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1194 my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
1195 my $amount = defined($soll->{net_amount}) ? $soll : $haben;
1196 $haben->{notes} = ($haben->{memo} || $soll->{memo}) if $is_payment;
1197 $haben->{notes} //= '';
1198 $haben->{notes} = SL::HTML::Util->strip($haben->{notes});
1199 $haben->{notes} =~ s{\r}{}g;
1200 $haben->{notes} =~ s{\n+}{ }g;
1203 amount => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1204 debit_accno => _format_accno($soll->{accno}),
1205 debit_accname => $soll->{accname},
1206 credit_accno => _format_accno($haben->{accno}),
1207 credit_accname => $haben->{accname},
1208 tax => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1209 notes => $haben->{notes},
1210 (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno)),
1211 (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1214 $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1217 $_->{out}->close for values %csvs;
1220 $self->add_filenames(@filenames);
1222 return { download_token => $self->download_token, filenames => \@filenames };
1226 clean_temporary_directories();
1237 SL::DATEV - kivitendo DATEV Export module
1241 use SL::DATEV qw(:CONSTANTS);
1243 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1244 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1245 my $datev = SL::DATEV->new(
1246 exporttype => DATEV_ET_BUCHUNGEN,
1247 format => DATEV_FORMAT_KNE,
1252 # To only export transactions from a specific trans_id: (from and to are ignored)
1253 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1254 my $datev = SL::DATEV->new(
1255 exporttype => DATEV_ET_BUCHUNGEN,
1256 format => DATEV_FORMAT_KNE,
1257 trans_id => $invoice->trans_id,
1260 my $datev = SL::DATEV->new(
1261 exporttype => DATEV_ET_STAMM,
1262 format => DATEV_FORMAT_KNE,
1263 accnofrom => $start_account_number,
1264 accnoto => $end_account_number,
1267 # get or set datev stamm
1268 my $hashref = $datev->get_datev_stamm;
1269 $datev->save_datev_stamm($hashref);
1271 # manually clean up temporary directories older than 8 hours
1272 $datev->clean_temporary_directories;
1277 if ($datev->errors) {
1278 die join "\n", $datev->error;
1281 # get relevant data for saving the export:
1282 my $dl_token = $datev->download_token;
1283 my $path = $datev->export_path;
1284 my @files = $datev->filenames;
1286 # retrieving an export at a later time
1287 my $datev = SL::DATEV->new(
1288 download_token => $dl_token_from_user,
1291 my $path = $datev->export_path;
1292 my @files = glob("$path/*");
1296 This module implements the DATEV export standard. For usage see above.
1304 Generic constructor. See section attributes for information about what to pass.
1306 =item get_datev_stamm
1308 Loads DATEV Stammdaten and returns as hashref.
1310 =item save_datev_stamm HASHREF
1312 Saves DATEV Stammdaten from provided hashref.
1316 See L<CONSTANTS> for possible values
1318 =item has_exporttype
1320 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1324 Specifies the designated format of the export. Currently only KNE export is implemented.
1326 See L<CONSTANTS> for possible values
1330 Returns true if a format has been set. Without format most report functions won't work.
1332 =item download_token
1334 Returns a download token for this DATEV object.
1336 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1340 Returns an export_path for this DATEV object.
1342 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1346 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.
1348 =item net_gross_differences
1350 If there were any net gross differences during calculation they will be collected here.
1352 =item sum_net_gross_differences
1354 Sum of all differences.
1356 =item clean_temporary_directories
1358 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.
1362 Returns a list of errors that occured. If no errors occured, the export was a success.
1366 Exports data. You have to have set L<exporttype> and L<format> or an error will
1367 occur. OBE exports are currently not implemented.
1373 This is a list of attributes set in either the C<new> or a method of the same name.
1379 Set a database handle to use in the process. This allows for an export to be
1380 done on a transaction in progress without committing first.
1382 Note: If you don't want this code to commit, simply providing a dbh is not
1383 enough enymore. You'll have to wrap the call into a transaction yourself, so
1384 that the internal transaction does not commit.
1388 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1392 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1394 =item download_token
1396 Can be set on creation to retrieve a prior export for download.
1402 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1403 set for the export to work.
1407 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1408 L<from> and L<to> are currently still needed for the query to be assembled
1415 Set boundary account numbers for the export. Only useful for a stammdaten export.
1421 =head2 Supplied to L<exporttype>
1425 =item DATEV_ET_BUCHUNGEN
1427 =item DATEV_ET_STAMM
1431 =head2 Supplied to L<format>.
1435 =item DATEV_FORMAT_KNE
1437 =item DATEV_FORMAT_OBE
1441 =head1 ERROR HANDLING
1443 This module will die in the following cases:
1449 No or unrecognized exporttype or format was provided for an export
1453 OBE export was called, which is not yet implemented.
1461 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1467 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1471 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1472 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1476 =head1 BUGS AND CAVEATS
1482 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1486 OBE export is currently not implemented.
1492 - handling of export_path and download token is a bit dodgy, clean that up.
1496 L<SL::DATEV::KNEFile>
1500 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1502 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1504 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1506 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1508 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,