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;
37 use Exporter qw(import);
39 use List::Util qw(max sum);
40 use Time::HiRes qw(gettimeofday);
45 DATEV_ET_BUCHUNGEN => $i++,
46 DATEV_ET_STAMM => $i++,
48 DATEV_FORMAT_KNE => $i++,
49 DATEV_FORMAT_OBE => $i++,
53 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_FORMAT_KNE DATEV_FORMAT_OBE);
54 our @EXPORT_OK = (@export_constants);
55 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
62 my $obj = bless {}, $class;
64 $obj->$_($data{$_}) for keys %data;
71 $self->{exporttype} = $_[0] if @_;
72 return $self->{exporttype};
76 defined $_[0]->{exporttype};
81 $self->{format} = $_[0] if @_;
82 return $self->{format};
86 defined $_[0]->{format};
89 sub _get_export_path {
90 $main::lxdebug->enter_sub();
92 my ($a, $b) = gettimeofday();
93 my $path = _get_path_for_download_token("${a}-${b}-${$}");
95 mkpath($path) unless (-d $path);
97 $main::lxdebug->leave_sub();
102 sub _get_path_for_download_token {
103 $main::lxdebug->enter_sub();
105 my $token = shift || '';
108 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
109 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
112 $main::lxdebug->leave_sub();
117 sub _get_download_token_for_path {
118 $main::lxdebug->enter_sub();
123 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
124 $token = "${1}-${2}-${3}";
127 $main::lxdebug->leave_sub();
134 $self->{download_token} = $_[0] if @_;
135 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
141 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
146 push @{ $self->{filenames} ||= [] }, @_;
150 return @{ $_[0]{filenames} || [] };
155 push @{ $self->{errors} ||= [] }, @_;
159 return @{ $_[0]{errors} || [] };
162 sub add_net_gross_differences {
164 push @{ $self->{net_gross_differences} ||= [] }, @_;
167 sub net_gross_differences {
168 return @{ $_[0]{net_gross_differences} || [] };
171 sub sum_net_gross_differences {
172 return sum $_[0]->net_gross_differences;
179 $self->{from} = $_[0];
182 return $self->{from};
199 $self->{trans_id} = $_[0];
202 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
204 return $self->{trans_id};
211 $self->{accnofrom} = $_[0];
214 return $self->{accnofrom};
221 $self->{accnoto} = $_[0];
224 return $self->{accnoto};
232 $self->{dbh} = $_[0];
233 $self->{provided_dbh} = 1;
236 $self->{dbh} ||= $::form->get_standard_dbh;
243 sub clean_temporary_directories {
244 $::lxdebug->enter_sub;
246 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
247 next unless -d $path;
249 my $mtime = (stat($path))[9];
250 next if ((time() - $mtime) < 8 * 60 * 60);
255 $::lxdebug->leave_sub;
259 $main::lxdebug->enter_sub();
261 my $text = shift // '';
262 my $field_len = shift;
263 my $fill_char = shift;
264 my $alignment = shift || 'right';
266 my $text_len = length $text;
268 if ($field_len < $text_len) {
269 $text = substr $text, 0, $field_len;
271 } elsif ($field_len > $text_len) {
272 my $filler = ($fill_char) x ($field_len - $text_len);
273 $text = $alignment eq 'right' ? $filler . $text : $text . $filler;
276 $main::lxdebug->leave_sub();
281 sub get_datev_stamm {
282 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
285 sub save_datev_stamm {
286 my ($self, $data) = @_;
288 do_query($::form, $self->dbh, 'DELETE FROM datev');
290 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
292 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
293 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
295 $self->dbh->commit unless $self->provided_dbh;
302 die 'no format set!' unless $self->has_format;
304 if ($self->format == DATEV_FORMAT_KNE) {
305 $result = $self->kne_export;
306 } elsif ($self->format == DATEV_FORMAT_OBE) {
307 $result = $self->obe_export;
309 die 'unrecognized export format';
319 die 'no exporttype set!' unless $self->has_exporttype;
321 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
322 $result = $self->kne_buchungsexport;
323 } elsif ($self->exporttype == DATEV_ET_STAMM) {
324 $result = $self->kne_stammdatenexport;
326 die 'unrecognized exporttype';
333 die 'not yet implemented';
339 return unless $self->from && $self->to;
341 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
348 sub _get_transactions {
349 $main::lxdebug->enter_sub();
352 my $progress_callback = shift || sub {};
354 my $form = $main::form;
356 my $trans_id_filter = '';
358 if ( $self->{trans_id} ) {
359 # ignore dates when trans_id is passed so that the entire transaction is
360 # checked, not just either the initial bookings or the subsequent payments
361 # (the transdates will likely differ)
363 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
365 $fromto =~ s/transdate/ac\.transdate/g;
370 my $filter = ''; # Useful for debugging purposes
372 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');
375 qq|SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey,
376 ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate,
378 c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
383 LEFT JOIN ar ON (ac.trans_id = ar.id)
384 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
385 LEFT JOIN chart c ON (ac.chart_id = c.id)
386 LEFT JOIN tax t ON (ac.tax_id = t.id)
387 WHERE (ar.id IS NOT NULL)
394 SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey,
395 ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate,
397 c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
402 LEFT JOIN ap ON (ac.trans_id = ap.id)
403 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
404 LEFT JOIN chart c ON (ac.chart_id = c.id)
405 LEFT JOIN tax t ON (ac.tax_id = t.id)
406 WHERE (ap.id IS NOT NULL)
413 SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey,
414 gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate,
415 gl.description AS name, NULL as ustid,
416 c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
421 LEFT JOIN gl ON (ac.trans_id = gl.id)
422 LEFT JOIN chart c ON (ac.chart_id = c.id)
423 LEFT JOIN tax t ON (ac.tax_id = t.id)
424 WHERE (gl.id IS NOT NULL)
429 ORDER BY trans_id, acc_trans_id|;
431 my $sth = prepare_execute_query($form, $self->dbh, $query);
437 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
438 last unless $ref; # for single transactions
440 if (($counter % 500) == 0) {
441 $progress_callback->($counter);
444 my $trans = [ $ref ];
446 my $count = $ref->{amount};
449 # if the amount of a booking in a group is smaller than 0.02, any tax
450 # amounts will likely be smaller than 1 cent, so go into subcent mode
451 my $subcent = abs($count) < 0.02;
453 # records from acc_trans are ordered by trans_id and acc_trans_id
454 # first check for unbalanced ledger inside one trans_id
455 # there may be several groups inside a trans_id, e.g. the original booking and the payment
456 # each group individually should be exactly balanced and each group
457 # individually needs its own datev lines
459 # keep fetching new acc_trans lines until the end of a balanced group is reached
460 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
461 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
467 # check if trans_id of current acc_trans line is still the same as the
468 # trans_id of the first line in group, i.e. we haven't finished a 0-group
469 # before moving on to the next trans_id, error will likely be in the old
472 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
473 require SL::DB::Manager::AccTransaction;
474 if ( $trans->[0]->{trans_id} ) {
475 my $acc_trans_old_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
476 $self->add_error("Unbalanced ledger! Old: " . $acc_trans_old_obj->transaction_name) if ref($acc_trans_old_obj);
478 if ( $ref2->{trans_id} ) {
479 my $acc_trans_curr_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $ref2->{trans_id} ]);
480 $self->add_error("Unbalanced ledger! New:" . $acc_trans_curr_obj->transaction_name) if ref($acc_trans_curr_obj);
482 $self->add_error("count: $count");
486 push @{ $trans }, $ref2;
488 $count += $ref2->{amount};
492 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
493 my $ref = $trans->[$i];
494 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
495 if ( $all_taxchart_ids{$ref->{id}}
496 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
497 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
498 || $ref->{invoice})) {
502 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
503 && $ref->{is_tax} # that has "is_tax" set
504 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
505 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
506 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
511 if (scalar(@{$trans}) <= 2) {
512 push @{ $self->{DATEV} }, $trans;
516 # determine at which array position the reference value (called absumsatz) is
517 # and which amount it has
519 for my $j (0 .. (scalar(@{$trans}) - 1)) {
522 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
524 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
525 # true, instead of absumsatz use link AR/AP (there should only be one
528 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
529 # instead of absumsatz use link AR/AP (there should only be one, so jump
530 # out of search as soon as you find it )
533 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
534 # for ap/ar bookings we can always search for AR/AP in link and use that
535 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
536 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
537 $absumsatz = $trans->[$j]->{'amount'};
542 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
543 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
544 # there must be only one AR or AP chart in the booking
545 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
546 # manually pays an invoice in GL.
547 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
548 $notsplitindex = $j; # position in booking with highest amount
549 $absumsatz = $trans->[$j]->{'amount'};
554 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
555 my $rounding_error = 0;
558 # go through each line and determine if it is a tax booking or not
559 # skip all tax lines and notsplitindex line
560 # push all other accounts (e.g. income or expense) with corresponding taxkey
562 for my $j (0 .. (scalar(@{$trans}) - 1)) {
563 if ( ($j != $notsplitindex)
564 && !$trans->[$j]->{is_tax}
565 && ( $trans->[$j]->{'taxkey'} eq ""
566 || $trans->[$j]->{'taxkey'} eq "0"
567 || $trans->[$j]->{'taxkey'} eq "1"
568 || $trans->[$j]->{'taxkey'} eq "10"
569 || $trans->[$j]->{'taxkey'} eq "11")) {
571 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
573 $absumsatz += $trans->[$j]->{'amount'};
574 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
575 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
576 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
578 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
580 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
583 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
585 my $tax_rate = $trans->[$j]->{'taxrate'};
586 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
587 $new_trans{'tax_rate'} = 1 + $tax_rate;
589 if (!$trans->[$j]->{'invoice'}) {
590 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
591 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
592 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
593 $absumsatz += -1 * $new_trans{'amount'};
596 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
597 my $rounded = $form->round_amount($unrounded, 2);
599 $rounding_error = $unrounded - $rounded;
600 $new_trans{'amount'} = $rounded;
601 $new_trans{'umsatz'} = abs($rounded) * $ml;
602 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
603 $absumsatz -= $rounded;
606 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
607 push @taxed, $self->{DATEV}->[-1];
613 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
614 if ($idx >= scalar @taxed) {
615 last if (!$correction);
621 my $transaction = $taxed[$idx]->[0];
623 my $old_amount = $transaction->{amount};
624 my $old_correction = $correction;
627 if (!$transaction->{diff}) {
628 @possible_diffs = (0.01, -0.01);
630 @possible_diffs = ($transaction->{diff});
633 foreach my $diff (@possible_diffs) {
634 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
635 next if ($net_amount != $transaction->{net_amount});
637 $transaction->{diff} = $diff;
638 $transaction->{amount} += $diff;
639 $transaction->{umsatz} += $diff;
649 $absumsatz = $form->round_amount($absumsatz, 2);
650 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
651 require SL::DB::Manager::AccTransaction;
652 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
653 $self->add_error("Datev-Export fehlgeschlagen! Bei Transaktion " . $acc_trans_obj->transaction_name . " ($absumsatz)");
655 } elsif (abs($absumsatz) >= 0.01) {
656 $self->add_net_gross_differences($absumsatz);
662 $::lxdebug->leave_sub;
665 sub make_kne_data_header {
666 $main::lxdebug->enter_sub();
668 my ($self, $form) = @_;
671 my $stamm = $self->get_datev_stamm;
673 my $jahr = $self->from ? $self->from->year : DateTime->today->year;
676 my $header = "\x1D\x181";
677 $header .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
678 $header .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
679 $header .= _fill($stamm->{dfvkz}, 2, '0');
680 $header .= _fill($stamm->{beraternr}, 7, '0');
681 $header .= _fill($stamm->{mandantennr}, 5, '0');
682 $header .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
684 $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
685 $header .= $self->to ? $self->to->strftime('%d%m%y') : '';
689 $header .= $primanota;
692 $header .= _fill($stamm->{passwort}, 4, '0');
693 $header .= " " x 16; # Anwendungsinfo
694 $header .= " " x 16; # Inputinfo
698 my $versionssatz = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
700 my $query = qq|SELECT accno FROM chart LIMIT 1|;
701 my $ref = selectfirst_hashref_query($form, $self->dbh, $query);
703 $versionssatz .= length $ref->{accno};
704 $versionssatz .= ",";
705 $versionssatz .= length $ref->{accno};
706 $versionssatz .= ",SELF" . "\x1C\x79";
708 $header .= $versionssatz;
710 $main::lxdebug->leave_sub();
716 $main::lxdebug->enter_sub();
718 my ($date, $six) = @_;
720 my ($day, $month, $year) = split(/\./, $date);
723 $day = substr($day, 1, 1);
725 if (length($month) < 2) {
726 $month = "0" . $month;
728 if (length($year) > 2) {
729 $year = substr($year, -2, 2);
733 $date = $day . $month . $year;
735 $date = $day . $month;
738 $main::lxdebug->leave_sub();
743 sub trim_leading_zeroes {
751 sub make_ed_versionset {
752 $main::lxdebug->enter_sub();
754 my ($self, $header, $filename, $blockcount) = @_;
756 my $versionset = "V" . substr($filename, 2, 5);
757 $versionset .= substr($header, 6, 22);
760 $versionset .= "0000" . substr($header, 28, 19);
762 my $datum = " " x 16;
763 $versionset .= $datum . "001" . substr($header, 28, 4);
766 $versionset .= _fill($blockcount, 5, '0');
767 $versionset .= "001";
769 $versionset .= substr($header, -12, 10) . " ";
770 $versionset .= " " x 53;
772 $main::lxdebug->leave_sub();
778 $main::lxdebug->enter_sub();
780 my ($self, $form, $fileno) = @_;
782 my $stamm = $self->get_datev_stamm;
784 my $ev_header = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
786 $ev_header .= _fill($stamm->{beraternr}, 7, ' ', 'left');
787 $ev_header .= _fill($stamm->{beratername}, 9, ' ', 'left');
789 $ev_header .= (_fill($fileno, 5, '0')) x 2;
790 $ev_header .= " " x 95;
792 $main::lxdebug->leave_sub();
797 sub kne_buchungsexport {
798 $main::lxdebug->enter_sub();
806 my $filename = "ED00000";
811 my $fromto = $self->fromto;
813 $self->_get_transactions($fromto);
815 return if $self->errors;
819 while (scalar(@{ $self->{DATEV} || [] })) {
822 my $ed_filename = $self->export_path . $filename;
823 push(@filenames, $filename);
824 my $header = $self->make_kne_data_header($form);
826 my $kne_file = SL::DATEV::KNEFile->new();
827 $kne_file->add_block($header);
829 while (scalar(@{ $self->{DATEV} }) > 0) {
830 my $transaction = shift @{ $self->{DATEV} };
831 my $trans_lines = scalar(@{$transaction});
840 my $buchungstext = "";
842 my $datevautomatik = 0;
847 my $iconv = $::locale->{iconv_utf8};
848 my %umlaute = ($iconv->convert('ä') => 'ae',
849 $iconv->convert('ö') => 'oe',
850 $iconv->convert('ü') => 'ue',
851 $iconv->convert('Ä') => 'Ae',
852 $iconv->convert('Ö') => 'Oe',
853 $iconv->convert('Ü') => 'Ue',
854 $iconv->convert('ß') => 'sz');
855 for (my $i = 0; $i < $trans_lines; $i++) {
856 if ($trans_lines == 2) {
857 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
858 $umsatz = $transaction->[$i]->{'amount'};
861 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
862 $umsatz = $transaction->[$i]->{'umsatz'};
865 if ($transaction->[$i]->{'datevautomatik'}) {
868 if ($transaction->[$i]->{'taxkey'}) {
869 $taxkey = $transaction->[$i]->{'taxkey'};
871 if ($transaction->[$i]->{'charttax'}) {
872 $charttax = $transaction->[$i]->{'charttax'};
874 if ($transaction->[$i]->{'amount'} > 0) {
880 # Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
881 foreach my $umlaut (keys(%umlaute)) {
882 $transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
883 $transaction->[$haben]->{'name'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
886 $transaction->[$haben]->{'invnumber'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
887 $transaction->[$haben]->{'name'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
889 $transaction->[$haben]->{'invnumber'} = substr($transaction->[$haben]->{'invnumber'}, 0, 12);
890 $transaction->[$haben]->{'name'} = substr($transaction->[$haben]->{'name'}, 0, 30);
891 $transaction->[$haben]->{'invnumber'} =~ s/\ *$//;
892 $transaction->[$haben]->{'name'} =~ s/\ *$//;
894 if ($trans_lines >= 2) {
896 $gegenkonto = "a" . trim_leading_zeroes($transaction->[$haben]->{'accno'});
897 $konto = "e" . trim_leading_zeroes($transaction->[$soll]->{'accno'});
898 if ($transaction->[$haben]->{'invnumber'} ne "") {
899 $belegfeld1 = "\xBD" . $transaction->[$haben]->{'invnumber'} . "\x1C";
902 $datum .= &datetofour($transaction->[$haben]->{'transdate'}, 0);
903 $waehrung = "\xB3" . "EUR" . "\x1C";
904 if ($transaction->[$haben]->{'name'} ne "") {
905 $buchungstext = "\x1E" . $transaction->[$haben]->{'name'} . "\x1C";
907 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
908 $ustid = "\xBA" . $transaction->[$haben]->{'ustid'} . "\x1C";
910 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
911 $belegfeld2 = "\xBE" . &datetofour($transaction->[$haben]->{'duedate'}, 1) . "\x1C";
915 $umsatz = $kne_file->format_amount(abs($umsatz), 0);
916 $umsatzsumme += $umsatz;
917 $kne_file->add_block("+" . $umsatz);
919 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
920 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
921 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
922 # Skript angelegt werden.
923 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
924 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
925 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
926 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
927 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
929 if ( ( $datevautomatik || $taxkey)
930 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
931 # $kne_file->add_block("\x6C" . (!$datevautomatik ? $taxkey : "4"));
932 $kne_file->add_block("\x6C${taxkey}");
935 $kne_file->add_block($gegenkonto);
936 $kne_file->add_block($belegfeld1);
937 $kne_file->add_block($belegfeld2);
938 $kne_file->add_block($datum);
939 $kne_file->add_block($konto);
940 $kne_file->add_block($buchungstext);
941 $kne_file->add_block($ustid);
942 $kne_file->add_block($waehrung . "\x79");
945 my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
947 $kne_file->add_block($mandantenendsumme);
950 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
951 print(ED $kne_file->get_data());
954 $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
958 #Make EV Verwaltungsdatei
959 my $ev_header = $self->make_ev_header($form, $fileno);
960 my $ev_filename = $self->export_path . $evfile;
961 push(@filenames, $evfile);
962 open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
963 print(EV $ev_header);
965 foreach my $file (@ed_versionset) {
971 $self->add_filenames(@filenames);
973 $main::lxdebug->leave_sub();
975 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
978 sub kne_stammdatenexport {
979 $main::lxdebug->enter_sub();
984 $self->get_datev_stamm->{abrechnungsnr} = "99";
988 my $filename = "ED00000";
994 my $remaining_bytes = 256;
995 my $total_bytes = 256;
996 my $buchungssatz = "";
998 my $ed_filename = $self->export_path . $filename;
999 push(@filenames, $filename);
1000 open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1001 my $header = $self->make_kne_data_header($form);
1002 $remaining_bytes -= length($header);
1006 my (@where, @values) = ((), ());
1007 if ($self->accnofrom) {
1008 push @where, 'c.accno >= ?';
1009 push @values, $self->accnofrom;
1011 if ($self->accnoto) {
1012 push @where, 'c.accno <= ?';
1013 push @values, $self->accnoto;
1016 my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1018 my $query = qq|SELECT c.accno, c.description
1023 my $sth = $self->dbh->prepare($query);
1024 $sth->execute(@values) || $form->dberror($query);
1026 while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1027 if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1028 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1029 $buchungssatz .= "\x00" x $fuellzeichen;
1031 $total_bytes = ($blockcount) * 256;
1033 $buchungssatz .= "t" . $ref->{'accno'};
1034 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1035 $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1036 $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1037 $ref->{'description'} =~ s/\ *$//;
1040 ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1043 $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1044 $buchungssatz .= "\x00" x $fuellzeichen;
1046 $total_bytes = ($blockcount) * 256;
1048 $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1049 $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1054 print(ED $buchungssatz);
1055 $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1056 my $dateiende = "\x00" x $fuellzeichen;
1058 print(ED $dateiende);
1061 #Make EV Verwaltungsdatei
1063 $self->make_ed_versionset($header, $filename, $blockcount);
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) {
1072 print(EV $ed_versionset[$file]);
1076 $self->add_filenames(@filenames);
1078 $main::lxdebug->leave_sub();
1080 return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1084 clean_temporary_directories();
1095 SL::DATEV - kivitendo DATEV Export module
1099 use SL::DATEV qw(:CONSTANTS);
1101 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1102 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1103 my $datev = SL::DATEV->new(
1104 exporttype => DATEV_ET_BUCHUNGEN,
1105 format => DATEV_FORMAT_KNE,
1110 # To only export transactions from a specific trans_id: (from and to are ignored)
1111 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1112 my $datev = SL::DATEV->new(
1113 exporttype => DATEV_ET_BUCHUNGEN,
1114 format => DATEV_FORMAT_KNE,
1115 trans_id => $invoice->trans_id,
1118 my $datev = SL::DATEV->new(
1119 exporttype => DATEV_ET_STAMM,
1120 format => DATEV_FORMAT_KNE,
1121 accnofrom => $start_account_number,
1122 accnoto => $end_account_number,
1125 # get or set datev stamm
1126 my $hashref = $datev->get_datev_stamm;
1127 $datev->save_datev_stamm($hashref);
1129 # manually clean up temporary directories older than 8 hours
1130 $datev->clean_temporary_directories;
1135 if ($datev->errors) {
1136 die join "\n", $datev->error;
1139 # get relevant data for saving the export:
1140 my $dl_token = $datev->download_token;
1141 my $path = $datev->export_path;
1142 my @files = $datev->filenames;
1144 # retrieving an export at a later time
1145 my $datev = SL::DATEV->new(
1146 download_token => $dl_token_from_user,
1149 my $path = $datev->export_path;
1150 my @files = glob("$path/*");
1154 This module implements the DATEV export standard. For usage see above.
1162 Generic constructor. See section attributes for information about what to pass.
1164 =item get_datev_stamm
1166 Loads DATEV Stammdaten and returns as hashref.
1168 =item save_datev_stamm HASHREF
1170 Saves DATEV Stammdaten from provided hashref.
1174 See L<CONSTANTS> for possible values
1176 =item has_exporttype
1178 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1182 Specifies the designated format of the export. Currently only KNE export is implemented.
1184 See L<CONSTANTS> for possible values
1188 Returns true if a format has been set. Without format most report functions won't work.
1190 =item download_token
1192 Returns a download token for this DATEV object.
1194 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1198 Returns an export_path for this DATEV object.
1200 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1204 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.
1206 =item net_gross_differences
1208 If there were any net gross differences during calculation they will be collected here.
1210 =item sum_net_gross_differences
1212 Sum of all differences.
1214 =item clean_temporary_directories
1216 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.
1220 Returns a list of errors that occured. If no errors occured, the export was a success.
1224 Exports data. You have to have set L<exporttype> and L<format> or an error will
1225 occur. OBE exports are currently not implemented.
1231 This is a list of attributes set in either the C<new> or a method of the same name.
1237 Set a database handle to use in the process. This allows for an export to be
1238 done on a transaction in progress without committing first.
1242 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1246 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1248 =item download_token
1250 Can be set on creation to retrieve a prior export for download.
1256 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1257 set for the export to work.
1261 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1262 L<from> and L<to> are currently still needed for the query to be assembled
1269 Set boundary account numbers for the export. Only useful for a stammdaten export.
1275 =head2 Supplied to L<exporttype>
1279 =item DATEV_ET_BUCHUNGEN
1281 =item DATEV_ET_STAMM
1285 =head2 Supplied to L<format>.
1289 =item DATEV_FORMAT_KNE
1291 =item DATEV_FORMAT_OBE
1295 =head1 ERROR HANDLING
1297 This module will die in the following cases:
1303 No or unrecognized exporttype or format was provided for an export
1307 OBE export was called, which is not yet implemented.
1315 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1321 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1325 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1326 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1330 =head1 BUGS AND CAVEATS
1336 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1340 OBE export is currently not implemented.
1346 - handling of export_path and download token is a bit dodgy, clean that up.
1350 L<SL::DATEV::KNEFile>
1354 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1356 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1358 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1360 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1362 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,