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++,
59 DATEV_FORMAT_CSV => $i++,
63 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV);
64 our @EXPORT_OK = (@export_constants);
65 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
72 my $obj = bless {}, $class;
74 $obj->$_($data{$_}) for keys %data;
81 $self->{exporttype} = $_[0] if @_;
82 return $self->{exporttype};
86 defined $_[0]->{exporttype};
91 $self->{format} = $_[0] if @_;
92 return $self->{format};
96 defined $_[0]->{format};
99 sub _get_export_path {
100 $main::lxdebug->enter_sub();
102 my ($a, $b) = gettimeofday();
103 my $path = _get_path_for_download_token("${a}-${b}-${$}");
105 mkpath($path) unless (-d $path);
107 $main::lxdebug->leave_sub();
112 sub _get_path_for_download_token {
113 $main::lxdebug->enter_sub();
115 my $token = shift || '';
118 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
119 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
122 $main::lxdebug->leave_sub();
127 sub _get_download_token_for_path {
128 $main::lxdebug->enter_sub();
133 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
134 $token = "${1}-${2}-${3}";
137 $main::lxdebug->leave_sub();
144 $self->{download_token} = $_[0] if @_;
145 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
151 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
156 push @{ $self->{filenames} ||= [] }, @_;
160 return @{ $_[0]{filenames} || [] };
165 push @{ $self->{errors} ||= [] }, @_;
169 return @{ $_[0]{errors} || [] };
172 sub add_net_gross_differences {
174 push @{ $self->{net_gross_differences} ||= [] }, @_;
177 sub net_gross_differences {
178 return @{ $_[0]{net_gross_differences} || [] };
181 sub sum_net_gross_differences {
182 return sum $_[0]->net_gross_differences;
189 $self->{from} = $_[0];
192 return $self->{from};
209 $self->{trans_id} = $_[0];
212 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
214 return $self->{trans_id};
221 $self->{accnofrom} = $_[0];
224 return $self->{accnofrom};
231 $self->{accnoto} = $_[0];
234 return $self->{accnoto};
242 $self->{dbh} = $_[0];
243 $self->{provided_dbh} = 1;
246 $self->{dbh} ||= SL::DB->client->dbh;
253 sub clean_temporary_directories {
254 $::lxdebug->enter_sub;
256 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
257 next unless -d $path;
259 my $mtime = (stat($path))[9];
260 next if ((time() - $mtime) < 8 * 60 * 60);
265 $::lxdebug->leave_sub;
269 $main::lxdebug->enter_sub();
271 my $text = shift // '';
272 my $field_len = shift;
273 my $fill_char = shift;
274 my $alignment = shift || 'right';
276 my $text_len = length $text;
278 if ($field_len < $text_len) {
279 $text = substr $text, 0, $field_len;
281 } elsif ($field_len > $text_len) {
282 my $filler = ($fill_char) x ($field_len - $text_len);
283 $text = $alignment eq 'right' ? $filler . $text : $text . $filler;
286 $main::lxdebug->leave_sub();
291 sub get_datev_stamm {
292 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
295 sub save_datev_stamm {
296 my ($self, $data) = @_;
298 SL::DB->client->with_transaction(sub {
299 do_query($::form, $self->dbh, 'DELETE FROM datev');
301 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
303 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
304 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
306 }) or do { die SL::DB->client->error };
313 die 'no format set!' unless $self->has_format;
315 if ($self->format == DATEV_FORMAT_CSV) {
316 $result = $self->csv_export;
317 } elsif ($self->format == DATEV_FORMAT_KNE) {
318 $result = $self->kne_export;
319 } elsif ($self->format == DATEV_FORMAT_OBE) {
320 $result = $self->obe_export;
322 die 'unrecognized export format';
332 die 'no exporttype set!' unless $self->has_exporttype;
334 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
335 $result = $self->kne_buchungsexport;
336 } elsif ($self->exporttype == DATEV_ET_STAMM) {
337 $result = $self->kne_stammdatenexport;
338 } elsif ($self->exporttype == DATEV_ET_CSV) {
339 $result = $self->csv_export_for_tax_accountant;
341 die 'unrecognized exporttype';
348 die 'not yet implemented';
352 die 'not yet implemented';
358 return unless $self->from && $self->to;
360 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
367 sub generate_datev_data {
368 $main::lxdebug->enter_sub();
370 my ($self, %params) = @_;
371 my $fromto = $params{from_to} // '';
372 my $progress_callback = $params{progress_callback} || sub {};
374 my $form = $main::form;
376 my $trans_id_filter = '';
377 my $ar_department_id_filter = '';
378 my $ap_department_id_filter = '';
379 my $gl_department_id_filter = '';
380 if ( $form->{department_id} ) {
381 $ar_department_id_filter = " AND ar.department_id = ? ";
382 $ap_department_id_filter = " AND ap.department_id = ? ";
383 $gl_department_id_filter = " AND gl.department_id = ? ";
386 my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter);
387 if ( $form->{gldatefrom} ) {
388 $gl_itime_filter = " AND gl.itime >= ? ";
389 $ar_itime_filter = " AND ar.itime >= ? ";
390 $ap_itime_filter = " AND ap.itime >= ? ";
393 if ( $self->{trans_id} ) {
394 # ignore dates when trans_id is passed so that the entire transaction is
395 # checked, not just either the initial bookings or the subsequent payments
396 # (the transdates will likely differ)
398 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
400 $fromto =~ s/transdate/ac\.transdate/g;
405 my $filter = ''; # Useful for debugging purposes
407 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');
410 qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
411 ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate, ar.itime::date,
412 ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL 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,
421 LEFT JOIN ar ON (ac.trans_id = ar.id)
422 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
423 LEFT JOIN chart c ON (ac.chart_id = c.id)
424 LEFT JOIN tax t ON (ac.tax_id = t.id)
425 LEFT JOIN chart tc ON (t.chart_id = tc.id)
426 WHERE (ar.id IS NOT NULL)
430 $ar_department_id_filter
435 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
436 ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate, ap.itime::date,
437 ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
438 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
440 t.rate AS taxrate, t.taxdescription,
442 tc.accno AS tax_accno, tc.description AS tax_accname,
446 LEFT JOIN ap ON (ac.trans_id = ap.id)
447 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
448 LEFT JOIN chart c ON (ac.chart_id = c.id)
449 LEFT JOIN tax t ON (ac.tax_id = t.id)
450 LEFT JOIN chart tc ON (t.chart_id = tc.id)
451 WHERE (ap.id IS NOT NULL)
455 $ap_department_id_filter
460 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
461 gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate, gl.itime::date,
462 gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
463 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
465 t.rate AS taxrate, t.taxdescription,
467 tc.accno AS tax_accno, tc.description AS tax_accname,
471 LEFT JOIN gl ON (ac.trans_id = gl.id)
472 LEFT JOIN chart c ON (ac.chart_id = c.id)
473 LEFT JOIN tax t ON (ac.tax_id = t.id)
474 LEFT JOIN chart tc ON (t.chart_id = tc.id)
475 WHERE (gl.id IS NOT NULL)
479 $gl_department_id_filter
482 ORDER BY trans_id, acc_trans_id|;
485 if ( $form->{gldatefrom} or $form->{department_id} ) {
488 if ( $form->{gldatefrom} ) {
489 my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom});
490 die "illegal data" unless ref($glfromdate) eq 'DateTime';
491 push(@query_args, $glfromdate);
493 if ( $form->{department_id} ) {
494 push(@query_args, $form->{department_id});
499 my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
505 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
506 last unless $ref; # for single transactions
508 if (($counter % 500) == 0) {
509 $progress_callback->($counter);
512 my $trans = [ $ref ];
514 my $count = $ref->{amount};
517 # if the amount of a booking in a group is smaller than 0.02, any tax
518 # amounts will likely be smaller than 1 cent, so go into subcent mode
519 my $subcent = abs($count) < 0.02;
521 # records from acc_trans are ordered by trans_id and acc_trans_id
522 # first check for unbalanced ledger inside one trans_id
523 # there may be several groups inside a trans_id, e.g. the original booking and the payment
524 # each group individually should be exactly balanced and each group
525 # individually needs its own datev lines
527 # keep fetching new acc_trans lines until the end of a balanced group is reached
528 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
529 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
535 # check if trans_id of current acc_trans line is still the same as the
536 # trans_id of the first line in group, i.e. we haven't finished a 0-group
537 # before moving on to the next trans_id, error will likely be in the old
540 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
541 require SL::DB::Manager::AccTransaction;
542 if ( $trans->[0]->{trans_id} ) {
543 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
544 $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
545 $acc_trans_obj->transaction_name, $ref2->{trans_id})
551 push @{ $trans }, $ref2;
553 $count += $ref2->{amount};
557 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
558 my $ref = $trans->[$i];
559 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
560 if ( $all_taxchart_ids{$ref->{id}}
561 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
562 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
563 || $ref->{invoice})) {
567 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
568 && $ref->{is_tax} # that has "is_tax" set
569 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
570 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
571 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
576 if (scalar(@{$trans}) <= 2) {
577 push @{ $self->{DATEV} }, $trans;
581 # determine at which array position the reference value (called absumsatz) is
582 # and which amount it has
584 for my $j (0 .. (scalar(@{$trans}) - 1)) {
587 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
589 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
590 # true, instead of absumsatz use link AR/AP (there should only be one
593 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
594 # instead of absumsatz use link AR/AP (there should only be one, so jump
595 # out of search as soon as you find it )
598 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
599 # for ap/ar bookings we can always search for AR/AP in link and use that
600 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
601 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
602 $absumsatz = $trans->[$j]->{'amount'};
607 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
608 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
609 # there must be only one AR or AP chart in the booking
610 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
611 # manually pays an invoice in GL.
612 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
613 $notsplitindex = $j; # position in booking with highest amount
614 $absumsatz = $trans->[$j]->{'amount'};
619 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
620 my $rounding_error = 0;
623 # go through each line and determine if it is a tax booking or not
624 # skip all tax lines and notsplitindex line
625 # push all other accounts (e.g. income or expense) with corresponding taxkey
627 for my $j (0 .. (scalar(@{$trans}) - 1)) {
628 if ( ($j != $notsplitindex)
629 && !$trans->[$j]->{is_tax}
630 && ( $trans->[$j]->{'taxkey'} eq ""
631 || $trans->[$j]->{'taxkey'} eq "0"
632 || $trans->[$j]->{'taxkey'} eq "1"
633 || $trans->[$j]->{'taxkey'} eq "10"
634 || $trans->[$j]->{'taxkey'} eq "11")) {
636 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
638 $absumsatz += $trans->[$j]->{'amount'};
639 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
640 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
641 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
643 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
645 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
648 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
650 my $tax_rate = $trans->[$j]->{'taxrate'};
651 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
652 $new_trans{'tax_rate'} = 1 + $tax_rate;
654 if (!$trans->[$j]->{'invoice'}) {
655 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
656 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
657 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
658 $absumsatz += -1 * $new_trans{'amount'};
661 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
662 my $rounded = $form->round_amount($unrounded, 2);
664 $rounding_error = $unrounded - $rounded;
665 $new_trans{'amount'} = $rounded;
666 $new_trans{'umsatz'} = abs($rounded) * $ml;
667 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
668 $absumsatz -= $rounded;
671 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
672 push @taxed, $self->{DATEV}->[-1];
678 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
679 if ($idx >= scalar @taxed) {
680 last if (!$correction);
686 my $transaction = $taxed[$idx]->[0];
688 my $old_amount = $transaction->{amount};
689 my $old_correction = $correction;
692 if (!$transaction->{diff}) {
693 @possible_diffs = (0.01, -0.01);
695 @possible_diffs = ($transaction->{diff});
698 foreach my $diff (@possible_diffs) {
699 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
700 next if ($net_amount != $transaction->{net_amount});
702 $transaction->{diff} = $diff;
703 $transaction->{amount} += $diff;
704 $transaction->{umsatz} += $diff;
714 $absumsatz = $form->round_amount($absumsatz, 2);
715 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
716 require SL::DB::Manager::AccTransaction;
717 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
718 $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
719 $acc_trans_obj->transaction_name, $absumsatz)
721 } elsif (abs($absumsatz) >= 0.01) {
722 $self->add_net_gross_differences($absumsatz);
728 $::lxdebug->leave_sub;
731 sub make_kne_data_header {
732 $main::lxdebug->enter_sub();
734 my ($self, $form) = @_;
737 my $stamm = $self->get_datev_stamm;
739 my $jahr = $self->from ? $self->from->year : DateTime->today->year;
742 my $header = "\x1D\x181";
743 $header .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
744 $header .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
745 $header .= _fill($stamm->{dfvkz}, 2, '0');
746 $header .= _fill($stamm->{beraternr}, 7, '0');
747 $header .= _fill($stamm->{mandantennr}, 5, '0');
748 $header .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
750 $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
751 $header .= $self->to ? $self->to->strftime('%d%m%y') : '';
755 $header .= $primanota;
758 $header .= _fill($stamm->{passwort}, 4, '0');
759 $header .= " " x 16; # Anwendungsinfo
760 $header .= " " x 16; # Inputinfo
764 my $versionssatz = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
766 my $query = qq|SELECT accno FROM chart LIMIT 1|;
767 my $ref = selectfirst_hashref_query($form, $self->dbh, $query);
769 $versionssatz .= length $ref->{accno};
770 $versionssatz .= ",";
771 $versionssatz .= length $ref->{accno};
772 $versionssatz .= ",SELF" . "\x1C\x79";
774 $header .= $versionssatz;
776 $main::lxdebug->leave_sub();
782 $main::lxdebug->enter_sub();
784 my ($date, $six) = @_;
786 my ($day, $month, $year) = split(/\./, $date);
789 $day = substr($day, 1, 1);
791 if (length($month) < 2) {
792 $month = "0" . $month;
794 if (length($year) > 2) {
795 $year = substr($year, -2, 2);
799 $date = $day . $month . $year;
801 $date = $day . $month;
804 $main::lxdebug->leave_sub();
809 sub trim_leading_zeroes {
817 sub make_ed_versionset {
818 $main::lxdebug->enter_sub();
820 my ($self, $header, $filename, $blockcount) = @_;
822 my $versionset = "V" . substr($filename, 2, 5);
823 $versionset .= substr($header, 6, 22);
826 $versionset .= "0000" . substr($header, 28, 19);
828 my $datum = " " x 16;
829 $versionset .= $datum . "001" . substr($header, 28, 4);
832 $versionset .= _fill($blockcount, 5, '0');
833 $versionset .= "001";
835 $versionset .= substr($header, -12, 10) . " ";
836 $versionset .= " " x 53;
838 $main::lxdebug->leave_sub();
844 $main::lxdebug->enter_sub();
846 my ($self, $form, $fileno) = @_;
848 my $stamm = $self->get_datev_stamm;
850 my $ev_header = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
852 $ev_header .= _fill($stamm->{beraternr}, 7, ' ', 'left');
853 $ev_header .= _fill($stamm->{beratername}, 9, ' ', 'left');
855 $ev_header .= (_fill($fileno, 5, '0')) x 2;
856 $ev_header .= " " x 95;
858 $main::lxdebug->leave_sub();
863 sub generate_datev_lines {
866 my @datev_lines = ();
868 foreach my $transaction ( @{ $self->{DATEV} } ) {
870 # each $transaction entry contains data from several acc_trans entries
871 # belonging to the same trans_id
873 my %datev_data = (); # data for one transaction
874 my $trans_lines = scalar(@{$transaction});
882 my $buchungstext = "";
884 my $datevautomatik = 0;
889 for (my $i = 0; $i < $trans_lines; $i++) {
890 if ($trans_lines == 2) {
891 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
892 $umsatz = $transaction->[$i]->{'amount'};
895 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
896 $umsatz = $transaction->[$i]->{'umsatz'};
899 if ($transaction->[$i]->{'datevautomatik'}) {
902 if ($transaction->[$i]->{'taxkey'}) {
903 $taxkey = $transaction->[$i]->{'taxkey'};
905 if ($transaction->[$i]->{'charttax'}) {
906 $charttax = $transaction->[$i]->{'charttax'};
908 if ($transaction->[$i]->{'amount'} > 0) {
915 if ($trans_lines >= 2) {
917 $datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
918 $datev_data{'konto'} = $transaction->[$soll]->{'accno'};
919 if ($transaction->[$haben]->{'invnumber'} ne "") {
920 $datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
922 $datev_data{datum} = $transaction->[$haben]->{'transdate'};
923 $datev_data{waehrung} = 'EUR';
925 if ($transaction->[$haben]->{'name'} ne "") {
926 $datev_data{buchungstext} = $transaction->[$haben]->{'name'};
928 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
929 $datev_data{ustid} = $transaction->[$haben]->{'ustid'};
931 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
932 $datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
936 $datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
938 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
939 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
940 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
941 # Skript angelegt werden.
942 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
943 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
944 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
945 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
946 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
949 # only set buchungsschluessel if the following conditions are met:
950 if ( ( $datevautomatik || $taxkey)
951 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
952 # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
953 $datev_data{buchungsschluessel} = $taxkey;
956 push(@datev_lines, \%datev_data);
959 # example of modifying export data:
960 # foreach my $datev_line ( @datev_lines ) {
961 # if ( $datev_line{"konto"} eq '1234' ) {
962 # $datev_line{"konto"} = '9999';
967 return \@datev_lines;
971 sub kne_buchungsexport {
972 $main::lxdebug->enter_sub();
980 my $filename = "ED00001";
984 my $ed_filename = $self->export_path . $filename;
986 my $fromto = $self->fromto;
988 $self->generate_datev_data(from_to => $self->fromto); # fetches data from db, transforms data and fills $self->{DATEV}
989 return if $self->errors;
991 my @datev_lines = @{ $self->generate_datev_lines };
994 my $umsatzsumme = sum map { $_->{umsatz} } @datev_lines;
996 # prepare kne file, everything gets stored in ED00001
997 my $header = $self->make_kne_data_header($form);
998 my $kne_file = SL::DATEV::KNEFile->new();
999 $kne_file->add_block($header);
1001 my $iconv = $::locale->{iconv_utf8};
1002 my %umlaute = ($iconv->convert('ä') => 'ae',
1003 $iconv->convert('ö') => 'oe',
1004 $iconv->convert('ü') => 'ue',
1005 $iconv->convert('Ä') => 'Ae',
1006 $iconv->convert('Ö') => 'Oe',
1007 $iconv->convert('Ü') => 'Ue',
1008 $iconv->convert('ß') => 'sz');
1010 # add the data from @datev_lines to the kne_file, formatting as needed
1011 foreach my $kne ( @datev_lines ) {
1012 $kne_file->add_block("+" . $kne_file->format_amount(abs($kne->{umsatz}), 0));
1014 # only add buchungsschluessel if it was previously defined
1015 $kne_file->add_block("\x6C" . $kne->{buchungsschluessel}) if defined $kne->{buchungsschluessel};
1017 # ($kne->{gegenkonto}) = $kne->{gegenkonto} =~ /^(\d+)/;
1018 $kne_file->add_block("a" . trim_leading_zeroes($kne->{gegenkonto}));
1020 if ( $kne->{belegfeld1} ) {
1021 my $invnumber = $kne->{belegfeld1};
1022 foreach my $umlaut (keys(%umlaute)) {
1023 $invnumber =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1025 $invnumber =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1026 $invnumber = substr($invnumber, 0, 12);
1027 $invnumber =~ s/\ *$//;
1028 $kne_file->add_block("\xBD" . $invnumber . "\x1C");
1031 $kne_file->add_block("\xBE" . &datetofour($kne->{belegfeld2},1) . "\x1C");
1033 $kne_file->add_block("d" . &datetofour($kne->{datum},0));
1035 # ($kne->{konto}) = $kne->{konto} =~ /^(\d+)/;
1036 $kne_file->add_block("e" . trim_leading_zeroes($kne->{konto}));
1038 my $name = $kne->{buchungstext};
1039 foreach my $umlaut (keys(%umlaute)) {
1040 $name =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1042 $name =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
1043 $name = substr($name, 0, 30);
1045 $kne_file->add_block("\x1E" . $name . "\x1C");
1047 $kne_file->add_block("\xBA" . $kne->{'ustid'} . "\x1C") if $kne->{'ustid'};
1049 $kne_file->add_block("\xB3" . $kne->{'waehrung'} . "\x1C" . "\x79");
1052 $umsatzsumme = $kne_file->format_amount(abs($umsatzsumme), 0);
1053 my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
1055 $kne_file->add_block($mandantenendsumme);
1058 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1059 print(ED $kne_file->get_data());
1062 $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
1064 #Make EV Verwaltungsdatei
1065 my $ev_header = $self->make_ev_header($form, $fileno);
1066 my $ev_filename = $self->export_path . $evfile;
1067 push(@filenames, $evfile);
1068 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1069 print(EV $ev_header);
1071 foreach my $file (@ed_versionset) {
1077 $self->add_filenames(@filenames);
1079 $main::lxdebug->leave_sub();
1081 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1084 sub kne_stammdatenexport {
1085 $main::lxdebug->enter_sub();
1090 $self->get_datev_stamm->{abrechnungsnr} = "99";
1094 my $filename = "ED00000";
1095 my $evfile = "EV01";
1100 my $remaining_bytes = 256;
1101 my $total_bytes = 256;
1102 my $buchungssatz = "";
1104 my $ed_filename = $self->export_path . $filename;
1105 push(@filenames, $filename);
1106 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1107 my $header = $self->make_kne_data_header($form);
1108 $remaining_bytes -= length($header);
1112 my (@where, @values) = ((), ());
1113 if ($self->accnofrom) {
1114 push @where, 'c.accno >= ?';
1115 push @values, $self->accnofrom;
1117 if ($self->accnoto) {
1118 push @where, 'c.accno <= ?';
1119 push @values, $self->accnoto;
1122 my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1124 my $query = qq|SELECT c.accno, c.description
1129 my $sth = $self->dbh->prepare($query);
1130 $sth->execute(@values) || $form->dberror($query);
1132 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1133 if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1134 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1135 $buchungssatz .= "\x00" x $fuellzeichen;
1137 $total_bytes = ($blockcount) * 256;
1139 $buchungssatz .= "t" . $ref->{'accno'};
1140 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1141 $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1142 $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1143 $ref->{'description'} =~ s/\ *$//;
1146 ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1149 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1150 $buchungssatz .= "\x00" x $fuellzeichen;
1152 $total_bytes = ($blockcount) * 256;
1154 $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1155 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1160 print(ED $buchungssatz);
1161 $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1162 my $dateiende = "\x00" x $fuellzeichen;
1164 print(ED $dateiende);
1167 #Make EV Verwaltungsdatei
1169 $self->make_ed_versionset($header, $filename, $blockcount);
1171 my $ev_header = $self->make_ev_header($form, $fileno);
1172 my $ev_filename = $self->export_path . $evfile;
1173 push(@filenames, $evfile);
1174 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1175 print(EV $ev_header);
1177 foreach my $file (@ed_versionset) {
1178 print(EV $ed_versionset[$file]);
1182 $self->add_filenames(@filenames);
1184 $main::lxdebug->leave_sub();
1186 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1191 return $accno . ('0' x (6 - min(length($accno), 6)));
1194 sub csv_export_for_tax_accountant {
1197 $self->generate_datev_data(from_to => $self->fromto);
1199 foreach my $transaction (@{ $self->{DATEV} }) {
1200 foreach my $entry (@{ $transaction }) {
1201 $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1206 partition_by { $_->[0]->{table} }
1207 sort_by { $_->[0]->{sortkey} }
1208 grep { 2 == scalar(@{ $_ }) }
1209 @{ $self->{DATEV} };
1212 acc_trans_id => { 'text' => $::locale->text('ID'), },
1213 amount => { 'text' => $::locale->text('Amount'), },
1214 credit_accname => { 'text' => $::locale->text('Credit Account Name'), },
1215 credit_accno => { 'text' => $::locale->text('Credit Account'), },
1216 debit_accname => { 'text' => $::locale->text('Debit Account Name'), },
1217 debit_accno => { 'text' => $::locale->text('Debit Account'), },
1218 invnumber => { 'text' => $::locale->text('Reference'), },
1219 name => { 'text' => $::locale->text('Name'), },
1220 notes => { 'text' => $::locale->text('Notes'), },
1221 tax => { 'text' => $::locale->text('Tax'), },
1222 taxkey => { 'text' => $::locale->text('Taxkey'), },
1223 tax_accname => { 'text' => $::locale->text('Tax Account Name'), },
1224 tax_accno => { 'text' => $::locale->text('Tax Account'), },
1225 transdate => { 'text' => $::locale->text('Transdate'), },
1226 vcnumber => { 'text' => $::locale->text('Customer/Vendor Number'), },
1230 acc_trans_id name vcnumber
1231 transdate invnumber amount
1232 debit_accno debit_accname
1233 credit_accno credit_accname
1235 tax_accno tax_accname taxkey
1239 my %filenames_by_type = (
1240 ar => $::locale->text('AR Transactions'),
1241 ap => $::locale->text('AP Transactions'),
1242 gl => $::locale->text('GL Transactions'),
1246 foreach my $type (qw(ap ar)) {
1250 filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1251 csv => Text::CSV_XS->new({
1259 filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1260 csv => Text::CSV_XS->new({
1268 foreach my $csv (values %csvs) {
1269 $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1270 $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1272 push @filenames, $csv->{filename};
1275 foreach my $transaction (@{ $transactions{$type} }) {
1276 my $is_payment = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1277 my $csv = $is_payment ? $csvs{payments} : $csvs{invoices};
1279 my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1280 my $tax = defined($soll->{tax_accno}) ? $soll : $haben;
1281 my $amount = defined($soll->{net_amount}) ? $soll : $haben;
1282 $haben->{notes} = ($haben->{memo} || $soll->{memo}) if $is_payment;
1283 $haben->{notes} //= '';
1284 $haben->{notes} = SL::HTML::Util->strip($haben->{notes});
1285 $haben->{notes} =~ s{\r}{}g;
1286 $haben->{notes} =~ s{\n+}{ }g;
1289 amount => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1290 debit_accno => _format_accno($soll->{accno}),
1291 debit_accname => $soll->{accname},
1292 credit_accno => _format_accno($haben->{accno}),
1293 credit_accname => $haben->{accname},
1294 tax => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1295 notes => $haben->{notes},
1296 (map { ($_ => $tax->{$_}) } qw(taxkey tax_accname tax_accno)),
1297 (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1300 $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1303 $_->{out}->close for values %csvs;
1306 $self->add_filenames(@filenames);
1308 return { download_token => $self->download_token, filenames => \@filenames };
1312 clean_temporary_directories();
1323 SL::DATEV - kivitendo DATEV Export module
1327 use SL::DATEV qw(:CONSTANTS);
1329 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1330 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1331 my $datev = SL::DATEV->new(
1332 exporttype => DATEV_ET_BUCHUNGEN,
1333 format => DATEV_FORMAT_KNE,
1338 # To only export transactions from a specific trans_id: (from and to are ignored)
1339 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1340 my $datev = SL::DATEV->new(
1341 exporttype => DATEV_ET_BUCHUNGEN,
1342 format => DATEV_FORMAT_KNE,
1343 trans_id => $invoice->trans_id,
1346 my $datev = SL::DATEV->new(
1347 exporttype => DATEV_ET_STAMM,
1348 format => DATEV_FORMAT_KNE,
1349 accnofrom => $start_account_number,
1350 accnoto => $end_account_number,
1353 # get or set datev stamm
1354 my $hashref = $datev->get_datev_stamm;
1355 $datev->save_datev_stamm($hashref);
1357 # manually clean up temporary directories older than 8 hours
1358 $datev->clean_temporary_directories;
1363 if ($datev->errors) {
1364 die join "\n", $datev->error;
1367 # get relevant data for saving the export:
1368 my $dl_token = $datev->download_token;
1369 my $path = $datev->export_path;
1370 my @files = $datev->filenames;
1372 # retrieving an export at a later time
1373 my $datev = SL::DATEV->new(
1374 download_token => $dl_token_from_user,
1377 my $path = $datev->export_path;
1378 my @files = glob("$path/*");
1380 # Only test the datev data of a specific trans_id, without generating an
1381 # export file, but filling $datev->errors if errors exist
1383 my $datev = SL::DATEV->new(
1384 trans_id => $invoice->trans_id,
1386 $datev->generate_datev_data;
1387 # if ($datev->errors) { ...
1392 This module implements the DATEV export standard. For usage see above.
1400 Generic constructor. See section attributes for information about what to pass.
1402 =item generate_datev_data
1404 Fetches all transactions from the database (via a trans_id or a date range),
1405 and does an initial transformation (e.g. filters out tax, determines
1406 the brutto amount, checks split transactions ...) and stores this data in
1409 If any errors are found these are collected in $self->errors.
1411 This function is needed for all the exports, but can be also called
1412 independently in order to check transactions for DATEV compatibility.
1414 =item generate_datev_lines
1416 Parse the data in $self->{DATEV} and transform it into a format that can be
1417 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1419 The transformed data is returned as an arrayref, which is ready to be converted
1420 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1422 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1423 entries with datevautomatik have an empty taxkey, as the taxkey is already
1424 determined by the chart.
1426 =item get_datev_stamm
1428 Loads DATEV Stammdaten and returns as hashref.
1430 =item save_datev_stamm HASHREF
1432 Saves DATEV Stammdaten from provided hashref.
1436 See L<CONSTANTS> for possible values
1438 =item has_exporttype
1440 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1444 Specifies the designated format of the export. Currently only KNE export is implemented.
1446 See L<CONSTANTS> for possible values
1450 Returns true if a format has been set. Without format most report functions won't work.
1452 =item download_token
1454 Returns a download token for this DATEV object.
1456 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1460 Returns an export_path for this DATEV object.
1462 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1466 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.
1468 =item net_gross_differences
1470 If there were any net gross differences during calculation they will be collected here.
1472 =item sum_net_gross_differences
1474 Sum of all differences.
1476 =item clean_temporary_directories
1478 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.
1482 Returns a list of errors that occured. If no errors occured, the export was a success.
1486 Exports data. You have to have set L<exporttype> and L<format> or an error will
1487 occur. OBE exports are currently not implemented.
1489 =item csv_export_for_tax_accountant
1491 Generates up to four downloadable csv files containing data about sales and
1492 purchase invoices, and their respective payments:
1495 my $startdate = DateTime->new(year => 2012, month => 1, day => 1);
1496 my $enddate = DateTime->new(year => 2012, month => 12, day => 31);
1497 SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1499 # 'download_token' => '1488551625-815654-22430',
1501 # 'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1502 # 'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1503 # 'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1504 # 'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1512 This is a list of attributes set in either the C<new> or a method of the same name.
1518 Set a database handle to use in the process. This allows for an export to be
1519 done on a transaction in progress without committing first.
1521 Note: If you don't want this code to commit, simply providing a dbh is not
1522 enough enymore. You'll have to wrap the call into a transaction yourself, so
1523 that the internal transaction does not commit.
1527 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1531 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1533 =item download_token
1535 Can be set on creation to retrieve a prior export for download.
1541 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1542 set for the export to work.
1546 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1547 L<from> and L<to> are currently still needed for the query to be assembled
1554 Set boundary account numbers for the export. Only useful for a stammdaten export.
1560 =head2 Supplied to L<exporttype>
1564 =item DATEV_ET_BUCHUNGEN
1566 =item DATEV_ET_STAMM
1570 =head2 Supplied to L<format>.
1574 =item DATEV_FORMAT_KNE
1576 =item DATEV_FORMAT_OBE
1580 =head1 ERROR HANDLING
1582 This module will die in the following cases:
1588 No or unrecognized exporttype or format was provided for an export
1592 OBE export was called, which is not yet implemented.
1600 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1606 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1610 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1611 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1615 =head1 BUGS AND CAVEATS
1621 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1625 OBE export is currently not implemented.
1631 - handling of export_path and download token is a bit dodgy, clean that up.
1635 L<SL::DATEV::KNEFile>
1639 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1641 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1643 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1645 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1647 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,