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 #======================================================================
36 use Encode qw(encode);
37 use SL::HTML::Util ();
39 use SL::Locale::String qw(t8);
45 use Exporter qw(import);
48 use List::MoreUtils qw(any);
49 use List::Util qw(min max sum);
50 use List::UtilsBy qw(partition_by sort_by);
52 use Time::HiRes qw(gettimeofday);
58 DATEV_ET_BUCHUNGEN => $i++,
59 DATEV_ET_STAMM => $i++,
62 DATEV_FORMAT_KNE => $i++,
63 DATEV_FORMAT_OBE => $i++,
64 DATEV_FORMAT_CSV => $i++,
68 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV);
69 our @EXPORT_OK = (@export_constants);
70 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
77 my $obj = bless {}, $class;
79 $obj->$_($data{$_}) for keys %data;
86 $self->{exporttype} = $_[0] if @_;
87 return $self->{exporttype};
91 defined $_[0]->{exporttype};
96 $self->{format} = $_[0] if @_;
97 return $self->{format};
101 defined $_[0]->{format};
104 sub _get_export_path {
105 $main::lxdebug->enter_sub();
107 my ($a, $b) = gettimeofday();
108 my $path = _get_path_for_download_token("${a}-${b}-${$}");
110 mkpath($path) unless (-d $path);
112 $main::lxdebug->leave_sub();
117 sub _get_path_for_download_token {
118 $main::lxdebug->enter_sub();
120 my $token = shift || '';
123 if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
124 $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
127 $main::lxdebug->leave_sub();
132 sub _get_download_token_for_path {
133 $main::lxdebug->enter_sub();
138 if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
139 $token = "${1}-${2}-${3}";
142 $main::lxdebug->leave_sub();
149 $self->{download_token} = $_[0] if @_;
150 return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
156 return $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
161 push @{ $self->{filenames} ||= [] }, @_;
165 return @{ $_[0]{filenames} || [] };
170 push @{ $self->{errors} ||= [] }, @_;
174 return @{ $_[0]{errors} || [] };
177 sub add_net_gross_differences {
179 push @{ $self->{net_gross_differences} ||= [] }, @_;
182 sub net_gross_differences {
183 return @{ $_[0]{net_gross_differences} || [] };
186 sub sum_net_gross_differences {
187 return sum $_[0]->net_gross_differences;
194 die "Invalid type, need DateTime Object" unless ref $_[0] eq 'DateTime';
195 $self->{from} = $_[0];
198 return $self->{from};
205 die "Invalid type, need DateTime Object" unless ref $_[0] eq 'DateTime';
216 $self->{trans_id} = $_[0];
219 die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
221 return $self->{trans_id};
228 $self->{warnings} = [@_];
230 return $self->{warnings};
238 $self->{use_pk} = $_[0];
241 return $self->{use_pk};
248 $self->{accnofrom} = $_[0];
251 return $self->{accnofrom};
258 $self->{accnoto} = $_[0];
261 return $self->{accnoto};
269 $self->{dbh} = $_[0];
270 $self->{provided_dbh} = 1;
273 $self->{dbh} ||= SL::DB->client->dbh;
280 sub clean_temporary_directories {
281 $::lxdebug->enter_sub;
283 foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
284 next unless -d $path;
286 my $mtime = (stat($path))[9];
287 next if ((time() - $mtime) < 8 * 60 * 60);
292 $::lxdebug->leave_sub;
295 sub get_datev_stamm {
296 return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
299 sub save_datev_stamm {
300 my ($self, $data) = @_;
302 SL::DB->client->with_transaction(sub {
303 do_query($::form, $self->dbh, 'DELETE FROM datev');
305 my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
307 my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
308 do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
310 }) or do { die SL::DB->client->error };
316 return $self->csv_export;
323 die 'no exporttype set!' unless $self->has_exporttype;
325 if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
327 $self->generate_datev_data(from_to => $self->fromto);
328 return if $self->errors;
330 my $datev_csv = SL::DATEV::CSV->new(
331 datev_lines => $self->generate_datev_lines,
334 locked => $self->locked,
338 my $filename = "EXTF_DATEV_kivitendo" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
340 my $csv = Text::CSV_XS->new({
345 }) or die "Cannot use CSV: ".Text::CSV_XS->error_diag();
347 # get encoding from defaults - use cp1252 if DATEV strict export is used
348 my $enc = ($::instance_conf->get_datev_export_format eq 'cp1252') ? 'cp1252' : 'utf-8';
349 my $csv_file = IO::File->new($self->export_path . '/' . $filename, ">:encoding($enc)") or die "Can't open: $!";
351 $csv->print($csv_file, $_) for @{ $datev_csv->header };
352 $csv->print($csv_file, $_) for @{ $datev_csv->lines };
354 $self->{warnings} = $datev_csv->warnings;
356 $self->_create_xml_and_documents if $self->{documents} && $self->{guids} && %{ $self->{guids} };
358 # convert utf-8 to cp1252//translit if set
359 if ($::instance_conf->get_datev_export_format eq 'cp1252-translit') {
361 my $filename_translit = "EXTF_DATEV_kivitendo_translit" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
362 open my $fh_in, '<:encoding(UTF-8)', $self->export_path . '/' . $filename or die "could not open $filename for reading: $!";
363 open my $fh_out, '>', $self->export_path . '/' . $filename_translit or die "could not open $filename_translit for writing: $!";
365 my $converter = SL::Iconv->new("utf-8", "cp1252//translit");
367 print $fh_out $converter->convert($_) while <$fh_in>;
371 unlink $self->export_path . '/' . $filename or warn "Could not unlink $filename: $!";
372 $filename = $filename_translit;
375 return { download_token => $self->download_token, filenames => $filename };
378 die 'unrecognized exporttype';
387 return unless $self->from && $self->to;
389 return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
400 $self->{locked} = $_[0];
402 return $self->{locked};
409 $self->{imported} = $_[0];
411 return $self->{imported};
418 $self->{documents} = $_[0];
420 return $self->{documents};
423 sub _create_xml_and_documents {
426 die "No guids" unless %{ $self->{guids} };
428 my $today = DateTime->now_local;
429 my $doc = XML::LibXML::Document->new('1.0', 'utf-8');
431 my $root = $doc->createElement('archive');
432 #<archive xmlns="http://xml.datev.de/bedi/tps/document/v05.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://xml.datev.de/bedi/tps/document/v05.0 Document_v050.xsd" version="5.0" generatingSystem="DATEV-Musterdaten">
434 $root->setAttribute('xmlns' => 'http://xml.datev.de/bedi/tps/document/v05.0');
435 $root->setAttribute('xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance');
436 $root->setAttribute('xsi:schemaLocation' => 'http://xml.datev.de/bedi/tps/document/v05.0 Document_v050.xsd');
437 $root->setAttribute('version' => '5.0');
438 $root->setAttribute('generatingSystem' => 'kivitendo');
440 # header with timestamp
441 my $header_tag = $doc->createElement('header');
442 $root->appendChild($header_tag);
443 my $date_tag = $doc->createElement('date');
444 $date_tag->appendTextNode($today);
445 $header_tag->appendChild($date_tag);
449 my $content_node = $doc->createElement('content');
450 $root->appendChild($content_node);
451 # we have n document childs
452 foreach my $guid (keys %{ $self->{guids} }) {
453 # 1. get filename and file location
454 my $file_version = SL::DB::Manager::FileVersion->find_by(guid => $guid);
455 die "Invalid guid $guid" unless ref $file_version eq 'SL::DB::FileVersion';
456 # file_name has to be unique add guid if needed
457 my $filename_for_zip = (exists $self->{files}{$file_version->file_name})
458 ? $file_version->file_name . '__' . $guid
459 : $file_version->file_name;
460 $filename_for_zip = $guid . '.pdf';
461 $self->{files}{$filename_for_zip} = $file_version->get_system_location;
462 # create xml metadata for files
463 my $document_node = $doc->createElement('document');
465 $document_node->setAttribute('guid' => $guid);
466 $document_node->setAttribute('processID' => '1');
467 $document_node->setAttribute('type' => '1');
468 $content_node->appendChild($document_node);
469 my $extension_node = $doc->createElement('extension');
470 $extension_node->setAttribute('xsi:type' => 'File');
471 $extension_node->setAttribute('name' => $filename_for_zip);
472 $document_node->appendChild($extension_node);
474 $doc->setDocumentElement($root);
476 # create Archive::Zip in Export Path
477 my $zip = Archive::Zip->new();
478 # add metadata document
479 $zip->addString($doc->toString(), 'document.xml');
481 foreach my $filename (keys %{ $self->{files} }) {
482 # my $enc_filename = encode('Windows-1252', $filename);
483 $zip->addFile($self->{files}{$filename}, $filename);
485 die "Cannot write Belege-XML.zip" unless ($zip->writeToFileNamed($self->export_path . 'Belege-XML.zip')
486 == Archive::Zip::AZ_OK());
489 sub generate_datev_data {
490 $main::lxdebug->enter_sub();
492 my ($self, %params) = @_;
493 my $fromto = $params{from_to} // '';
494 my $progress_callback = $params{progress_callback} || sub {};
496 my $form = $main::form;
498 my $trans_id_filter = '';
499 my $ar_department_id_filter = '';
500 my $ap_department_id_filter = '';
501 my $gl_department_id_filter = '';
502 if ( $form->{department_id} ) {
503 $ar_department_id_filter = " AND ar.department_id = ? ";
504 $ap_department_id_filter = " AND ap.department_id = ? ";
505 $gl_department_id_filter = " AND gl.department_id = ? ";
508 my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter);
509 if ( $form->{gldatefrom} ) {
510 $gl_itime_filter = " AND gl.itime >= ? ";
511 $ar_itime_filter = " AND ar.itime >= ? ";
512 $ap_itime_filter = " AND ap.itime >= ? ";
514 $gl_itime_filter = "";
515 $ar_itime_filter = "";
516 $ap_itime_filter = "";
519 if ( $self->{trans_id} ) {
520 # ignore dates when trans_id is passed so that the entire transaction is
521 # checked, not just either the initial bookings or the subsequent payments
522 # (the transdates will likely differ)
524 $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
526 $fromto =~ s/transdate/ac\.transdate/g;
531 my $filter = ''; # Useful for debugging purposes
533 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');
535 my $ar_accno = "c.accno";
536 my $ap_accno = "c.accno";
537 if ( $self->use_pk ) {
538 $ar_accno = "CASE WHEN ac.chart_link = 'AR' THEN ct.customernumber ELSE c.accno END as accno";
539 $ap_accno = "CASE WHEN ac.chart_link = 'AP' THEN ct.vendornumber ELSE c.accno END as accno";
542 if ( !$self->imported ) {
543 $gl_imported = " AND NOT imported";
547 qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
548 ar.invnumber, ar.duedate, ar.amount as umsatz, COALESCE(ar.tax_point, ar.deliverydate) AS deliverydate, ar.itime::date,
549 ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
550 $ar_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
552 t.rate AS taxrate, t.taxdescription,
554 tc.accno AS tax_accno, tc.description AS tax_accname,
557 project.projectnumber as projectnumber, project.description as projectdescription,
558 department.description as departmentdescription
560 LEFT JOIN ar ON (ac.trans_id = ar.id)
561 LEFT JOIN customer ct ON (ar.customer_id = ct.id)
562 LEFT JOIN chart c ON (ac.chart_id = c.id)
563 LEFT JOIN tax t ON (ac.tax_id = t.id)
564 LEFT JOIN chart tc ON (t.chart_id = tc.id)
565 LEFT JOIN department ON (department.id = ar.department_id)
566 LEFT JOIN project ON (project.id = ar.globalproject_id)
567 WHERE (ar.id IS NOT NULL)
571 $ar_department_id_filter
576 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
577 ap.invnumber, ap.duedate, ap.amount as umsatz, COALESCE(ap.tax_point, ap.deliverydate) AS deliverydate, ap.itime::date,
578 ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
579 $ap_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
581 t.rate AS taxrate, t.taxdescription,
583 tc.accno AS tax_accno, tc.description AS tax_accname,
586 project.projectnumber as projectnumber, project.description as projectdescription,
587 department.description as departmentdescription
589 LEFT JOIN ap ON (ac.trans_id = ap.id)
590 LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
591 LEFT JOIN chart c ON (ac.chart_id = c.id)
592 LEFT JOIN tax t ON (ac.tax_id = t.id)
593 LEFT JOIN chart tc ON (t.chart_id = tc.id)
594 LEFT JOIN department ON (department.id = ap.department_id)
595 LEFT JOIN project ON (project.id = ap.globalproject_id)
596 WHERE (ap.id IS NOT NULL)
600 $ap_department_id_filter
605 SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
606 gl.reference AS invnumber, NULL AS duedate, ac.amount as umsatz, COALESCE(gl.tax_point, gl.deliverydate) AS deliverydate, gl.itime::date,
607 gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
608 c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
610 t.rate AS taxrate, t.taxdescription,
612 tc.accno AS tax_accno, tc.description AS tax_accname,
615 '' as projectnumber, '' as projectdescription,
616 department.description as departmentdescription
618 LEFT JOIN gl ON (ac.trans_id = gl.id)
619 LEFT JOIN chart c ON (ac.chart_id = c.id)
620 LEFT JOIN tax t ON (ac.tax_id = t.id)
621 LEFT JOIN chart tc ON (t.chart_id = tc.id)
622 LEFT JOIN department ON (department.id = gl.department_id)
623 WHERE (gl.id IS NOT NULL)
627 $gl_department_id_filter
629 AND NOT EXISTS (SELECT gl_id from ap_gl where gl_id = gl.id)
632 ORDER BY trans_id, acc_trans_id|;
635 if ( $form->{gldatefrom} or $form->{department_id} ) {
638 if ( $form->{gldatefrom} ) {
639 my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom});
640 die "illegal data" unless ref($glfromdate) eq 'DateTime';
641 push(@query_args, $glfromdate);
643 if ( $form->{department_id} ) {
644 push(@query_args, $form->{department_id});
649 my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
655 while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
656 last unless $ref; # for single transactions
658 if (($counter % 500) == 0) {
659 $progress_callback->($counter);
662 my $trans = [ $ref ];
664 my $count = $ref->{amount};
667 # if the amount of a booking in a group is smaller than 0.02, any tax
668 # amounts will likely be smaller than 1 cent, so go into subcent mode
669 my $subcent = abs($count) < 0.02;
671 # records from acc_trans are ordered by trans_id and acc_trans_id
672 # first check for unbalanced ledger inside one trans_id
673 # there may be several groups inside a trans_id, e.g. the original booking and the payment
674 # each group individually should be exactly balanced and each group
675 # individually needs its own datev lines
677 # keep fetching new acc_trans lines until the end of a balanced group is reached
678 while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
679 my $ref2 = $sth->fetchrow_hashref("NAME_lc");
685 # check if trans_id of current acc_trans line is still the same as the
686 # trans_id of the first line in group, i.e. we haven't finished a 0-group
687 # before moving on to the next trans_id, error will likely be in the old
690 if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
691 require SL::DB::Manager::AccTransaction;
692 if ( $trans->[0]->{trans_id} ) {
693 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
694 $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
695 $acc_trans_obj->transaction_name, $ref2->{trans_id})
701 push @{ $trans }, $ref2;
703 $count += $ref2->{amount};
707 foreach my $i (0 .. scalar(@{ $trans }) - 1) {
708 my $ref = $trans->[$i];
709 my $prev_ref = 0 < $i ? $trans->[$i - 1] : undef;
710 if ( $all_taxchart_ids{$ref->{id}}
711 && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
712 && ( ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
713 || $ref->{invoice})) {
717 if ( !$ref->{invoice} # we have a non-invoice booking (=gl)
718 && $ref->{is_tax} # that has "is_tax" set
719 && !($prev_ref->{is_tax}) # previous line wasn't is_tax
720 && (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) { # and sign same as previous sign
721 $trans->[$i - 1]->{tax_amount} = $ref->{amount};
726 if (scalar(@{$trans}) <= 2) {
727 push @{ $self->{DATEV} }, $trans;
731 # determine at which array position the reference value (called absumsatz) is
732 # and which amount it has
734 for my $j (0 .. (scalar(@{$trans}) - 1)) {
737 # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
739 # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
740 # true, instead of absumsatz use link AR/AP (there should only be one
743 # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
744 # instead of absumsatz use link AR/AP (there should only be one, so jump
745 # out of search as soon as you find it )
748 # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
749 # for ap/ar bookings we can always search for AR/AP in link and use that
750 if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
751 or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
752 $absumsatz = $trans->[$j]->{'amount'};
757 # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
758 # for AR and AP transaction exit the loop as soon as an AR or AP account is found
759 # there must be only one AR or AP chart in the booking
760 # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
761 # manually pays an invoice in GL.
762 if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
763 $notsplitindex = $j; # position in booking with highest amount
764 $absumsatz = $trans->[$j]->{'amount'};
769 my $ml = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
770 my $rounding_error = 0;
773 # go through each line and determine if it is a tax booking or not
774 # skip all tax lines and notsplitindex line
775 # push all other accounts (e.g. income or expense) with corresponding taxkey
777 for my $j (0 .. (scalar(@{$trans}) - 1)) {
778 if ( ($j != $notsplitindex)
779 && !$trans->[$j]->{is_tax}
780 && ( $trans->[$j]->{'taxkey'} eq ""
781 || $trans->[$j]->{'taxkey'} eq "0"
782 || $trans->[$j]->{'taxkey'} eq "1"
783 || $trans->[$j]->{'taxkey'} eq "10"
784 || $trans->[$j]->{'taxkey'} eq "11")) {
786 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
788 $absumsatz += $trans->[$j]->{'amount'};
789 $new_trans{'amount'} = $trans->[$j]->{'amount'} * (-1);
790 $new_trans{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
791 $trans->[$j]->{'umsatz'} = abs($trans->[$j]->{'amount'}) * $ml;
793 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
795 } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
798 map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
800 my $tax_rate = $trans->[$j]->{'taxrate'};
801 $new_trans{'net_amount'} = $trans->[$j]->{'amount'} * -1;
802 $new_trans{'tax_rate'} = 1 + $tax_rate;
804 if (!$trans->[$j]->{'invoice'}) {
805 $new_trans{'amount'} = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
806 $new_trans{'umsatz'} = abs($new_trans{'amount'}) * $ml;
807 $trans->[$j]->{'umsatz'} = $new_trans{'umsatz'};
808 $absumsatz += -1 * $new_trans{'amount'};
811 my $unrounded = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
812 my $rounded = $form->round_amount($unrounded, 2);
814 $rounding_error = $unrounded - $rounded;
815 $new_trans{'amount'} = $rounded;
816 $new_trans{'umsatz'} = abs($rounded) * $ml;
817 $trans->[$j]->{'umsatz'} = $new_trans{umsatz};
818 $absumsatz -= $rounded;
821 push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
822 push @taxed, $self->{DATEV}->[-1];
828 while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
829 if ($idx >= scalar @taxed) {
830 last if (!$correction);
836 my $transaction = $taxed[$idx]->[0];
838 my $old_amount = $transaction->{amount};
839 my $old_correction = $correction;
842 if (!$transaction->{diff}) {
843 @possible_diffs = (0.01, -0.01);
845 @possible_diffs = ($transaction->{diff});
848 foreach my $diff (@possible_diffs) {
849 my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
850 next if ($net_amount != $transaction->{net_amount});
852 $transaction->{diff} = $diff;
853 $transaction->{amount} += $diff;
854 $transaction->{umsatz} += $diff;
864 $absumsatz = $form->round_amount($absumsatz, 2);
865 if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
866 require SL::DB::Manager::AccTransaction;
867 my $acc_trans_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
868 $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
869 $acc_trans_obj->transaction_name, $absumsatz)
871 } elsif (abs($absumsatz) >= 0.01) {
872 $self->add_net_gross_differences($absumsatz);
878 $::lxdebug->leave_sub;
881 sub generate_datev_lines {
884 my @datev_lines = ();
886 foreach my $transaction ( @{ $self->{DATEV} } ) {
888 # each $transaction entry contains data from several acc_trans entries
889 # belonging to the same trans_id
891 my %datev_data = (); # data for one transaction
892 my $trans_lines = scalar(@{$transaction});
900 my $buchungstext = "";
902 my $datevautomatik = 0;
907 for (my $i = 0; $i < $trans_lines; $i++) {
908 if ($trans_lines == 2) {
909 if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
910 $umsatz = $transaction->[$i]->{'amount'};
913 if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
914 $umsatz = $transaction->[$i]->{'umsatz'};
917 if ($transaction->[$i]->{'datevautomatik'}) {
920 if ($transaction->[$i]->{'taxkey'}) {
921 $taxkey = $transaction->[$i]->{'taxkey'};
922 # $taxkey = 0 if $taxkey == 94; # taxbookings are in gl
924 if ($transaction->[$i]->{'charttax'}) {
925 $charttax = $transaction->[$i]->{'charttax'};
927 if ($transaction->[$i]->{'amount'} > 0) {
934 if ($trans_lines >= 2) {
936 # Personenkontenerweiterung: accno has already been replaced if use_pk was set
937 $datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
938 $datev_data{'konto'} = $transaction->[$soll]->{'accno'};
939 if ($transaction->[$haben]->{'invnumber'} ne "") {
940 $datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
942 $datev_data{datum} = $transaction->[$haben]->{'transdate'};
943 $datev_data{waehrung} = 'EUR';
944 $datev_data{kost1} = $transaction->[$haben]->{'departmentdescription'};
945 $datev_data{kost2} = $transaction->[$haben]->{'projectdescription'};
947 if ($transaction->[$haben]->{'name'} ne "") {
948 $datev_data{buchungstext} = $transaction->[$haben]->{'name'};
950 if (($transaction->[$haben]->{'ustid'} // '') ne "") {
951 $datev_data{ustid} = SL::VATIDNr->normalize($transaction->[$haben]->{'ustid'});
953 if (($transaction->[$haben]->{'duedate'} // '') ne "") {
954 $datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
957 # if deliverydate exists, add it to datev export if it is
958 # * an ar/ap booking that is not a payment
960 if ( ($transaction->[$haben]->{'deliverydate'} // '') ne ''
962 ( $transaction->[$haben]->{'table'} =~ /^(ar|ap)$/
963 && $transaction->[$haben]->{'link'} !~ m/_paid/
964 && $transaction->[$soll]->{'link'} !~ m/_paid/
966 || $transaction->[$haben]->{'table'} eq 'gl'
969 $datev_data{leistungsdatum} = $transaction->[$haben]->{'deliverydate'};
972 $datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
974 # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
975 # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
976 # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
977 # Skript angelegt werden.
978 # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
979 # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
980 # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
981 # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
982 # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
985 # only set buchungsschluessel if the following conditions are met:
986 if ( ( $datevautomatik || $taxkey)
987 && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
988 # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
989 $datev_data{buchungsschluessel} = $taxkey;
991 # set lock for each transaction
992 $datev_data{locked} = $self->locked;
993 # add guids if datev export with documents is requested
994 if ($self->documents) {
995 # add all document links for the latest created/uploaded document
996 my $latest_document = SL::DB::Manager::File->get_first(query =>
998 object_id => $transaction->[$haben]->{trans_id},
999 file_type => 'document',
1000 mime_type => 'application/pdf',
1002 object_type => 'gl_transaction',
1003 object_type => 'purchase_invoice',
1004 object_type => 'invoice',
1005 object_type => 'credit_note',
1008 sort_by => 'itime DESC');
1009 if (ref $latest_document eq 'SL::DB::File') {
1010 #if (scalar @{ $latest_documents }) {
1011 # if we have a booking document add guid from the latest version
1012 # one record may be referenced to more transaction (credit booking with different accounts)
1013 # therefore collect guids in hash
1014 # not yet implemented -> datev steigt aus, sobald ein komma getrennter wert erscheint
1015 #foreach my $latest_document (@{ $latest_documents }) {
1016 die "No file datatype:" . ref $latest_document unless (ref $latest_document eq 'SL::DB::File');
1017 my $latest_guid = $latest_document->file_versions_sorted->[-1]->guid;
1019 $self->{guids}{$latest_guid} = 1;
1020 $datev_data{document_guid} .= $datev_data{document_guid} ? ',' : '';
1021 $datev_data{document_guid} .= $latest_guid;
1026 push(@datev_lines, \%datev_data) if $datev_data{umsatz};
1029 # example of modifying export data:
1030 # foreach my $datev_line ( @datev_lines ) {
1031 # if ( $datev_line{"konto"} eq '1234' ) {
1032 # $datev_line{"konto"} = '9999';
1037 return \@datev_lines;
1040 sub check_vcnumbers_are_valid_pk_numbers {
1043 # better use a class variable and set this in sub new (also needed in DATEV::CSV)
1044 # calculation is also a bit more sane in sub check_valid_length_of_accounts
1045 my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
1046 my $pk_length = $length_of_accounts + 1;
1047 my $query = <<"SQL";
1048 SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
1050 SELECT vendornumber AS vcnumber FROM vendor WHERE vendornumber !~ '^[[:digit:]]{$pk_length}\$'
1053 my ($has_non_pk_accounts) = selectrow_query($::form, SL::DB->client->dbh, $query);
1054 return defined $has_non_pk_accounts ? 0 : 1;
1058 sub check_valid_length_of_accounts {
1061 my $query = <<"SQL";
1062 SELECT DISTINCT char_length (accno) FROM chart WHERE charttype='A' AND id in (select chart_id from acc_trans);
1065 my $accno_length = selectall_hashref_query($::form, SL::DB->client->dbh, $query);
1066 if (1 < scalar @$accno_length) {
1067 $::form->error(t8("Invalid combination of ledger account number length." .
1068 " Mismatch length of #1 with length of #2. Please check your account settings. ",
1069 $accno_length->[0]->{char_length}, $accno_length->[1]->{char_length}));
1074 sub check_document_export {
1077 # no dms enabled and works only for type Filesystem
1078 return 0 unless $::instance_conf->get_doc_storage
1079 && $::instance_conf->get_doc_storage_for_documents eq 'Filesystem';
1085 sub check_all_bookings_have_documents {
1089 die "Need from date" unless $params{from};
1090 die "Need to date" unless $params{to};
1092 $self->from($params{from});
1093 $self->to($params{to});
1095 my $fromto = $self->fromto;
1096 # not all last month ar ap gl booking have an entry -> rent ?
1098 select distinct trans_id,object_id from acc_trans
1099 left join files on files.object_id=trans_id
1101 and object_id is null
1102 and trans_id not in (select id from gl)
1105 my ($booking_has_no_document) = selectrow_query($::form, SL::DB->client->dbh, $query);
1106 return defined $booking_has_no_document ? 0 : 1;
1114 return encode('UTF-8', $value // '');
1119 clean_temporary_directories();
1130 SL::DATEV - kivitendo DATEV Export module
1134 use SL::DATEV qw(:CONSTANTS);
1136 my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1137 my $enddate = DateTime->new(year => 2014, month => 9, day => 31);
1138 my $datev = SL::DATEV->new(
1139 exporttype => DATEV_ET_BUCHUNGEN,
1140 format => DATEV_FORMAT_KNE,
1145 # To only export transactions from a specific trans_id: (from and to are ignored)
1146 my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1147 my $datev = SL::DATEV->new(
1148 exporttype => DATEV_ET_BUCHUNGEN,
1149 format => DATEV_FORMAT_KNE,
1150 trans_id => $invoice->trans_id,
1153 my $datev = SL::DATEV->new(
1154 exporttype => DATEV_ET_STAMM,
1155 format => DATEV_FORMAT_KNE,
1156 accnofrom => $start_account_number,
1157 accnoto => $end_account_number,
1160 # get or set datev stamm
1161 my $hashref = $datev->get_datev_stamm;
1162 $datev->save_datev_stamm($hashref);
1164 # manually clean up temporary directories older than 8 hours
1165 $datev->clean_temporary_directories;
1170 if ($datev->errors) {
1171 die join "\n", $datev->error;
1174 # get relevant data for saving the export:
1175 my $dl_token = $datev->download_token;
1176 my $path = $datev->export_path;
1177 my @files = $datev->filenames;
1179 # retrieving an export at a later time
1180 my $datev = SL::DATEV->new(
1181 download_token => $dl_token_from_user,
1184 my $path = $datev->export_path;
1185 my @files = glob("$path/*");
1187 # Only test the datev data of a specific trans_id, without generating an
1188 # export file, but filling $datev->errors if errors exist
1190 my $datev = SL::DATEV->new(
1191 trans_id => $invoice->trans_id,
1193 $datev->generate_datev_data;
1194 # if ($datev->errors) { ...
1199 This module implements the DATEV export standard. For usage see above.
1207 Generic constructor. See section attributes for information about what to pass.
1209 =item generate_datev_data
1211 Fetches all transactions from the database (via a trans_id or a date range),
1212 and does an initial transformation (e.g. filters out tax, determines
1213 the brutto amount, checks split transactions ...) and stores this data in
1216 If any errors are found these are collected in $self->errors.
1218 This function is needed for all the exports, but can be also called
1219 independently in order to check transactions for DATEV compatibility.
1221 =item generate_datev_lines
1223 Parse the data in $self->{DATEV} and transform it into a format that can be
1224 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1226 The transformed data is returned as an arrayref, which is ready to be converted
1227 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1229 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1230 entries with datevautomatik have an empty taxkey, as the taxkey is already
1231 determined by the chart.
1233 =item get_datev_stamm
1235 Loads DATEV Stammdaten and returns as hashref.
1237 =item save_datev_stamm HASHREF
1239 Saves DATEV Stammdaten from provided hashref.
1243 See L<CONSTANTS> for possible values
1245 =item has_exporttype
1247 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1251 Specifies the designated format of the export. Currently only KNE export is implemented.
1253 See L<CONSTANTS> for possible values
1257 Returns true if a format has been set. Without format most report functions won't work.
1259 =item download_token
1261 Returns a download token for this DATEV object.
1263 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1267 Returns an export_path for this DATEV object.
1269 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1273 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.
1275 =item net_gross_differences
1277 If there were any net gross differences during calculation they will be collected here.
1279 =item sum_net_gross_differences
1281 Sum of all differences.
1283 =item clean_temporary_directories
1285 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.
1289 Returns a list of errors that occurred. If no errors occurred, the export was a success.
1293 Exports data. You have to have set L<exporttype> and L<format> or an error will
1294 occur. OBE exports are currently not implemented.
1296 =item csv_export_for_tax_accountant
1298 Generates up to four downloadable csv files containing data about sales and
1299 purchase invoices, and their respective payments:
1302 my $startdate = DateTime->new(year => 2012, month => 1, day => 1);
1303 my $enddate = DateTime->new(year => 2012, month => 12, day => 31);
1304 SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1306 # 'download_token' => '1488551625-815654-22430',
1308 # 'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1309 # 'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1310 # 'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1311 # 'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1316 =item check_vcnumbers_are_valid_pk_numbers
1318 Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.
1320 Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
1321 (e.g. 5), and checks the database for any customers or vendors whose customer-
1322 or vendornumber doesn't consist of only numbers with exactly that length. E.g.
1323 for a chart length of four "10001" would be ok, but not "10001b" or "1000".
1325 All vcnumbers are checked, obsolete customers or vendors aren't exempt.
1327 There is also no check for the typical customer range 10000-69999 and the
1328 typical vendor range 70000-99999.
1330 =item check_valid_length_of_accounts
1332 Returns 1 if all currently booked accounts have only one common number length domain (e.g. 4 or 6).
1333 Will throw an error if more than one distinct size is detected.
1334 The error message gives a short hint with the value of the (at least)
1335 two mismatching number length domains.
1337 =item check_document_export
1339 Returns 1 if DMS feature is enabled and Backend is Filesystem
1341 =item check_all_bookings_have_documents
1343 Returns 1 if all ar and ap transactions for this period have a document entry in files.
1344 Therefore all ar and ap transactions may be exported.
1345 Note: DATEV accepts only PDF and for some gl bookings a document makes no sense
1352 This is a list of attributes set in either the C<new> or a method of the same name.
1358 Set a database handle to use in the process. This allows for an export to be
1359 done on a transaction in progress without committing first.
1361 Note: If you don't want this code to commit, simply providing a dbh is not
1362 enough enymore. You'll have to wrap the call into a transaction yourself, so
1363 that the internal transaction does not commit.
1367 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1371 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1373 =item download_token
1375 Can be set on creation to retrieve a prior export for download.
1381 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1382 set for the export to work.
1386 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1387 L<from> and L<to> are currently still needed for the query to be assembled
1394 Set boundary account numbers for the export. Only useful for a stammdaten export.
1398 Boolean if the transactions are locked (read-only in kivitenod) or not.
1399 Default value is false
1405 =head2 Supplied to L<exporttype>
1409 =item DATEV_ET_BUCHUNGEN
1411 =item DATEV_ET_STAMM
1415 =head2 Supplied to L<format>.
1419 =item DATEV_FORMAT_KNE
1421 =item DATEV_FORMAT_OBE
1425 =head1 ERROR HANDLING
1427 This module will die in the following cases:
1433 No or unrecognized exporttype or format was provided for an export
1437 OBE export was called, which is not yet implemented.
1445 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1451 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1455 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).> This error occurs if a
1456 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1460 =head1 BUGS AND CAVEATS
1466 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1470 OBE export is currently not implemented.
1476 - handling of export_path and download token is a bit dodgy, clean that up.
1480 L<SL::DATEV::KNEFile>
1485 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1487 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1489 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1491 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1493 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,