SL/DATEV.pm

   1 #=====================================================================
   2 # kivitendo ERP
   3 # Copyright (c) 2004
   4 #
   5 #  Author: Philip Reetz
   6 #   Email: p.reetz@linet-services.de
   7 #     Web: http://www.lx-office.org
   8 #
   9 #
  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.
  14 #
  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,
  22 # MA 02110-1335, USA.
  23 #======================================================================
  24 #
  25 # Datev export module
  26 #======================================================================
  27
  28 package SL::DATEV;
  29
  30 use utf8;
  31 use strict;
  32
  33 use SL::DBUtils;
  34 use SL::DATEV::KNEFile;
  35 use SL::DATEV::CSV;
  36 use SL::DB;
  37 use SL::HTML::Util ();
  38 use SL::Locale::String qw(t8);
  39
  40 use Data::Dumper;
  41 use DateTime;
  42 use Exporter qw(import);
  43 use File::Path;
  44 use IO::File;
  45 use List::MoreUtils qw(any);
  46 use List::Util qw(min max sum);
  47 use List::UtilsBy qw(partition_by sort_by);
  48 use Text::CSV_XS;
  49 use Time::HiRes qw(gettimeofday);
  50
  51 {
  52   my $i = 0;
  53   use constant {
  54     DATEV_ET_BUCHUNGEN => $i++,
  55     DATEV_ET_STAMM     => $i++,
  56     DATEV_ET_CSV       => $i++,
  57
  58     DATEV_FORMAT_KNE   => $i++,
  59     DATEV_FORMAT_OBE   => $i++,
  60     DATEV_FORMAT_CSV   => $i++,
  61   };
  62 }
  63
  64 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_ET_CSV DATEV_FORMAT_KNE DATEV_FORMAT_OBE DATEV_FORMAT_CSV);
  65 our @EXPORT_OK = (@export_constants);
  66 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
  67
  68
  69 sub new {
  70   my $class = shift;
  71   my %data  = @_;
  72
  73   my $obj = bless {}, $class;
  74
  75   $obj->$_($data{$_}) for keys %data;
  76
  77   $obj;
  78 }
  79
  80 sub exporttype {
  81   my $self = shift;
  82   $self->{exporttype} = $_[0] if @_;
  83   return $self->{exporttype};
  84 }
  85
  86 sub has_exporttype {
  87   defined $_[0]->{exporttype};
  88 }
  89
  90 sub format {
  91   my $self = shift;
  92   $self->{format} = $_[0] if @_;
  93   return $self->{format};
  94 }
  95
  96 sub has_format {
  97   defined $_[0]->{format};
  98 }
  99
 100 sub _get_export_path {
 101   $main::lxdebug->enter_sub();
 102
 103   my ($a, $b) = gettimeofday();
 104   my $path    = _get_path_for_download_token("${a}-${b}-${$}");
 105
 106   mkpath($path) unless (-d $path);
 107
 108   $main::lxdebug->leave_sub();
 109
 110   return $path;
 111 }
 112
 113 sub _get_path_for_download_token {
 114   $main::lxdebug->enter_sub();
 115
 116   my $token = shift || '';
 117   my $path;
 118
 119   if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
 120     $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
 121   }
 122
 123   $main::lxdebug->leave_sub();
 124
 125   return $path;
 126 }
 127
 128 sub _get_download_token_for_path {
 129   $main::lxdebug->enter_sub();
 130
 131   my $path = shift;
 132   my $token;
 133
 134   if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
 135     $token = "${1}-${2}-${3}";
 136   }
 137
 138   $main::lxdebug->leave_sub();
 139
 140   return $token;
 141 }
 142
 143 sub download_token {
 144   my $self = shift;
 145   $self->{download_token} = $_[0] if @_;
 146   return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
 147 }
 148
 149 sub export_path {
 150   my ($self) = @_;
 151
 152   return  $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
 153 }
 154
 155 sub add_filenames {
 156   my $self = shift;
 157   push @{ $self->{filenames} ||= [] }, @_;
 158 }
 159
 160 sub filenames {
 161   return @{ $_[0]{filenames} || [] };
 162 }
 163
 164 sub add_error {
 165   my $self = shift;
 166   push @{ $self->{errors} ||= [] }, @_;
 167 }
 168
 169 sub errors {
 170   return @{ $_[0]{errors} || [] };
 171 }
 172
 173 sub add_net_gross_differences {
 174   my $self = shift;
 175   push @{ $self->{net_gross_differences} ||= [] }, @_;
 176 }
 177
 178 sub net_gross_differences {
 179   return @{ $_[0]{net_gross_differences} || [] };
 180 }
 181
 182 sub sum_net_gross_differences {
 183   return sum $_[0]->net_gross_differences;
 184 }
 185
 186 sub from {
 187  my $self = shift;
 188
 189  if (@_) {
 190    $self->{from} = $_[0];
 191  }
 192
 193  return $self->{from};
 194 }
 195
 196 sub to {
 197  my $self = shift;
 198
 199  if (@_) {
 200    $self->{to} = $_[0];
 201  }
 202
 203  return $self->{to};
 204 }
 205
 206 sub trans_id {
 207   my $self = shift;
 208
 209   if (@_) {
 210     $self->{trans_id} = $_[0];
 211   }
 212
 213   die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
 214
 215   return $self->{trans_id};
 216 }
 217
 218 sub warnings {
 219   my $self = shift;
 220
 221   if (@_) {
 222     $self->{warnings} = [@_];
 223   } else {
 224    return $self->{warnings};
 225   }
 226 }
 227
 228 sub use_pk {
 229  my $self = shift;
 230
 231  if (@_) {
 232    $self->{use_pk} = $_[0];
 233  }
 234
 235  return $self->{use_pk};
 236 }
 237
 238 sub accnofrom {
 239  my $self = shift;
 240
 241  if (@_) {
 242    $self->{accnofrom} = $_[0];
 243  }
 244
 245  return $self->{accnofrom};
 246 }
 247
 248 sub accnoto {
 249  my $self = shift;
 250
 251  if (@_) {
 252    $self->{accnoto} = $_[0];
 253  }
 254
 255  return $self->{accnoto};
 256 }
 257
 258
 259 sub dbh {
 260   my $self = shift;
 261
 262   if (@_) {
 263     $self->{dbh} = $_[0];
 264     $self->{provided_dbh} = 1;
 265   }
 266
 267   $self->{dbh} ||= SL::DB->client->dbh;
 268 }
 269
 270 sub provided_dbh {
 271   $_[0]{provided_dbh};
 272 }
 273
 274 sub clean_temporary_directories {
 275   $::lxdebug->enter_sub;
 276
 277   foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
 278     next unless -d $path;
 279
 280     my $mtime = (stat($path))[9];
 281     next if ((time() - $mtime) < 8 * 60 * 60);
 282
 283     rmtree $path;
 284   }
 285
 286   $::lxdebug->leave_sub;
 287 }
 288
 289 sub _fill {
 290   $main::lxdebug->enter_sub();
 291
 292   my $text      = shift // '';
 293   my $field_len = shift;
 294   my $fill_char = shift;
 295   my $alignment = shift || 'right';
 296
 297   my $text_len  = length $text;
 298
 299   if ($field_len < $text_len) {
 300     $text = substr $text, 0, $field_len;
 301
 302   } elsif ($field_len > $text_len) {
 303     my $filler = ($fill_char) x ($field_len - $text_len);
 304     $text      = $alignment eq 'right' ? $filler . $text : $text . $filler;
 305   }
 306
 307   $main::lxdebug->leave_sub();
 308
 309   return $text;
 310 }
 311
 312 sub get_datev_stamm {
 313   return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
 314 }
 315
 316 sub save_datev_stamm {
 317   my ($self, $data) = @_;
 318
 319   SL::DB->client->with_transaction(sub {
 320     do_query($::form, $self->dbh, 'DELETE FROM datev');
 321
 322     my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
 323
 324     my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
 325     do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
 326     1;
 327   }) or do { die SL::DB->client->error };
 328 }
 329
 330 sub export {
 331   my ($self) = @_;
 332   my $result;
 333
 334   die 'no format set!' unless $self->has_format;
 335
 336   if ($self->format == DATEV_FORMAT_CSV) {
 337     $result = $self->csv_export;
 338   } elsif ($self->format == DATEV_FORMAT_KNE) {
 339     $result = $self->kne_export;
 340   } elsif ($self->format == DATEV_FORMAT_OBE) {
 341     $result = $self->obe_export;
 342   } else {
 343     die 'unrecognized export format';
 344   }
 345
 346   return $result;
 347 }
 348
 349 sub kne_export {
 350   my ($self) = @_;
 351   my $result;
 352
 353   die 'no exporttype set!' unless $self->has_exporttype;
 354
 355   if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
 356     $result = $self->kne_buchungsexport;
 357   } elsif ($self->exporttype == DATEV_ET_STAMM) {
 358     $result = $self->kne_stammdatenexport;
 359   } elsif ($self->exporttype == DATEV_ET_CSV) {
 360     $result = $self->csv_export_for_tax_accountant;
 361   } else {
 362     die 'unrecognized exporttype';
 363   }
 364
 365   return $result;
 366 }
 367
 368 sub csv_export {
 369   my ($self) = @_;
 370   my $result;
 371
 372   die 'no exporttype set!' unless $self->has_exporttype;
 373
 374   if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
 375
 376   $self->generate_datev_data(from_to => $self->fromto);
 377   return if $self->errors;
 378   my $datev_ref;
 379   ($datev_ref, $self->{warnings}) = SL::DATEV::CSV->new(datev_lines  => $self->generate_datev_lines,
 380                                                         from         => $self->from,
 381                                                         to           => $self->to,
 382                                                         locked       => $self->locked,
 383                                                        );
 384
 385   my $filename = "EXTF_DATEV_kivitendo" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
 386
 387   my $csv = Text::CSV_XS->new({
 388               binary       => 1,
 389               sep_char     => ";",
 390               always_quote => 1,
 391               eol          => "\r\n",
 392             }) or die "Cannot use CSV: ".Text::CSV_XS->error_diag();
 393
 394   my $csv_file = IO::File->new($self->export_path . '/' . $filename, '>:encoding(cp1252)') or die "Can't open: $!";
 395   $csv->print($csv_file, $_) for @{ $datev_ref };
 396   $csv_file->close;
 397
 398   return { download_token => $self->download_token, filenames => $filename };
 399
 400   } elsif ($self->exporttype == DATEV_ET_STAMM) {
 401     die 'will never be implemented';
 402     # 'Background: Export should only contain non
 403     #  DATEV-Charts and DATEV import will only
 404     #  import new Charts.'
 405   } elsif ($self->exporttype == DATEV_ET_CSV) {
 406     $result = $self->csv_export_for_tax_accountant;
 407   } else {
 408     die 'unrecognized exporttype';
 409   }
 410
 411 return $result;
 412 }
 413
 414 sub obe_export {
 415   die 'not yet implemented';
 416 }
 417
 418 sub fromto {
 419   my ($self) = @_;
 420
 421   return unless $self->from && $self->to;
 422
 423   return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
 424 }
 425
 426 sub _sign {
 427   $_[0] <=> 0;
 428 }
 429
 430 sub locked {
 431  my $self = shift;
 432
 433  if (@_) {
 434    $self->{locked} = $_[0];
 435  }
 436  return $self->{locked};
 437 }
 438
 439 sub generate_datev_data {
 440   $main::lxdebug->enter_sub();
 441
 442   my ($self, %params)   = @_;
 443   my $fromto            = $params{from_to} // '';
 444   my $progress_callback = $params{progress_callback} || sub {};
 445
 446   my $form     =  $main::form;
 447
 448   my $trans_id_filter = '';
 449   my $ar_department_id_filter = '';
 450   my $ap_department_id_filter = '';
 451   my $gl_department_id_filter = '';
 452   if ( $form->{department_id} ) {
 453     $ar_department_id_filter = " AND ar.department_id = ? ";
 454     $ap_department_id_filter = " AND ap.department_id = ? ";
 455     $gl_department_id_filter = " AND gl.department_id = ? ";
 456   }
 457
 458   my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter);
 459   if ( $form->{gldatefrom} ) {
 460     $gl_itime_filter = " AND gl.itime >= ? ";
 461     $ar_itime_filter = " AND ar.itime >= ? ";
 462     $ap_itime_filter = " AND ap.itime >= ? ";
 463   } else {
 464     $gl_itime_filter = "";
 465     $ar_itime_filter = "";
 466     $ap_itime_filter = "";
 467   }
 468
 469   if ( $self->{trans_id} ) {
 470     # ignore dates when trans_id is passed so that the entire transaction is
 471     # checked, not just either the initial bookings or the subsequent payments
 472     # (the transdates will likely differ)
 473     $fromto = '';
 474     $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
 475   } else {
 476     $fromto      =~ s/transdate/ac\.transdate/g;
 477   };
 478
 479   my ($notsplitindex);
 480
 481   my $filter   = '';            # Useful for debugging purposes
 482
 483   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');
 484
 485   my $ar_accno = "c.accno";
 486   my $ap_accno = "c.accno";
 487   if ( $self->use_pk ) {
 488     $ar_accno = "CASE WHEN ac.chart_link = 'AR' THEN ct.customernumber ELSE c.accno END as accno";
 489     $ap_accno = "CASE WHEN ac.chart_link = 'AP' THEN ct.vendornumber   ELSE c.accno END as accno";
 490   }
 491
 492   my $query    =
 493     qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
 494          ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate, ar.itime::date,
 495          ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
 496          $ar_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 497          ar.invoice,
 498          t.rate AS taxrate, t.taxdescription,
 499          'ar' as table,
 500          tc.accno AS tax_accno, tc.description AS tax_accname,
 501          ar.department_id,
 502          ar.notes,
 503          project.projectnumber as projectnumber, project.description as projectdescription,
 504          department.description as departmentdescription
 505        FROM acc_trans ac
 506        LEFT JOIN ar          ON (ac.trans_id    = ar.id)
 507        LEFT JOIN customer ct ON (ar.customer_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  = ar.department_id)
 512        LEFT JOIN project     ON (project.id     = ar.globalproject_id)
 513        WHERE (ar.id IS NOT NULL)
 514          AND $fromto
 515          $trans_id_filter
 516          $ar_itime_filter
 517          $ar_department_id_filter
 518          $filter
 519
 520        UNION ALL
 521
 522        SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
 523          ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate, ap.itime::date,
 524          ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
 525          $ap_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 526          ap.invoice,
 527          t.rate AS taxrate, t.taxdescription,
 528          'ap' as table,
 529          tc.accno AS tax_accno, tc.description AS tax_accname,
 530          ap.department_id,
 531          ap.notes,
 532          project.projectnumber as projectnumber, project.description as projectdescription,
 533          department.description as departmentdescription
 534        FROM acc_trans ac
 535        LEFT JOIN ap        ON (ac.trans_id  = ap.id)
 536        LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
 537        LEFT JOIN chart c   ON (ac.chart_id  = c.id)
 538        LEFT JOIN tax t     ON (ac.tax_id    = t.id)
 539        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
 540        LEFT JOIN department  ON (department.id  = ap.department_id)
 541        LEFT JOIN project     ON (project.id     = ap.globalproject_id)
 542        WHERE (ap.id IS NOT NULL)
 543          AND $fromto
 544          $trans_id_filter
 545          $ap_itime_filter
 546          $ap_department_id_filter
 547          $filter
 548
 549        UNION ALL
 550
 551        SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
 552          gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate, gl.itime::date,
 553          gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
 554          c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 555          FALSE AS invoice,
 556          t.rate AS taxrate, t.taxdescription,
 557          'gl' as table,
 558          tc.accno AS tax_accno, tc.description AS tax_accname,
 559          gl.department_id,
 560          gl.notes,
 561          '' as projectnumber, '' as projectdescription,
 562          department.description as departmentdescription
 563        FROM acc_trans ac
 564        LEFT JOIN gl      ON (ac.trans_id  = gl.id)
 565        LEFT JOIN chart c ON (ac.chart_id  = c.id)
 566        LEFT JOIN tax t   ON (ac.tax_id    = t.id)
 567        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
 568        LEFT JOIN department  ON (department.id  = gl.department_id)
 569        WHERE (gl.id IS NOT NULL)
 570          AND $fromto
 571          $trans_id_filter
 572          $gl_itime_filter
 573          $gl_department_id_filter
 574          $filter
 575
 576        ORDER BY trans_id, acc_trans_id|;
 577
 578   my @query_args;
 579   if ( $form->{gldatefrom} or $form->{department_id} ) {
 580
 581     for ( 1 .. 3 ) {
 582       if ( $form->{gldatefrom} ) {
 583         my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom});
 584         die "illegal data" unless ref($glfromdate) eq 'DateTime';
 585         push(@query_args, $glfromdate);
 586       }
 587       if ( $form->{department_id} ) {
 588         push(@query_args, $form->{department_id});
 589       }
 590     }
 591   }
 592
 593   my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
 594   $self->{DATEV} = [];
 595
 596   my $counter = 0;
 597   my $continue = 1; #
 598   my $name;
 599   while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
 600     last unless $ref;  # for single transactions
 601     $counter++;
 602     if (($counter % 500) == 0) {
 603       $progress_callback->($counter);
 604     }
 605
 606     my $trans    = [ $ref ];
 607
 608     my $count    = $ref->{amount};
 609     my $firstrun = 1;
 610
 611     # if the amount of a booking in a group is smaller than 0.02, any tax
 612     # amounts will likely be smaller than 1 cent, so go into subcent mode
 613     my $subcent  = abs($count) < 0.02;
 614
 615     # records from acc_trans are ordered by trans_id and acc_trans_id
 616     # first check for unbalanced ledger inside one trans_id
 617     # there may be several groups inside a trans_id, e.g. the original booking and the payment
 618     # each group individually should be exactly balanced and each group
 619     # individually needs its own datev lines
 620
 621     # keep fetching new acc_trans lines until the end of a balanced group is reached
 622     while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
 623       my $ref2 = $sth->fetchrow_hashref("NAME_lc");
 624       unless ( $ref2 ) {
 625         $continue = 0;
 626         last;
 627       };
 628
 629       # check if trans_id of current acc_trans line is still the same as the
 630       # trans_id of the first line in group, i.e. we haven't finished a 0-group
 631       # before moving on to the next trans_id, error will likely be in the old
 632       # trans_id.
 633
 634       if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
 635         require SL::DB::Manager::AccTransaction;
 636         if ( $trans->[0]->{trans_id} ) {
 637           my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
 638           $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
 639                               $acc_trans_obj->transaction_name, $ref2->{trans_id})
 640           );
 641         };
 642         return;
 643       }
 644
 645       push @{ $trans }, $ref2;
 646
 647       $count    += $ref2->{amount};
 648       $firstrun  = 0;
 649     }
 650
 651     foreach my $i (0 .. scalar(@{ $trans }) - 1) {
 652       my $ref        = $trans->[$i];
 653       my $prev_ref   = 0 < $i ? $trans->[$i - 1] : undef;
 654       if (   $all_taxchart_ids{$ref->{id}}
 655           && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
 656           && (   ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
 657               || $ref->{invoice})) {
 658         $ref->{is_tax} = 1;
 659       }
 660
 661       if (   !$ref->{invoice}   # we have a non-invoice booking (=gl)
 662           &&  $ref->{is_tax}    # that has "is_tax" set
 663           && !($prev_ref->{is_tax})  # previous line wasn't is_tax
 664           &&  (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) {  # and sign same as previous sign
 665         $trans->[$i - 1]->{tax_amount} = $ref->{amount};
 666       }
 667     }
 668
 669     my $absumsatz     = 0;
 670     if (scalar(@{$trans}) <= 2) {
 671       push @{ $self->{DATEV} }, $trans;
 672       next;
 673     }
 674
 675     # determine at which array position the reference value (called absumsatz) is
 676     # and which amount it has
 677
 678     for my $j (0 .. (scalar(@{$trans}) - 1)) {
 679
 680       # Three cases:
 681       # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
 682
 683       # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
 684       # true, instead of absumsatz use link AR/AP (there should only be one
 685       # entry)
 686
 687       # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
 688       # instead of absumsatz use link AR/AP (there should only be one, so jump
 689       # out of search as soon as you find it )
 690
 691       # case 1 and 2
 692       # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
 693       # for ap/ar bookings we can always search for AR/AP in link and use that
 694       if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
 695          or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
 696         $absumsatz     = $trans->[$j]->{'amount'};
 697         $notsplitindex = $j;
 698       }
 699
 700       # case 3
 701       # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
 702       # for AR and AP transaction exit the loop as soon as an AR or AP account is found
 703       # there must be only one AR or AP chart in the booking
 704       # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
 705       # manually pays an invoice in GL.
 706       if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
 707         $notsplitindex = $j;   # position in booking with highest amount
 708         $absumsatz     = $trans->[$j]->{'amount'};
 709         last;
 710       };
 711     }
 712
 713     my $ml             = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
 714     my $rounding_error = 0;
 715     my @taxed;
 716
 717     # go through each line and determine if it is a tax booking or not
 718     # skip all tax lines and notsplitindex line
 719     # push all other accounts (e.g. income or expense) with corresponding taxkey
 720
 721     for my $j (0 .. (scalar(@{$trans}) - 1)) {
 722       if (   ($j != $notsplitindex)
 723           && !$trans->[$j]->{is_tax}
 724           && (   $trans->[$j]->{'taxkey'} eq ""
 725               || $trans->[$j]->{'taxkey'} eq "0"
 726               || $trans->[$j]->{'taxkey'} eq "1"
 727               || $trans->[$j]->{'taxkey'} eq "10"
 728               || $trans->[$j]->{'taxkey'} eq "11")) {
 729         my %new_trans = ();
 730         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
 731
 732         $absumsatz               += $trans->[$j]->{'amount'};
 733         $new_trans{'amount'}      = $trans->[$j]->{'amount'} * (-1);
 734         $new_trans{'umsatz'}      = abs($trans->[$j]->{'amount'}) * $ml;
 735         $trans->[$j]->{'umsatz'}  = abs($trans->[$j]->{'amount'}) * $ml;
 736
 737         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
 738
 739       } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
 740
 741         my %new_trans = ();
 742         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
 743
 744         my $tax_rate              = $trans->[$j]->{'taxrate'};
 745         $new_trans{'net_amount'}  = $trans->[$j]->{'amount'} * -1;
 746         $new_trans{'tax_rate'}    = 1 + $tax_rate;
 747
 748         if (!$trans->[$j]->{'invoice'}) {
 749           $new_trans{'amount'}      = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
 750           $new_trans{'umsatz'}      = abs($new_trans{'amount'}) * $ml;
 751           $trans->[$j]->{'umsatz'}  = $new_trans{'umsatz'};
 752           $absumsatz               += -1 * $new_trans{'amount'};
 753
 754         } else {
 755           my $unrounded             = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
 756           my $rounded               = $form->round_amount($unrounded, 2);
 757
 758           $rounding_error           = $unrounded - $rounded;
 759           $new_trans{'amount'}      = $rounded;
 760           $new_trans{'umsatz'}      = abs($rounded) * $ml;
 761           $trans->[$j]->{'umsatz'}  = $new_trans{umsatz};
 762           $absumsatz               -= $rounded;
 763         }
 764
 765         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
 766         push @taxed, $self->{DATEV}->[-1];
 767       }
 768     }
 769
 770     my $idx        = 0;
 771     my $correction = 0;
 772     while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
 773       if ($idx >= scalar @taxed) {
 774         last if (!$correction);
 775
 776         $correction = 0;
 777         $idx        = 0;
 778       }
 779
 780       my $transaction = $taxed[$idx]->[0];
 781
 782       my $old_amount     = $transaction->{amount};
 783       my $old_correction = $correction;
 784       my @possible_diffs;
 785
 786       if (!$transaction->{diff}) {
 787         @possible_diffs = (0.01, -0.01);
 788       } else {
 789         @possible_diffs = ($transaction->{diff});
 790       }
 791
 792       foreach my $diff (@possible_diffs) {
 793         my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
 794         next if ($net_amount != $transaction->{net_amount});
 795
 796         $transaction->{diff}    = $diff;
 797         $transaction->{amount} += $diff;
 798         $transaction->{umsatz} += $diff;
 799         $absumsatz             -= $diff;
 800         $correction             = 1;
 801
 802         last;
 803       }
 804
 805       $idx++;
 806     }
 807
 808     $absumsatz = $form->round_amount($absumsatz, 2);
 809     if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
 810       require SL::DB::Manager::AccTransaction;
 811       my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
 812       $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
 813                           $acc_trans_obj->transaction_name, $absumsatz)
 814       );
 815     } elsif (abs($absumsatz) >= 0.01) {
 816       $self->add_net_gross_differences($absumsatz);
 817     }
 818   }
 819
 820   $sth->finish();
 821
 822   $::lxdebug->leave_sub;
 823 }
 824
 825 sub make_kne_data_header {
 826   $main::lxdebug->enter_sub();
 827
 828   my ($self, $form) = @_;
 829   my ($primanota);
 830
 831   my $stamm = $self->get_datev_stamm;
 832
 833   my $jahr = $self->from ? $self->from->year : DateTime->today->year;
 834
 835   #Header
 836   my $header  = "\x1D\x181";
 837   $header    .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
 838   $header    .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
 839   $header    .= _fill($stamm->{dfvkz}, 2, '0');
 840   $header    .= _fill($stamm->{beraternr}, 7, '0');
 841   $header    .= _fill($stamm->{mandantennr}, 5, '0');
 842   $header    .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
 843
 844   $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
 845   $header .= $self->to   ? $self->to->strftime('%d%m%y')   : '';
 846
 847   if ($self->fromto) {
 848     $primanota = "001";
 849     $header .= $primanota;
 850   }
 851
 852   $header .= _fill($stamm->{passwort}, 4, '0');
 853   $header .= " " x 16;       # Anwendungsinfo
 854   $header .= " " x 16;       # Inputinfo
 855   $header .= "\x79";
 856
 857   #Versionssatz
 858   my $versionssatz  = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
 859
 860   my $query         = qq|SELECT accno FROM chart LIMIT 1|;
 861   my $ref           = selectfirst_hashref_query($form, $self->dbh, $query);
 862
 863   $versionssatz    .= length $ref->{accno};
 864   $versionssatz    .= ",";
 865   $versionssatz    .= length $ref->{accno};
 866   $versionssatz    .= ",SELF" . "\x1C\x79";
 867
 868   $header          .= $versionssatz;
 869
 870   $main::lxdebug->leave_sub();
 871
 872   return $header;
 873 }
 874
 875 sub datetofour {
 876   $main::lxdebug->enter_sub();
 877
 878   my ($date, $six) = @_;
 879
 880   my ($day, $month, $year) = split(/\./, $date);
 881
 882   if (length($month) < 2) {
 883     $month = "0" . $month;
 884   }
 885   if (length($year) > 2) {
 886     $year = substr($year, -2, 2);
 887   }
 888
 889   if ($six) {
 890     $date = $day . $month . $year;
 891   } else {
 892     $date = $day . $month;
 893   }
 894
 895   $main::lxdebug->leave_sub();
 896
 897   return $date;
 898 }
 899
 900 sub trim_leading_zeroes {
 901   my $str = shift;
 902
 903   $str =~ s/^0+//g;
 904
 905   return $str;
 906 }
 907
 908 sub make_ed_versionset {
 909   $main::lxdebug->enter_sub();
 910
 911   my ($self, $header, $filename, $blockcount) = @_;
 912
 913   my $versionset  = "V" . substr($filename, 2, 5);
 914   $versionset    .= substr($header, 6, 22);
 915
 916   if ($self->fromto) {
 917     $versionset .= "0000" . substr($header, 28, 19);
 918   } else {
 919     my $datum = " " x 16;
 920     $versionset .= $datum . "001" . substr($header, 28, 4);
 921   }
 922
 923   $versionset .= _fill($blockcount, 5, '0');
 924   $versionset .= "001";
 925   $versionset .= " 1";
 926   $versionset .= substr($header, -12, 10) . "    ";
 927   $versionset .= " " x 53;
 928
 929   $main::lxdebug->leave_sub();
 930
 931   return $versionset;
 932 }
 933
 934 sub make_ev_header {
 935   $main::lxdebug->enter_sub();
 936
 937   my ($self, $form, $fileno) = @_;
 938
 939   my $stamm = $self->get_datev_stamm;
 940
 941   my $ev_header  = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
 942   $ev_header    .= "   ";
 943   $ev_header    .= _fill($stamm->{beraternr}, 7, ' ', 'left');
 944   $ev_header    .= _fill($stamm->{beratername}, 9, ' ', 'left');
 945   $ev_header    .= " ";
 946   $ev_header    .= (_fill($fileno, 5, '0')) x 2;
 947   $ev_header    .= " " x 95;
 948
 949   $main::lxdebug->leave_sub();
 950
 951   return $ev_header;
 952 }
 953
 954 sub generate_datev_lines {
 955   my ($self) = @_;
 956
 957   my @datev_lines = ();
 958
 959   foreach my $transaction ( @{ $self->{DATEV} } ) {
 960
 961     # each $transaction entry contains data from several acc_trans entries
 962     # belonging to the same trans_id
 963
 964     my %datev_data = (); # data for one transaction
 965     my $trans_lines = scalar(@{$transaction});
 966
 967     my $umsatz         = 0;
 968     my $gegenkonto     = "";
 969     my $konto          = "";
 970     my $belegfeld1     = "";
 971     my $datum          = "";
 972     my $waehrung       = "";
 973     my $buchungstext   = "";
 974     my $belegfeld2     = "";
 975     my $datevautomatik = 0;
 976     my $taxkey         = 0;
 977     my $charttax       = 0;
 978     my $ustid          ="";
 979     my ($haben, $soll);
 980     for (my $i = 0; $i < $trans_lines; $i++) {
 981       if ($trans_lines == 2) {
 982         if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
 983           $umsatz = $transaction->[$i]->{'amount'};
 984         }
 985       } else {
 986         if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
 987           $umsatz = $transaction->[$i]->{'umsatz'};
 988         }
 989       }
 990       if ($transaction->[$i]->{'datevautomatik'}) {
 991         $datevautomatik = 1;
 992       }
 993       if ($transaction->[$i]->{'taxkey'}) {
 994         $taxkey = $transaction->[$i]->{'taxkey'};
 995       }
 996       if ($transaction->[$i]->{'charttax'}) {
 997         $charttax = $transaction->[$i]->{'charttax'};
 998       }
 999       if ($transaction->[$i]->{'amount'} > 0) {
1000         $haben = $i;
1001       } else {
1002         $soll = $i;
1003       }
1004     }
1005
1006     if ($trans_lines >= 2) {
1007
1008       # Personenkontenerweiterung: accno has already been replaced if use_pk was set
1009       $datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
1010       $datev_data{'konto'}      = $transaction->[$soll]->{'accno'};
1011       if ($transaction->[$haben]->{'invnumber'} ne "") {
1012         $datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
1013       }
1014       $datev_data{datum} = $transaction->[$haben]->{'transdate'};
1015       $datev_data{waehrung} = 'EUR';
1016       $datev_data{kost1} = $transaction->[$haben]->{'departmentdescription'};
1017       $datev_data{kost2} = $transaction->[$haben]->{'projectdescription'};
1018
1019       if ($transaction->[$haben]->{'name'} ne "") {
1020         $datev_data{buchungstext} = $transaction->[$haben]->{'name'};
1021       }
1022       if (($transaction->[$haben]->{'ustid'} // '') ne "") {
1023         $datev_data{ustid} = $transaction->[$haben]->{'ustid'};
1024       }
1025       if (($transaction->[$haben]->{'duedate'} // '') ne "") {
1026         $datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
1027       }
1028     }
1029     $datev_data{soll_haben_kennzeichen} = (0 < $umsatz) ? 'H' : 'S';
1030     $datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
1031
1032     # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
1033     # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
1034     # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
1035     # Skript angelegt werden.
1036     # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
1037     # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
1038     # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
1039     # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
1040     # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
1041     #
1042
1043     # only set buchungsschluessel if the following conditions are met:
1044     if (   ( $datevautomatik || $taxkey)
1045         && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
1046       # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
1047       $datev_data{buchungsschluessel} = $taxkey;
1048     }
1049
1050     push(@datev_lines, \%datev_data);
1051   }
1052
1053   # example of modifying export data:
1054   # foreach my $datev_line ( @datev_lines ) {
1055   #   if ( $datev_line{"konto"} eq '1234' ) {
1056   #     $datev_line{"konto"} = '9999';
1057   #   }
1058   # }
1059   #
1060
1061   return \@datev_lines;
1062 }
1063
1064
1065 sub kne_buchungsexport {
1066   $main::lxdebug->enter_sub();
1067
1068   my ($self) = @_;
1069
1070   my $form = $::form;
1071
1072   my @filenames;
1073
1074   my $filename    = "ED00001";
1075   my $evfile      = "EV01";
1076   my @ed_versionset;
1077   my $fileno      = 1;
1078   my $ed_filename = $self->export_path . $filename;
1079
1080   my $fromto = $self->fromto;
1081
1082   $self->generate_datev_data(from_to => $self->fromto); # fetches data from db, transforms data and fills $self->{DATEV}
1083   return if $self->errors;
1084
1085   my @datev_lines = @{ $self->generate_datev_lines };
1086
1087
1088   my $umsatzsumme = sum map { $_->{umsatz} } @datev_lines;
1089
1090   # prepare kne file, everything gets stored in ED00001
1091   my $header = $self->make_kne_data_header($form);
1092   my $kne_file = SL::DATEV::KNEFile->new();
1093   $kne_file->add_block($header);
1094
1095   my $iconv   = $::locale->{iconv_utf8};
1096   my %umlaute = ($iconv->convert('ä') => 'ae',
1097                  $iconv->convert('ö') => 'oe',
1098                  $iconv->convert('ü') => 'ue',
1099                  $iconv->convert('Ä') => 'Ae',
1100                  $iconv->convert('Ö') => 'Oe',
1101                  $iconv->convert('Ü') => 'Ue',
1102                  $iconv->convert('ß') => 'sz');
1103
1104   # add the data from @datev_lines to the kne_file, formatting as needed
1105   foreach my $kne ( @datev_lines ) {
1106     $kne_file->add_block("+" . $kne_file->format_amount(abs($kne->{umsatz}), 0));
1107
1108     # only add buchungsschluessel if it was previously defined
1109     $kne_file->add_block("\x6C" . $kne->{buchungsschluessel}) if defined $kne->{buchungsschluessel};
1110
1111     # ($kne->{gegenkonto}) = $kne->{gegenkonto} =~ /^(\d+)/;
1112     $kne_file->add_block("a" . trim_leading_zeroes($kne->{gegenkonto}));
1113
1114     if ( $kne->{belegfeld1} ) {
1115       my $invnumber = $kne->{belegfeld1};
1116       foreach my $umlaut (keys(%umlaute)) {
1117         $invnumber =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1118       }
1119       $invnumber =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1120       $invnumber =  substr($invnumber, 0, 12);
1121       $invnumber =~ s/\ *$//;
1122       $kne_file->add_block("\xBD" . $invnumber . "\x1C");
1123     }
1124
1125     $kne_file->add_block("\xBE" . &datetofour($kne->{belegfeld2},1) . "\x1C");
1126
1127     $kne_file->add_block("d" . &datetofour($kne->{datum},0));
1128
1129     # ($kne->{konto}) = $kne->{konto} =~ /^(\d+)/;
1130     $kne_file->add_block("e" . trim_leading_zeroes($kne->{konto}));
1131
1132     my $name = $kne->{buchungstext};
1133     foreach my $umlaut (keys(%umlaute)) {
1134       $name =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1135     }
1136     $name =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
1137     $name =  substr($name, 0, 30);
1138     $name =~ s/\ *$//;
1139     $kne_file->add_block("\x1E" . $name . "\x1C");
1140
1141     $kne_file->add_block("\xBA" . $kne->{'ustid'}    . "\x1C") if $kne->{'ustid'};
1142
1143     $kne_file->add_block("\xB3" . $kne->{'waehrung'} . "\x1C" . "\x79");
1144   };
1145
1146   $umsatzsumme          = $kne_file->format_amount(abs($umsatzsumme), 0);
1147   my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
1148
1149   $kne_file->add_block($mandantenendsumme);
1150   $kne_file->flush();
1151
1152   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1153   print(ED $kne_file->get_data());
1154   close(ED);
1155
1156   $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
1157
1158   #Make EV Verwaltungsdatei
1159   my $ev_header   = $self->make_ev_header($form, $fileno);
1160   my $ev_filename = $self->export_path . $evfile;
1161   push(@filenames, $evfile);
1162   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1163   print(EV $ev_header);
1164
1165   foreach my $file (@ed_versionset) {
1166     print(EV $file);
1167   }
1168   close(EV);
1169   ###
1170
1171   $self->add_filenames(@filenames);
1172
1173   $main::lxdebug->leave_sub();
1174
1175   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1176 }
1177
1178 sub kne_stammdatenexport {
1179   $main::lxdebug->enter_sub();
1180
1181   my ($self) = @_;
1182   my $form = $::form;
1183
1184   $self->get_datev_stamm->{abrechnungsnr} = "99";
1185
1186   my @filenames;
1187
1188   my $filename    = "ED00000";
1189   my $evfile      = "EV01";
1190   my @ed_versionset;
1191   my $fileno          = 1;
1192   my $i               = 0;
1193   my $blockcount      = 1;
1194   my $remaining_bytes = 256;
1195   my $total_bytes     = 256;
1196   my $buchungssatz    = "";
1197   $filename++;
1198   my $ed_filename = $self->export_path . $filename;
1199   push(@filenames, $filename);
1200   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1201   my $header = $self->make_kne_data_header($form);
1202   $remaining_bytes -= length($header);
1203
1204   my $fuellzeichen;
1205
1206   my (@where, @values) = ((), ());
1207   if ($self->accnofrom) {
1208     push @where, 'c.accno >= ?';
1209     push @values, $self->accnofrom;
1210   }
1211   if ($self->accnoto) {
1212     push @where, 'c.accno <= ?';
1213     push @values, $self->accnoto;
1214   }
1215
1216   my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1217
1218   my $query     = qq|SELECT c.accno, c.description
1219                      FROM chart c
1220                      $where_str
1221                      ORDER BY c.accno|;
1222
1223   my $sth = $self->dbh->prepare($query);
1224   $sth->execute(@values) || $form->dberror($query);
1225
1226   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1227     if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1228       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1229       $buchungssatz .= "\x00" x $fuellzeichen;
1230       $blockcount++;
1231       $total_bytes = ($blockcount) * 256;
1232     }
1233     $buchungssatz .= "t" . $ref->{'accno'};
1234     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1235     $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1236     $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1237     $ref->{'description'} =~ s/\ *$//;
1238
1239     if (
1240         ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1241         ) <= 6
1242       ) {
1243       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1244       $buchungssatz .= "\x00" x $fuellzeichen;
1245       $blockcount++;
1246       $total_bytes = ($blockcount) * 256;
1247     }
1248     $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1249     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1250   }
1251
1252   $sth->finish;
1253   print(ED $header);
1254   print(ED $buchungssatz);
1255   $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1256   my $dateiende = "\x00" x $fuellzeichen;
1257   print(ED "z");
1258   print(ED $dateiende);
1259   close(ED);
1260
1261   #Make EV Verwaltungsdatei
1262   $ed_versionset[0] =
1263     $self->make_ed_versionset($header, $filename, $blockcount);
1264
1265   my $ev_header = $self->make_ev_header($form, $fileno);
1266   my $ev_filename = $self->export_path . $evfile;
1267   push(@filenames, $evfile);
1268   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1269   print(EV $ev_header);
1270
1271   foreach my $file (@ed_versionset) {
1272     print(EV $ed_versionset[$file]);
1273   }
1274   close(EV);
1275
1276   $self->add_filenames(@filenames);
1277
1278   $main::lxdebug->leave_sub();
1279
1280   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1281 }
1282
1283 sub _format_accno {
1284   my ($accno) = @_;
1285   return $accno . ('0' x (6 - min(length($accno), 6)));
1286 }
1287
1288 sub csv_export_for_tax_accountant {
1289   my ($self) = @_;
1290
1291   $self->generate_datev_data(from_to => $self->fromto);
1292
1293   foreach my $transaction (@{ $self->{DATEV} }) {
1294     foreach my $entry (@{ $transaction }) {
1295       $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1296     }
1297   }
1298
1299   my %transactions =
1300     partition_by { $_->[0]->{table} }
1301     sort_by      { $_->[0]->{sortkey} }
1302     grep         { 2 == scalar(@{ $_ }) }
1303     @{ $self->{DATEV} };
1304
1305   my %column_defs = (
1306     acc_trans_id      => { 'text' => $::locale->text('ID'), },
1307     amount            => { 'text' => $::locale->text('Amount'), },
1308     credit_accname    => { 'text' => $::locale->text('Credit Account Name'), },
1309     credit_accno      => { 'text' => $::locale->text('Credit Account'), },
1310     debit_accname     => { 'text' => $::locale->text('Debit Account Name'), },
1311     debit_accno       => { 'text' => $::locale->text('Debit Account'), },
1312     invnumber         => { 'text' => $::locale->text('Reference'), },
1313     name              => { 'text' => $::locale->text('Name'), },
1314     notes             => { 'text' => $::locale->text('Notes'), },
1315     tax               => { 'text' => $::locale->text('Tax'), },
1316     taxkey            => { 'text' => $::locale->text('Taxkey'), },
1317     tax_accname       => { 'text' => $::locale->text('Tax Account Name'), },
1318     tax_accno         => { 'text' => $::locale->text('Tax Account'), },
1319     transdate         => { 'text' => $::locale->text('Transdate'), },
1320     vcnumber          => { 'text' => $::locale->text('Customer/Vendor Number'), },
1321   );
1322
1323   my @columns = qw(
1324     acc_trans_id name           vcnumber
1325     transdate    invnumber      amount
1326     debit_accno  debit_accname
1327     credit_accno credit_accname
1328     tax
1329     tax_accno    tax_accname    taxkey
1330     notes
1331   );
1332
1333   my %filenames_by_type = (
1334     ar => $::locale->text('AR Transactions'),
1335     ap => $::locale->text('AP Transactions'),
1336     gl => $::locale->text('GL Transactions'),
1337   );
1338
1339   my @filenames;
1340   foreach my $type (qw(ap ar)) {
1341     my %csvs = (
1342       invoices   => {
1343         content  => '',
1344         filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1345         csv      => Text::CSV_XS->new({
1346           binary   => 1,
1347           eol      => "\n",
1348           sep_char => ";",
1349         }),
1350       },
1351       payments   => {
1352         content  => '',
1353         filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1354         csv      => Text::CSV_XS->new({
1355           binary   => 1,
1356           eol      => "\n",
1357           sep_char => ";",
1358         }),
1359       },
1360     );
1361
1362     foreach my $csv (values %csvs) {
1363       $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1364       $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1365
1366       push @filenames, $csv->{filename};
1367     }
1368
1369     foreach my $transaction (@{ $transactions{$type} }) {
1370       my $is_payment     = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1371       my $csv            = $is_payment ? $csvs{payments} : $csvs{invoices};
1372
1373       my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1374       my $tax            = defined($soll->{tax_accno})  ? $soll : $haben;
1375       my $amount         = defined($soll->{net_amount}) ? $soll : $haben;
1376       $haben->{notes}    = ($haben->{memo} || $soll->{memo}) if $is_payment;
1377       $haben->{notes}  //= '';
1378       $haben->{notes}    =  SL::HTML::Util->strip($haben->{notes});
1379       $haben->{notes}    =~ s{\r}{}g;
1380       $haben->{notes}    =~ s{\n+}{ }g;
1381
1382       my %row            = (
1383         amount           => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1384         debit_accno      => _format_accno($soll->{accno}),
1385         debit_accname    => $soll->{accname},
1386         credit_accno     => _format_accno($haben->{accno}),
1387         credit_accname   => $haben->{accname},
1388         tax              => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1389         notes            => $haben->{notes},
1390         (map { ($_ => $tax->{$_})                    } qw(taxkey tax_accname tax_accno)),
1391         (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1392       );
1393
1394       $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1395     }
1396
1397     $_->{out}->close for values %csvs;
1398   }
1399
1400   $self->add_filenames(@filenames);
1401
1402   return { download_token => $self->download_token, filenames => \@filenames };
1403 }
1404
1405 sub check_vcnumbers_are_valid_pk_numbers {
1406   my ($self) = @_;
1407
1408   # better use a class variable and set this in sub new (also needed in DATEV::CSV)
1409   # calculation is also a bit more sane in sub check_valid_length_of_accounts
1410   my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
1411   my $pk_length = $length_of_accounts + 1;
1412   my $query = <<"SQL";
1413    SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
1414    UNION
1415    SELECT vendornumber   AS vcnumber FROM vendor   WHERE vendornumber   !~ '^[[:digit:]]{$pk_length}\$'
1416    LIMIT 1;
1417 SQL
1418   my ($has_non_pk_accounts)  = selectrow_query($::form, SL::DB->client->dbh, $query);
1419   return defined $has_non_pk_accounts ? 0 : 1;
1420 }
1421
1422
1423 sub check_valid_length_of_accounts {
1424   my ($self) = @_;
1425
1426   my $query = <<"SQL";
1427   SELECT DISTINCT char_length (accno) FROM chart WHERE charttype='A' AND id in (select chart_id from acc_trans);
1428 SQL
1429
1430   my $accno_length = selectall_hashref_query($::form, SL::DB->client->dbh, $query);
1431   if (1 < scalar @$accno_length) {
1432     $::form->error(t8("Invalid combination of ledger account number length." .
1433                       " Mismatch length of #1 with length of #2. Please check your account settings. ",
1434                       $accno_length->[0]->{char_length}, $accno_length->[1]->{char_length}));
1435   }
1436   return 1;
1437 }
1438
1439 sub DESTROY {
1440   clean_temporary_directories();
1441 }
1442
1443 1;
1444
1445 __END__
1446
1447 =encoding utf-8
1448
1449 =head1 NAME
1450
1451 SL::DATEV - kivitendo DATEV Export module
1452
1453 =head1 SYNOPSIS
1454
1455   use SL::DATEV qw(:CONSTANTS);
1456
1457   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1458   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
1459   my $datev = SL::DATEV->new(
1460     exporttype => DATEV_ET_BUCHUNGEN,
1461     format     => DATEV_FORMAT_KNE,
1462     from       => $startdate,
1463     to         => $enddate,
1464   );
1465
1466   # To only export transactions from a specific trans_id: (from and to are ignored)
1467   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1468   my $datev = SL::DATEV->new(
1469     exporttype => DATEV_ET_BUCHUNGEN,
1470     format     => DATEV_FORMAT_KNE,
1471     trans_id   => $invoice->trans_id,
1472   );
1473
1474   my $datev = SL::DATEV->new(
1475     exporttype => DATEV_ET_STAMM,
1476     format     => DATEV_FORMAT_KNE,
1477     accnofrom  => $start_account_number,
1478     accnoto    => $end_account_number,
1479   );
1480
1481   # get or set datev stamm
1482   my $hashref = $datev->get_datev_stamm;
1483   $datev->save_datev_stamm($hashref);
1484
1485   # manually clean up temporary directories older than 8 hours
1486   $datev->clean_temporary_directories;
1487
1488   # export
1489   $datev->export;
1490
1491   if ($datev->errors) {
1492     die join "\n", $datev->error;
1493   }
1494
1495   # get relevant data for saving the export:
1496   my $dl_token = $datev->download_token;
1497   my $path     = $datev->export_path;
1498   my @files    = $datev->filenames;
1499
1500   # retrieving an export at a later time
1501   my $datev = SL::DATEV->new(
1502     download_token => $dl_token_from_user,
1503   );
1504
1505   my $path     = $datev->export_path;
1506   my @files    = glob("$path/*");
1507
1508   # Only test the datev data of a specific trans_id, without generating an
1509   # export file, but filling $datev->errors if errors exist
1510
1511   my $datev = SL::DATEV->new(
1512     trans_id   => $invoice->trans_id,
1513   );
1514   $datev->generate_datev_data;
1515   # if ($datev->errors) { ...
1516
1517
1518 =head1 DESCRIPTION
1519
1520 This module implements the DATEV export standard. For usage see above.
1521
1522 =head1 FUNCTIONS
1523
1524 =over 4
1525
1526 =item new PARAMS
1527
1528 Generic constructor. See section attributes for information about what to pass.
1529
1530 =item generate_datev_data
1531
1532 Fetches all transactions from the database (via a trans_id or a date range),
1533 and does an initial transformation (e.g. filters out tax, determines
1534 the brutto amount, checks split transactions ...) and stores this data in
1535 $self->{DATEV}.
1536
1537 If any errors are found these are collected in $self->errors.
1538
1539 This function is needed for all the exports, but can be also called
1540 independently in order to check transactions for DATEV compatibility.
1541
1542 =item generate_datev_lines
1543
1544 Parse the data in $self->{DATEV} and transform it into a format that can be
1545 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1546
1547 The transformed data is returned as an arrayref, which is ready to be converted
1548 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1549
1550 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1551 entries with datevautomatik have an empty taxkey, as the taxkey is already
1552 determined by the chart.
1553
1554 =item get_datev_stamm
1555
1556 Loads DATEV Stammdaten and returns as hashref.
1557
1558 =item save_datev_stamm HASHREF
1559
1560 Saves DATEV Stammdaten from provided hashref.
1561
1562 =item exporttype
1563
1564 See L<CONSTANTS> for possible values
1565
1566 =item has_exporttype
1567
1568 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1569
1570 =item format
1571
1572 Specifies the designated format of the export. Currently only KNE export is implemented.
1573
1574 See L<CONSTANTS> for possible values
1575
1576 =item has_format
1577
1578 Returns true if a format has been set. Without format most report functions won't work.
1579
1580 =item download_token
1581
1582 Returns a download token for this DATEV object.
1583
1584 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1585
1586 =item export_path
1587
1588 Returns an export_path for this DATEV object.
1589
1590 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1591
1592 =item filenames
1593
1594 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.
1595
1596 =item net_gross_differences
1597
1598 If there were any net gross differences during calculation they will be collected here.
1599
1600 =item sum_net_gross_differences
1601
1602 Sum of all differences.
1603
1604 =item clean_temporary_directories
1605
1606 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.
1607
1608 =item errors
1609
1610 Returns a list of errors that occured. If no errors occured, the export was a success.
1611
1612 =item export
1613
1614 Exports data. You have to have set L<exporttype> and L<format> or an error will
1615 occur. OBE exports are currently not implemented.
1616
1617 =item csv_export_for_tax_accountant
1618
1619 Generates up to four downloadable csv files containing data about sales and
1620 purchase invoices, and their respective payments:
1621
1622 Example:
1623   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
1624   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
1625   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1626   # {
1627   #   'download_token' => '1488551625-815654-22430',
1628   #   'filenames' => [
1629   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1630   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1631   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1632   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1633   #                  ]
1634   # };
1635
1636
1637 =item csv_buchungsexport
1638
1639 Generates the CSV-Format data for the CSV DATEV export and returns
1640 an 2-dimensional array as an array_ref.
1641
1642 Requires $self->fromto for a valid DATEV header.
1643
1644 Furthermore we assume that the first day of the fiscal year is
1645 the first of January and we cannot guarantee that our data in kivitendo
1646 is locked, that means a booking cannot be modified after a defined (vat tax)
1647 period.
1648 Some validity checks (max_length and regex) will be done if the
1649 data structure contains them and the field is defined.
1650
1651 To add or alter the structure of the data take a look at SL::DATEV::CSV.pm
1652
1653 =item _csv_buchungsexport_to_file
1654
1655 Generates one downloadable csv file wrapped in a zip archive.
1656 Basically this method is just a thin wrapper for TEXT::CSV_XS.pm
1657
1658 Generates a CSV-file with the same encodings as defined in DATEV Format CSV 2015:
1659  $ file
1660  $ EXTF_Buchungsstapel.csv: ISO-8859 text, with very long lines, with CRLF line terminators
1661
1662 Usage: _csv_buchungsexport_to_file($self, data => $self->csv_buchungsexport);
1663
1664 =item check_vcnumbers_are_valid_pk_numbers
1665
1666 Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.
1667
1668 Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
1669 (e.g. 5), and checks the database for any customers or vendors whose customer-
1670 or vendornumber doesn't consist of only numbers with exactly that length. E.g.
1671 for a chart length of four "10001" would be ok, but not "10001b" or "1000".
1672
1673 All vcnumbers are checked, obsolete customers or vendors aren't exempt.
1674
1675 There is also no check for the typical customer range 10000-69999 and the
1676 typical vendor range 70000-99999.
1677
1678 =item check_valid_length_of_accounts
1679
1680 Returns 1 if all currently booked accounts have only one common number length domain (e.g. 4 or 6).
1681 Will throw an error if more than one distinct size is detected.
1682 The error message gives a short hint with the value of the (at least)
1683 two mismatching number length domains.
1684
1685 =back
1686
1687 =head1 ATTRIBUTES
1688
1689 This is a list of attributes set in either the C<new> or a method of the same name.
1690
1691 =over 4
1692
1693 =item dbh
1694
1695 Set a database handle to use in the process. This allows for an export to be
1696 done on a transaction in progress without committing first.
1697
1698 Note: If you don't want this code to commit, simply providing a dbh is not
1699 enough enymore. You'll have to wrap the call into a transaction yourself, so
1700 that the internal transaction does not commit.
1701
1702 =item exporttype
1703
1704 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1705
1706 =item format
1707
1708 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1709
1710 =item download_token
1711
1712 Can be set on creation to retrieve a prior export for download.
1713
1714 =item from
1715
1716 =item to
1717
1718 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1719 set for the export to work.
1720
1721 =item trans_id
1722
1723 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1724 L<from> and L<to> are currently still needed for the query to be assembled
1725 correctly.
1726
1727 =item accnofrom
1728
1729 =item accnoto
1730
1731 Set boundary account numbers for the export. Only useful for a stammdaten export.
1732
1733 =item locked
1734
1735 Boolean if the transactions are locked (read-only in kivitenod) or not.
1736 Default value is false
1737
1738 =back
1739
1740 =head1 CONSTANTS
1741
1742 =head2 Supplied to L<exporttype>
1743
1744 =over 4
1745
1746 =item DATEV_ET_BUCHUNGEN
1747
1748 =item DATEV_ET_STAMM
1749
1750 =back
1751
1752 =head2 Supplied to L<format>.
1753
1754 =over 4
1755
1756 =item DATEV_FORMAT_KNE
1757
1758 =item DATEV_FORMAT_OBE
1759
1760 =back
1761
1762 =head1 ERROR HANDLING
1763
1764 This module will die in the following cases:
1765
1766 =over 4
1767
1768 =item *
1769
1770 No or unrecognized exporttype or format was provided for an export
1771
1772 =item *
1773
1774 OBE export was called, which is not yet implemented.
1775
1776 =item *
1777
1778 general I/O errors
1779
1780 =back
1781
1782 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1783
1784 =over 4
1785
1786 =item *
1787
1788 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1789
1790 =item *
1791
1792 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
1793 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1794
1795 =back
1796
1797 =head1 BUGS AND CAVEATS
1798
1799 =over 4
1800
1801 =item *
1802
1803 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1804
1805 =item *
1806
1807 OBE export is currently not implemented.
1808
1809 =back
1810
1811 =head1 TODO
1812
1813 - handling of export_path and download token is a bit dodgy, clean that up.
1814
1815 =head1 SEE ALSO
1816
1817 L<SL::DATEV::KNEFile>
1818 L<SL::DATEV::CSV>
1819
1820 =head1 AUTHORS
1821
1822 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1823
1824 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1825
1826 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1827
1828 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1829
1830 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
1831
1832 Stephan Köhler
1833
1834 =cut