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 ();
39 use Exporter qw(import);
42 use List::MoreUtils qw(any);
43 use List::Util qw(min max sum);
44 use List::UtilsBy qw(partition_by sort_by);
46 use Time::HiRes qw(gettimeofday);
51 DATEV_ET_BUCHUNGEN => $i++,
52 DATEV_ET_STAMM => $i++,
55 DATEV_FORMAT_KNE => $i++,
56 DATEV_FORMAT_OBE => $i++,
60 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE);
61 our @EXPORT_OK = (@export_constants);
62 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
69 my $obj = bless {}, $class;
71 $obj->$_($data{$_}) for keys %data;
78 $self->{exporttype} = $_[0] if @_;
79 return $self->{exporttype};
83 defined $_[0]->{exporttype};
88 $self->{format} = $_[0] if @_;
89 return $self->{format};
93 defined $_[0]->{format};
96 sub _get_export_path {
97 $main::lxdebug->enter_sub();
99 my ($a, $b) = gettimeofday();
100 my $path = _get_path_for_download_token("${a}-${b}-${$}");
102 mkpath($path) unless (-d $path);
104 $main::lxdebug->leave_sub();
109 sub _get_path_for_download_token {
110 $main::lxdebug->enter_sub();
112 my $token = shift || '';
115 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
116 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
119 $main::lxdebug->leave_sub();
124 sub _get_download_token_for_path {
125 $main::lxdebug->enter_sub();
130 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
131 $token = "${1}-${2}-${3}";
134 $main::lxdebug->leave_sub();
141 $self->{download_token} = $_[0] if @_;
142 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
148 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
153 push @{ $self->{filenames} ||= [] }, @_;
157 return @{ $_[0]{filenames} || [] };
162 push @{ $self->{errors} ||= [] }, @_;
166 return @{ $_[0]{errors} || [] };
169 sub add_net_gross_differences {
171 push @{ $self->{net_gross_differences} ||= [] }, @_;
174 sub net_gross_differences {
175 return @{ $_[0]{net_gross_differences} || [] };
178 sub sum_net_gross_differences {
179 return sum $_[0]->net_gross_differences;
186 $self->{from} = $_[0];
189 return $self->{from};
206 $self->{trans_id} = $_[0];
209 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
211 return $self->{trans_id};
218 $self->{accnofrom} = $_[0];
221 return $self->{accnofrom};
228 $self->{accnoto} = $_[0];
231 return $self->{accnoto};
239 $self->{dbh} = $_[0];
240 $self->{provided_dbh} = 1;
243 $self->{dbh} ||= SL::DB->client->dbh;
250 sub clean_temporary_directories {
251 $::lxdebug->enter_sub;
253 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
254 next unless -d $path;
256 my $mtime = (stat($path))[9];
257 next if ((time() - $mtime) < 8 * 60 * 60);
262 $::lxdebug->leave_sub;
266 $main::lxdebug->enter_sub();
268 my $text = shift // '';
269 my $field_len = shift;
270 my $fill_char = shift;
271 my $alignment = shift || 'right';
273 my $text_len = length $text;
275 if ($field_len < $text_len) {
276 $text = substr $text, 0, $field_len;
278 } elsif ($field_len > $text_len) {
279 my $filler = ($fill_char) x ($field_len - $text_len);
280 $text = $alignment eq 'right' ? $filler . $text : $text . $filler;
283 $main::lxdebug->leave_sub();
288 sub get_datev_stamm {
289 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
292 sub save_datev_stamm {
293 my ($self, $data) = @_;
295 SL::DB->client->with_transaction(sub {
296 do_query($::form, $self->dbh, 'DELETE FROM datev');
298 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
300 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
301 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
303 }) or do { die SL::DB->client->error };
310 die 'no format set!' unless $self->has_format;
312 if ($self->format == DATEV_FORMAT_KNE) {
313 $result = $self->kne_export;
314 } elsif ($self->format == DATEV_FORMAT_OBE) {
315 $result = $self->obe_export;
317 die 'unrecognized export format';
327 die 'no exporttype set!' unless $self->has_exporttype;
329 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
330 $result = $self->kne_buchungsexport;
331 } elsif ($self->exporttype == DATEV_ET_STAMM) {
332 $result = $self->kne_stammdatenexport;
333 } elsif ($self->exporttype == DATEV_ET_CSV) {
334 $result = $self->csv_export_for_tax_accountant;
336 die 'unrecognized exporttype';
343 die 'not yet implemented';
349 return unless $self->from && $self->to;
351 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
358 sub _get_transactions {
359 $main::lxdebug->enter_sub();
361 my ($self, %params) = @_;
362 my $fromto = $params{from_to};
363 my $progress_callback = $params{progress_callback} || sub {};
365 my $form = $main::form;
367 my $trans_id_filter = '';
369 if ( $self->{trans_id} ) {
370 # ignore dates when trans_id is passed so that the entire transaction is
371 # checked, not just either the initial bookings or the subsequent payments
372 # (the transdates will likely differ)
374 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
376 $fromto =~ s/transdate/ac\.transdate/g;
381 my $filter = ''; # Useful for debugging purposes
383 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');
386 qq|SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
387 ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate,
388 ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
389 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
391 t.rate AS taxrate, t.taxdescription,
393 tc.accno AS tax_accno, tc.description AS tax_accname,
396 LEFT JOIN ar ON (ac.trans_id = ar.id)
397 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
398 LEFT JOIN chart c ON (ac.chart_id = c.id)
399 LEFT JOIN tax t ON (ac.tax_id = t.id)
400 LEFT JOIN chart tc ON (t.chart_id = tc.id)
401 WHERE (ar.id IS NOT NULL)
408 SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
409 ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate,
410 ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
411 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
413 t.rate AS taxrate, t.taxdescription,
415 tc.accno AS tax_accno, tc.description AS tax_accname,
418 LEFT JOIN ap ON (ac.trans_id = ap.id)
419 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
420 LEFT JOIN chart c ON (ac.chart_id = c.id)
421 LEFT JOIN tax t ON (ac.tax_id = t.id)
422 LEFT JOIN chart tc ON (t.chart_id = tc.id)
423 WHERE (ap.id IS NOT NULL)
430 SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
431 gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate,
432 gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
433 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
435 t.rate AS taxrate, t.taxdescription,
437 tc.accno AS tax_accno, tc.description AS tax_accname,
440 LEFT JOIN gl ON (ac.trans_id = gl.id)
441 LEFT JOIN chart c ON (ac.chart_id = c.id)
442 LEFT JOIN tax t ON (ac.tax_id = t.id)
443 LEFT JOIN chart tc ON (t.chart_id = tc.id)
444 WHERE (gl.id IS NOT NULL)
449 ORDER BY trans_id, acc_trans_id|;
451 my $sth = prepare_execute_query($form, $self->dbh, $query);
457 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
458 last unless $ref; # for single transactions
460 if (($counter % 500) == 0) {
461 $progress_callback->($counter);
464 my $trans = [ $ref ];
466 my $count = $ref->{amount};
469 # if the amount of a booking in a group is smaller than 0.02, any tax
470 # amounts will likely be smaller than 1 cent, so go into subcent mode
471 my $subcent = abs($count) < 0.02;
473 # records from acc_trans are ordered by trans_id and acc_trans_id
474 # first check for unbalanced ledger inside one trans_id
475 # there may be several groups inside a trans_id, e.g. the original booking and the payment
476 # each group individually should be exactly balanced and each group
477 # individually needs its own datev lines
479 # keep fetching new acc_trans lines until the end of a balanced group is reached
480 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
481 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
487 # check if trans_id of current acc_trans line is still the same as the
488 # trans_id of the first line in group, i.e. we haven't finished a 0-group
489 # before moving on to the next trans_id, error will likely be in the old
492 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
493 require SL::DB::Manager::AccTransaction;
494 if ( $trans->[0]->{trans_id} ) {
495 my $acc_trans_old_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
496 $self->add_error("Unbalanced ledger! Old: " . $acc_trans_old_obj->transaction_name) if ref($acc_trans_old_obj);
498 if ( $ref2->{trans_id} ) {
499 my $acc_trans_curr_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $ref2->{trans_id} ]);
500 $self->add_error("Unbalanced ledger! New:" . $acc_trans_curr_obj->transaction_name) if ref($acc_trans_curr_obj);
502 $self->add_error("count: $count");
506 push @{ $trans }, $ref2;
508 $count += $ref2->{amount};
512 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
513 my $ref = $trans->[$i];
514 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
515 if ( $all_taxchart_ids{$ref->{id}}
516 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
517 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
518 || $ref->{invoice})) {
522 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
523 && $ref->{is_tax} # that has "is_tax" set
524 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
525 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
526 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
531 if (scalar(@{$trans}) <= 2) {
532 push @{ $self->{DATEV} }, $trans;
536 # determine at which array position the reference value (called absumsatz) is
537 # and which amount it has
539 for my $j (0 .. (scalar(@{$trans}) - 1)) {
542 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
544 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
545 # true, instead of absumsatz use link AR/AP (there should only be one
548 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
549 # instead of absumsatz use link AR/AP (there should only be one, so jump
550 # out of search as soon as you find it )
553 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
554 # for ap/ar bookings we can always search for AR/AP in link and use that
555 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
556 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
557 $absumsatz = $trans->[$j]->{'amount'};
562 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
563 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
564 # there must be only one AR or AP chart in the booking
565 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
566 # manually pays an invoice in GL.
567 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
568 $notsplitindex = $j; # position in booking with highest amount
569 $absumsatz = $trans->[$j]->{'amount'};
574 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
575 my $rounding_error = 0;
578 # go through each line and determine if it is a tax booking or not
579 # skip all tax lines and notsplitindex line
580 # push all other accounts (e.g. income or expense) with corresponding taxkey
582 for my $j (0 .. (scalar(@{$trans}) - 1)) {
583 if ( ($j != $notsplitindex)
584 && !$trans->[$j]->{is_tax}
585 && ( $trans->[$j]->{'taxkey'} eq ""
586 || $trans->[$j]->{'taxkey'} eq "0"
587 || $trans->[$j]->{'taxkey'} eq "1"
588 || $trans->[$j]->{'taxkey'} eq "10"
589 || $trans->[$j]->{'taxkey'} eq "11")) {
591 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
593 $absumsatz += $trans->[$j]->{'amount'};
594 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
595 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
596 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
598 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
600 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
603 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
605 my $tax_rate = $trans->[$j]->{'taxrate'};
606 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
607 $new_trans{'tax_rate'} = 1 + $tax_rate;
609 if (!$trans->[$j]->{'invoice'}) {
610 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
611 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
612 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
613 $absumsatz += -1 * $new_trans{'amount'};
616 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
617 my $rounded = $form->round_amount($unrounded, 2);
619 $rounding_error = $unrounded - $rounded;
620 $new_trans{'amount'} = $rounded;
621 $new_trans{'umsatz'} = abs($rounded) * $ml;
622 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
623 $absumsatz -= $rounded;
626 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
627 push @taxed, $self->{DATEV}->[-1];
633 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
634 if ($idx >= scalar @taxed) {
635 last if (!$correction);
641 my $transaction = $taxed[$idx]->[0];
643 my $old_amount = $transaction->{amount};
644 my $old_correction = $correction;
647 if (!$transaction->{diff}) {
648 @possible_diffs = (0.01, -0.01);
650 @possible_diffs = ($transaction->{diff});
653 foreach my $diff (@possible_diffs) {
654 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
655 next if ($net_amount != $transaction->{net_amount});
657 $transaction->{diff} = $diff;
658 $transaction->{amount} += $diff;
659 $transaction->{umsatz} += $diff;
669 $absumsatz = $form->round_amount($absumsatz, 2);
670 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
671 require SL::DB::Manager::AccTransaction;
672 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
673 $self->add_error("Datev-Export fehlgeschlagen! Bei Transaktion " . $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>,