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 SL::HTML::Util ();
 
  38 use SL::Locale::String qw(t8);
 
  43 use Exporter qw(import);
 
  46 use List::MoreUtils qw(any);
 
  47 use List::Util qw(min max sum);
 
  48 use List::UtilsBy qw(partition_by sort_by);
 
  50 use Time::HiRes qw(gettimeofday);
 
  55     DATEV_ET_BUCHUNGEN => $i++,
 
  56     DATEV_ET_STAMM     => $i++,
 
  59     DATEV_FORMAT_KNE   => $i++,
 
  60     DATEV_FORMAT_OBE   => $i++,
 
  61     DATEV_FORMAT_CSV   => $i++,
 
  65 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV);
 
  66 our @EXPORT_OK = (@export_constants);
 
  67 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
 
  74   my $obj = bless {}, $class;
 
  76   $obj->$_($data{$_}) for keys %data;
 
  83   $self->{exporttype} = $_[0] if @_;
 
  84   return $self->{exporttype};
 
  88   defined $_[0]->{exporttype};
 
  93   $self->{format} = $_[0] if @_;
 
  94   return $self->{format};
 
  98   defined $_[0]->{format};
 
 101 sub _get_export_path {
 
 102   $main::lxdebug->enter_sub();
 
 104   my ($a, $b) = gettimeofday();
 
 105   my $path    = _get_path_for_download_token("${a}-${b}-${$}");
 
 107   mkpath($path) unless (-d $path);
 
 109   $main::lxdebug->leave_sub();
 
 114 sub _get_path_for_download_token {
 
 115   $main::lxdebug->enter_sub();
 
 117   my $token = shift || '';
 
 120   if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
 
 121     $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
 
 124   $main::lxdebug->leave_sub();
 
 129 sub _get_download_token_for_path {
 
 130   $main::lxdebug->enter_sub();
 
 135   if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
 
 136     $token = "${1}-${2}-${3}";
 
 139   $main::lxdebug->leave_sub();
 
 146   $self->{download_token} = $_[0] if @_;
 
 147   return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
 
 153   return  $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
 
 158   push @{ $self->{filenames} ||= [] }, @_;
 
 162   return @{ $_[0]{filenames} || [] };
 
 167   push @{ $self->{errors} ||= [] }, @_;
 
 171   return @{ $_[0]{errors} || [] };
 
 174 sub add_net_gross_differences {
 
 176   push @{ $self->{net_gross_differences} ||= [] }, @_;
 
 179 sub net_gross_differences {
 
 180   return @{ $_[0]{net_gross_differences} || [] };
 
 183 sub sum_net_gross_differences {
 
 184   return sum $_[0]->net_gross_differences;
 
 191    $self->{from} = $_[0];
 
 194  return $self->{from};
 
 211     $self->{trans_id} = $_[0];
 
 214   die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
 
 216   return $self->{trans_id};
 
 223     $self->{warnings} = [@_];
 
 225    return $self->{warnings};
 
 233    $self->{use_pk} = $_[0];
 
 236  return $self->{use_pk};
 
 243    $self->{accnofrom} = $_[0];
 
 246  return $self->{accnofrom};
 
 253    $self->{accnoto} = $_[0];
 
 256  return $self->{accnoto};
 
 264     $self->{dbh} = $_[0];
 
 265     $self->{provided_dbh} = 1;
 
 268   $self->{dbh} ||= SL::DB->client->dbh;
 
 275 sub clean_temporary_directories {
 
 276   $::lxdebug->enter_sub;
 
 278   foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
 
 279     next unless -d $path;
 
 281     my $mtime = (stat($path))[9];
 
 282     next if ((time() - $mtime) < 8 * 60 * 60);
 
 287   $::lxdebug->leave_sub;
 
 290 sub get_datev_stamm {
 
 291   return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
 
 294 sub save_datev_stamm {
 
 295   my ($self, $data) = @_;
 
 297   SL::DB->client->with_transaction(sub {
 
 298     do_query($::form, $self->dbh, 'DELETE FROM datev');
 
 300     my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
 
 302     my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
 
 303     do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
 
 305   }) or do { die SL::DB->client->error };
 
 311   return $self->csv_export;
 
 318   die 'no exporttype set!' unless $self->has_exporttype;
 
 320   if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
 
 322     $self->generate_datev_data(from_to => $self->fromto);
 
 323     return if $self->errors;
 
 325     my $datev_csv = SL::DATEV::CSV->new(
 
 326       datev_lines  => $self->generate_datev_lines,
 
 329       locked       => $self->locked,
 
 333     my $filename = "EXTF_DATEV_kivitendo" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
 
 335     my $csv = Text::CSV_XS->new({
 
 340               }) or die "Cannot use CSV: ".Text::CSV_XS->error_diag();
 
 342     # get encoding from defaults - use cp1252 if DATEV strict export is used
 
 343     my $enc = ($::instance_conf->get_datev_export_format eq 'cp1252') ? 'cp1252' : 'utf-8';
 
 344     my $csv_file = IO::File->new($self->export_path . '/' . $filename, ">:encoding($enc)") or die "Can't open: $!";
 
 346     $csv->print($csv_file, $_) for @{ $datev_csv->header };
 
 347     $csv->print($csv_file, $_) for @{ $datev_csv->lines  };
 
 349     $self->{warnings} = $datev_csv->warnings;
 
 351     # convert utf-8 to cp1252//translit if set
 
 352     if ($::instance_conf->get_datev_export_format eq 'cp1252-translit') {
 
 354       my $filename_translit = "EXTF_DATEV_kivitendo_translit" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
 
 355       open my $fh_in,  '<:encoding(UTF-8)',  $self->export_path . '/' . $filename or die "could not open $filename for reading: $!";
 
 356       open my $fh_out, '>', $self->export_path . '/' . $filename_translit         or die "could not open $filename_translit for writing: $!";
 
 358       my $converter = SL::Iconv->new("utf-8", "cp1252//translit");
 
 360       print $fh_out $converter->convert($_) while <$fh_in>;
 
 364       unlink $self->export_path . '/' . $filename or warn "Could not unlink $filename: $!";
 
 365       $filename = $filename_translit;
 
 368     return { download_token => $self->download_token, filenames => $filename };
 
 371     die 'unrecognized exporttype';
 
 380   return unless $self->from && $self->to;
 
 382   return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
 
 393    $self->{locked} = $_[0];
 
 395  return $self->{locked};
 
 401    $self->{imported} = $_[0];
 
 403  return $self->{imported};
 
 406 sub generate_datev_data {
 
 407   $main::lxdebug->enter_sub();
 
 409   my ($self, %params)   = @_;
 
 410   my $fromto            = $params{from_to} // '';
 
 411   my $progress_callback = $params{progress_callback} || sub {};
 
 413   my $form     =  $main::form;
 
 415   my $trans_id_filter = '';
 
 416   my $ar_department_id_filter = '';
 
 417   my $ap_department_id_filter = '';
 
 418   my $gl_department_id_filter = '';
 
 419   if ( $form->{department_id} ) {
 
 420     $ar_department_id_filter = " AND ar.department_id = ? ";
 
 421     $ap_department_id_filter = " AND ap.department_id = ? ";
 
 422     $gl_department_id_filter = " AND gl.department_id = ? ";
 
 425   my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter);
 
 426   if ( $form->{gldatefrom} ) {
 
 427     $gl_itime_filter = " AND gl.itime >= ? ";
 
 428     $ar_itime_filter = " AND ar.itime >= ? ";
 
 429     $ap_itime_filter = " AND ap.itime >= ? ";
 
 431     $gl_itime_filter = "";
 
 432     $ar_itime_filter = "";
 
 433     $ap_itime_filter = "";
 
 436   if ( $self->{trans_id} ) {
 
 437     # ignore dates when trans_id is passed so that the entire transaction is
 
 438     # checked, not just either the initial bookings or the subsequent payments
 
 439     # (the transdates will likely differ)
 
 441     $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
 
 443     $fromto      =~ s/transdate/ac\.transdate/g;
 
 448   my $filter   = '';            # Useful for debugging purposes
 
 450   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');
 
 452   my $ar_accno = "c.accno";
 
 453   my $ap_accno = "c.accno";
 
 454   if ( $self->use_pk ) {
 
 455     $ar_accno = "CASE WHEN ac.chart_link = 'AR' THEN ct.customernumber ELSE c.accno END as accno";
 
 456     $ap_accno = "CASE WHEN ac.chart_link = 'AP' THEN ct.vendornumber   ELSE c.accno END as accno";
 
 459   if ( !$self->imported ) {
 
 460     $gl_imported = " AND NOT imported";
 
 464     qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
 
 465          ar.invnumber, ar.duedate, ar.amount as umsatz, COALESCE(ar.tax_point, ar.deliverydate) AS deliverydate, ar.itime::date,
 
 466          ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
 
 467          $ar_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 
 469          t.rate AS taxrate, t.taxdescription,
 
 471          tc.accno AS tax_accno, tc.description AS tax_accname,
 
 474          project.projectnumber as projectnumber, project.description as projectdescription,
 
 475          department.description as departmentdescription
 
 477        LEFT JOIN ar          ON (ac.trans_id    = ar.id)
 
 478        LEFT JOIN customer ct ON (ar.customer_id = ct.id)
 
 479        LEFT JOIN chart c     ON (ac.chart_id    = c.id)
 
 480        LEFT JOIN tax t       ON (ac.tax_id      = t.id)
 
 481        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
 
 482        LEFT JOIN department  ON (department.id  = ar.department_id)
 
 483        LEFT JOIN project     ON (project.id     = ar.globalproject_id)
 
 484        WHERE (ar.id IS NOT NULL)
 
 488          $ar_department_id_filter
 
 493        SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
 
 494          ap.invnumber, ap.duedate, ap.amount as umsatz, COALESCE(ap.tax_point, ap.deliverydate) AS deliverydate, ap.itime::date,
 
 495          ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
 
 496          $ap_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 
 498          t.rate AS taxrate, t.taxdescription,
 
 500          tc.accno AS tax_accno, tc.description AS tax_accname,
 
 503          project.projectnumber as projectnumber, project.description as projectdescription,
 
 504          department.description as departmentdescription
 
 506        LEFT JOIN ap        ON (ac.trans_id  = ap.id)
 
 507        LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
 
 508        LEFT JOIN chart c   ON (ac.chart_id  = c.id)
 
 509        LEFT JOIN tax t     ON (ac.tax_id    = t.id)
 
 510        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
 
 511        LEFT JOIN department  ON (department.id  = ap.department_id)
 
 512        LEFT JOIN project     ON (project.id     = ap.globalproject_id)
 
 513        WHERE (ap.id IS NOT NULL)
 
 517          $ap_department_id_filter
 
 522        SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
 
 523          gl.reference AS invnumber, NULL AS duedate, ac.amount as umsatz, COALESCE(gl.tax_point, gl.deliverydate) AS deliverydate, gl.itime::date,
 
 524          gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
 
 525          c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 
 527          t.rate AS taxrate, t.taxdescription,
 
 529          tc.accno AS tax_accno, tc.description AS tax_accname,
 
 532          '' as projectnumber, '' as projectdescription,
 
 533          department.description as departmentdescription
 
 535        LEFT JOIN gl      ON (ac.trans_id  = gl.id)
 
 536        LEFT JOIN chart c ON (ac.chart_id  = c.id)
 
 537        LEFT JOIN tax t   ON (ac.tax_id    = t.id)
 
 538        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
 
 539        LEFT JOIN department  ON (department.id  = gl.department_id)
 
 540        WHERE (gl.id IS NOT NULL)
 
 544          $gl_department_id_filter
 
 548        ORDER BY trans_id, acc_trans_id|;
 
 551   if ( $form->{gldatefrom} or $form->{department_id} ) {
 
 554       if ( $form->{gldatefrom} ) {
 
 555         my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom});
 
 556         die "illegal data" unless ref($glfromdate) eq 'DateTime';
 
 557         push(@query_args, $glfromdate);
 
 559       if ( $form->{department_id} ) {
 
 560         push(@query_args, $form->{department_id});
 
 565   my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
 
 571   while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
 
 572     last unless $ref;  # for single transactions
 
 574     if (($counter % 500) == 0) {
 
 575       $progress_callback->($counter);
 
 578     my $trans    = [ $ref ];
 
 580     my $count    = $ref->{amount};
 
 583     # if the amount of a booking in a group is smaller than 0.02, any tax
 
 584     # amounts will likely be smaller than 1 cent, so go into subcent mode
 
 585     my $subcent  = abs($count) < 0.02;
 
 587     # records from acc_trans are ordered by trans_id and acc_trans_id
 
 588     # first check for unbalanced ledger inside one trans_id
 
 589     # there may be several groups inside a trans_id, e.g. the original booking and the payment
 
 590     # each group individually should be exactly balanced and each group
 
 591     # individually needs its own datev lines
 
 593     # keep fetching new acc_trans lines until the end of a balanced group is reached
 
 594     while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
 
 595       my $ref2 = $sth->fetchrow_hashref("NAME_lc");
 
 601       # check if trans_id of current acc_trans line is still the same as the
 
 602       # trans_id of the first line in group, i.e. we haven't finished a 0-group
 
 603       # before moving on to the next trans_id, error will likely be in the old
 
 606       if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
 
 607         require SL::DB::Manager::AccTransaction;
 
 608         if ( $trans->[0]->{trans_id} ) {
 
 609           my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
 
 610           $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
 
 611                               $acc_trans_obj->transaction_name, $ref2->{trans_id})
 
 617       push @{ $trans }, $ref2;
 
 619       $count    += $ref2->{amount};
 
 623     foreach my $i (0 .. scalar(@{ $trans }) - 1) {
 
 624       my $ref        = $trans->[$i];
 
 625       my $prev_ref   = 0 < $i ? $trans->[$i - 1] : undef;
 
 626       if (   $all_taxchart_ids{$ref->{id}}
 
 627           && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
 
 628           && (   ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
 
 629               || $ref->{invoice})) {
 
 633       if (   !$ref->{invoice}   # we have a non-invoice booking (=gl)
 
 634           &&  $ref->{is_tax}    # that has "is_tax" set
 
 635           && !($prev_ref->{is_tax})  # previous line wasn't is_tax
 
 636           &&  (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) {  # and sign same as previous sign
 
 637         $trans->[$i - 1]->{tax_amount} = $ref->{amount};
 
 642     if (scalar(@{$trans}) <= 2) {
 
 643       push @{ $self->{DATEV} }, $trans;
 
 647     # determine at which array position the reference value (called absumsatz) is
 
 648     # and which amount it has
 
 650     for my $j (0 .. (scalar(@{$trans}) - 1)) {
 
 653       # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
 
 655       # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
 
 656       # true, instead of absumsatz use link AR/AP (there should only be one
 
 659       # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
 
 660       # instead of absumsatz use link AR/AP (there should only be one, so jump
 
 661       # out of search as soon as you find it )
 
 664       # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
 
 665       # for ap/ar bookings we can always search for AR/AP in link and use that
 
 666       if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
 
 667          or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
 
 668         $absumsatz     = $trans->[$j]->{'amount'};
 
 673       # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
 
 674       # for AR and AP transaction exit the loop as soon as an AR or AP account is found
 
 675       # there must be only one AR or AP chart in the booking
 
 676       # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
 
 677       # manually pays an invoice in GL.
 
 678       if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
 
 679         $notsplitindex = $j;   # position in booking with highest amount
 
 680         $absumsatz     = $trans->[$j]->{'amount'};
 
 685     my $ml             = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
 
 686     my $rounding_error = 0;
 
 689     # go through each line and determine if it is a tax booking or not
 
 690     # skip all tax lines and notsplitindex line
 
 691     # push all other accounts (e.g. income or expense) with corresponding taxkey
 
 693     for my $j (0 .. (scalar(@{$trans}) - 1)) {
 
 694       if (   ($j != $notsplitindex)
 
 695           && !$trans->[$j]->{is_tax}
 
 696           && (   $trans->[$j]->{'taxkey'} eq ""
 
 697               || $trans->[$j]->{'taxkey'} eq "0"
 
 698               || $trans->[$j]->{'taxkey'} eq "1"
 
 699               || $trans->[$j]->{'taxkey'} eq "10"
 
 700               || $trans->[$j]->{'taxkey'} eq "11")) {
 
 702         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
 
 704         $absumsatz               += $trans->[$j]->{'amount'};
 
 705         $new_trans{'amount'}      = $trans->[$j]->{'amount'} * (-1);
 
 706         $new_trans{'umsatz'}      = abs($trans->[$j]->{'amount'}) * $ml;
 
 707         $trans->[$j]->{'umsatz'}  = abs($trans->[$j]->{'amount'}) * $ml;
 
 709         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
 
 711       } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
 
 714         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
 
 716         my $tax_rate              = $trans->[$j]->{'taxrate'};
 
 717         $new_trans{'net_amount'}  = $trans->[$j]->{'amount'} * -1;
 
 718         $new_trans{'tax_rate'}    = 1 + $tax_rate;
 
 720         if (!$trans->[$j]->{'invoice'}) {
 
 721           $new_trans{'amount'}      = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
 
 722           $new_trans{'umsatz'}      = abs($new_trans{'amount'}) * $ml;
 
 723           $trans->[$j]->{'umsatz'}  = $new_trans{'umsatz'};
 
 724           $absumsatz               += -1 * $new_trans{'amount'};
 
 727           my $unrounded             = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
 
 728           my $rounded               = $form->round_amount($unrounded, 2);
 
 730           $rounding_error           = $unrounded - $rounded;
 
 731           $new_trans{'amount'}      = $rounded;
 
 732           $new_trans{'umsatz'}      = abs($rounded) * $ml;
 
 733           $trans->[$j]->{'umsatz'}  = $new_trans{umsatz};
 
 734           $absumsatz               -= $rounded;
 
 737         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
 
 738         push @taxed, $self->{DATEV}->[-1];
 
 744     while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
 
 745       if ($idx >= scalar @taxed) {
 
 746         last if (!$correction);
 
 752       my $transaction = $taxed[$idx]->[0];
 
 754       my $old_amount     = $transaction->{amount};
 
 755       my $old_correction = $correction;
 
 758       if (!$transaction->{diff}) {
 
 759         @possible_diffs = (0.01, -0.01);
 
 761         @possible_diffs = ($transaction->{diff});
 
 764       foreach my $diff (@possible_diffs) {
 
 765         my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
 
 766         next if ($net_amount != $transaction->{net_amount});
 
 768         $transaction->{diff}    = $diff;
 
 769         $transaction->{amount} += $diff;
 
 770         $transaction->{umsatz} += $diff;
 
 780     $absumsatz = $form->round_amount($absumsatz, 2);
 
 781     if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
 
 782       require SL::DB::Manager::AccTransaction;
 
 783       my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
 
 784       $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
 
 785                           $acc_trans_obj->transaction_name, $absumsatz)
 
 787     } elsif (abs($absumsatz) >= 0.01) {
 
 788       $self->add_net_gross_differences($absumsatz);
 
 794   $::lxdebug->leave_sub;
 
 797 sub generate_datev_lines {
 
 800   my @datev_lines = ();
 
 802   foreach my $transaction ( @{ $self->{DATEV} } ) {
 
 804     # each $transaction entry contains data from several acc_trans entries
 
 805     # belonging to the same trans_id
 
 807     my %datev_data = (); # data for one transaction
 
 808     my $trans_lines = scalar(@{$transaction});
 
 816     my $buchungstext   = "";
 
 818     my $datevautomatik = 0;
 
 823     for (my $i = 0; $i < $trans_lines; $i++) {
 
 824       if ($trans_lines == 2) {
 
 825         if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
 
 826           $umsatz = $transaction->[$i]->{'amount'};
 
 829         if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
 
 830           $umsatz = $transaction->[$i]->{'umsatz'};
 
 833       if ($transaction->[$i]->{'datevautomatik'}) {
 
 836       if ($transaction->[$i]->{'taxkey'}) {
 
 837         $taxkey = $transaction->[$i]->{'taxkey'};
 
 839       if ($transaction->[$i]->{'charttax'}) {
 
 840         $charttax = $transaction->[$i]->{'charttax'};
 
 842       if ($transaction->[$i]->{'amount'} > 0) {
 
 849     if ($trans_lines >= 2) {
 
 851       # Personenkontenerweiterung: accno has already been replaced if use_pk was set
 
 852       $datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
 
 853       $datev_data{'konto'}      = $transaction->[$soll]->{'accno'};
 
 854       if ($transaction->[$haben]->{'invnumber'} ne "") {
 
 855         $datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
 
 857       $datev_data{datum} = $transaction->[$haben]->{'transdate'};
 
 858       $datev_data{waehrung} = 'EUR';
 
 859       $datev_data{kost1} = $transaction->[$haben]->{'departmentdescription'};
 
 860       $datev_data{kost2} = $transaction->[$haben]->{'projectdescription'};
 
 862       if ($transaction->[$haben]->{'name'} ne "") {
 
 863         $datev_data{buchungstext} = $transaction->[$haben]->{'name'};
 
 865       if (($transaction->[$haben]->{'ustid'} // '') ne "") {
 
 866         $datev_data{ustid} = SL::VATIDNr->normalize($transaction->[$haben]->{'ustid'});
 
 868       if (($transaction->[$haben]->{'duedate'} // '') ne "") {
 
 869         $datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
 
 872       # if deliverydate exists, add it to datev export if it is
 
 873       # * an ar/ap booking that is not a payment
 
 875       if (    ($transaction->[$haben]->{'deliverydate'} // '') ne ''
 
 877                 (    $transaction->[$haben]->{'table'} =~ /^(ar|ap)$/
 
 878                   && $transaction->[$haben]->{'link'}  !~ m/_paid/
 
 879                   && $transaction->[$soll]->{'link'}   !~ m/_paid/
 
 881                 || $transaction->[$haben]->{'table'} eq 'gl'
 
 884         $datev_data{leistungsdatum} = $transaction->[$haben]->{'deliverydate'};
 
 887     $datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
 
 889     # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
 
 890     # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
 
 891     # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
 
 892     # Skript angelegt werden.
 
 893     # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
 
 894     # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
 
 895     # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
 
 896     # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
 
 897     # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
 
 900     # only set buchungsschluessel if the following conditions are met:
 
 901     if (   ( $datevautomatik || $taxkey)
 
 902         && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
 
 903       # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
 
 904       $datev_data{buchungsschluessel} = $taxkey;
 
 906     # set lock for each transaction
 
 907     $datev_data{locked} = $self->locked;
 
 909     push(@datev_lines, \%datev_data) if $datev_data{umsatz};
 
 912   # example of modifying export data:
 
 913   # foreach my $datev_line ( @datev_lines ) {
 
 914   #   if ( $datev_line{"konto"} eq '1234' ) {
 
 915   #     $datev_line{"konto"} = '9999';
 
 920   return \@datev_lines;
 
 923 sub check_vcnumbers_are_valid_pk_numbers {
 
 926   # better use a class variable and set this in sub new (also needed in DATEV::CSV)
 
 927   # calculation is also a bit more sane in sub check_valid_length_of_accounts
 
 928   my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
 
 929   my $pk_length = $length_of_accounts + 1;
 
 931    SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
 
 933    SELECT vendornumber   AS vcnumber FROM vendor   WHERE vendornumber   !~ '^[[:digit:]]{$pk_length}\$'
 
 936   my ($has_non_pk_accounts)  = selectrow_query($::form, SL::DB->client->dbh, $query);
 
 937   return defined $has_non_pk_accounts ? 0 : 1;
 
 941 sub check_valid_length_of_accounts {
 
 945   SELECT DISTINCT char_length (accno) FROM chart WHERE charttype='A' AND id in (select chart_id from acc_trans);
 
 948   my $accno_length = selectall_hashref_query($::form, SL::DB->client->dbh, $query);
 
 949   if (1 < scalar @$accno_length) {
 
 950     $::form->error(t8("Invalid combination of ledger account number length." .
 
 951                       " Mismatch length of #1 with length of #2. Please check your account settings. ",
 
 952                       $accno_length->[0]->{char_length}, $accno_length->[1]->{char_length}));
 
 958   clean_temporary_directories();
 
 969 SL::DATEV - kivitendo DATEV Export module
 
 973   use SL::DATEV qw(:CONSTANTS);
 
 975   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
 
 976   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
 
 977   my $datev = SL::DATEV->new(
 
 978     exporttype => DATEV_ET_BUCHUNGEN,
 
 979     format     => DATEV_FORMAT_KNE,
 
 984   # To only export transactions from a specific trans_id: (from and to are ignored)
 
 985   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
 
 986   my $datev = SL::DATEV->new(
 
 987     exporttype => DATEV_ET_BUCHUNGEN,
 
 988     format     => DATEV_FORMAT_KNE,
 
 989     trans_id   => $invoice->trans_id,
 
 992   my $datev = SL::DATEV->new(
 
 993     exporttype => DATEV_ET_STAMM,
 
 994     format     => DATEV_FORMAT_KNE,
 
 995     accnofrom  => $start_account_number,
 
 996     accnoto    => $end_account_number,
 
 999   # get or set datev stamm
 
1000   my $hashref = $datev->get_datev_stamm;
 
1001   $datev->save_datev_stamm($hashref);
 
1003   # manually clean up temporary directories older than 8 hours
 
1004   $datev->clean_temporary_directories;
 
1009   if ($datev->errors) {
 
1010     die join "\n", $datev->error;
 
1013   # get relevant data for saving the export:
 
1014   my $dl_token = $datev->download_token;
 
1015   my $path     = $datev->export_path;
 
1016   my @files    = $datev->filenames;
 
1018   # retrieving an export at a later time
 
1019   my $datev = SL::DATEV->new(
 
1020     download_token => $dl_token_from_user,
 
1023   my $path     = $datev->export_path;
 
1024   my @files    = glob("$path/*");
 
1026   # Only test the datev data of a specific trans_id, without generating an
 
1027   # export file, but filling $datev->errors if errors exist
 
1029   my $datev = SL::DATEV->new(
 
1030     trans_id   => $invoice->trans_id,
 
1032   $datev->generate_datev_data;
 
1033   # if ($datev->errors) { ...
 
1038 This module implements the DATEV export standard. For usage see above.
 
1046 Generic constructor. See section attributes for information about what to pass.
 
1048 =item generate_datev_data
 
1050 Fetches all transactions from the database (via a trans_id or a date range),
 
1051 and does an initial transformation (e.g. filters out tax, determines
 
1052 the brutto amount, checks split transactions ...) and stores this data in
 
1055 If any errors are found these are collected in $self->errors.
 
1057 This function is needed for all the exports, but can be also called
 
1058 independently in order to check transactions for DATEV compatibility.
 
1060 =item generate_datev_lines
 
1062 Parse the data in $self->{DATEV} and transform it into a format that can be
 
1063 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
 
1065 The transformed data is returned as an arrayref, which is ready to be converted
 
1066 to a DATEV data format, e.g. KNE, OBE, CSV, ...
 
1068 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
 
1069 entries with datevautomatik have an empty taxkey, as the taxkey is already
 
1070 determined by the chart.
 
1072 =item get_datev_stamm
 
1074 Loads DATEV Stammdaten and returns as hashref.
 
1076 =item save_datev_stamm HASHREF
 
1078 Saves DATEV Stammdaten from provided hashref.
 
1082 See L<CONSTANTS> for possible values
 
1084 =item has_exporttype
 
1086 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
 
1090 Specifies the designated format of the export. Currently only KNE export is implemented.
 
1092 See L<CONSTANTS> for possible values
 
1096 Returns true if a format has been set. Without format most report functions won't work.
 
1098 =item download_token
 
1100 Returns a download token for this DATEV object.
 
1102 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
 
1106 Returns an export_path for this DATEV object.
 
1108 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
 
1112 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.
 
1114 =item net_gross_differences
 
1116 If there were any net gross differences during calculation they will be collected here.
 
1118 =item sum_net_gross_differences
 
1120 Sum of all differences.
 
1122 =item clean_temporary_directories
 
1124 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.
 
1128 Returns a list of errors that occurred. If no errors occurred, the export was a success.
 
1132 Exports data. You have to have set L<exporttype> and L<format> or an error will
 
1133 occur. OBE exports are currently not implemented.
 
1135 =item csv_export_for_tax_accountant
 
1137 Generates up to four downloadable csv files containing data about sales and
 
1138 purchase invoices, and their respective payments:
 
1141   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
 
1142   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
 
1143   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
 
1145   #   'download_token' => '1488551625-815654-22430',
 
1147   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
 
1148   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
 
1149   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
 
1150   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
 
1155 =item check_vcnumbers_are_valid_pk_numbers
 
1157 Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.
 
1159 Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
 
1160 (e.g. 5), and checks the database for any customers or vendors whose customer-
 
1161 or vendornumber doesn't consist of only numbers with exactly that length. E.g.
 
1162 for a chart length of four "10001" would be ok, but not "10001b" or "1000".
 
1164 All vcnumbers are checked, obsolete customers or vendors aren't exempt.
 
1166 There is also no check for the typical customer range 10000-69999 and the
 
1167 typical vendor range 70000-99999.
 
1169 =item check_valid_length_of_accounts
 
1171 Returns 1 if all currently booked accounts have only one common number length domain (e.g. 4 or 6).
 
1172 Will throw an error if more than one distinct size is detected.
 
1173 The error message gives a short hint with the value of the (at least)
 
1174 two mismatching number length domains.
 
1180 This is a list of attributes set in either the C<new> or a method of the same name.
 
1186 Set a database handle to use in the process. This allows for an export to be
 
1187 done on a transaction in progress without committing first.
 
1189 Note: If you don't want this code to commit, simply providing a dbh is not
 
1190 enough enymore. You'll have to wrap the call into a transaction yourself, so
 
1191 that the internal transaction does not commit.
 
1195 See L<CONSTANTS> for possible values. This MUST be set before export is called.
 
1199 See L<CONSTANTS> for possible values. This MUST be set before export is called.
 
1201 =item download_token
 
1203 Can be set on creation to retrieve a prior export for download.
 
1209 Set boundary dates for the export. Unless a trans_id is passed these MUST be
 
1210 set for the export to work.
 
1214 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
 
1215 L<from> and L<to> are currently still needed for the query to be assembled
 
1222 Set boundary account numbers for the export. Only useful for a stammdaten export.
 
1226 Boolean if the transactions are locked (read-only in kivitenod) or not.
 
1227 Default value is false
 
1233 =head2 Supplied to L<exporttype>
 
1237 =item DATEV_ET_BUCHUNGEN
 
1239 =item DATEV_ET_STAMM
 
1243 =head2 Supplied to L<format>.
 
1247 =item DATEV_FORMAT_KNE
 
1249 =item DATEV_FORMAT_OBE
 
1253 =head1 ERROR HANDLING
 
1255 This module will die in the following cases:
 
1261 No or unrecognized exporttype or format was provided for an export
 
1265 OBE export was called, which is not yet implemented.
 
1273 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
 
1279 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
 
1283 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
 
1284 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
 
1288 =head1 BUGS AND CAVEATS
 
1294 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
 
1298 OBE export is currently not implemented.
 
1304 - handling of export_path and download token is a bit dodgy, clean that up.
 
1308 L<SL::DATEV::KNEFile>
 
1313 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
 
1315 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 
1317 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
 
1319 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
 
1321 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,