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