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   # EXTF_Buchungsstapel.csv: ISO-8859 text, with very long lines, with CRLF line terminators
1415   my $csv = Text::CSV_XS->new({
1416               binary       => 1,
1417               sep_char     => ";",
1418               always_quote => 1,
1419               eol          => "\r\n",
1420             }) or die "Cannot use CSV: ".Text::CSV_XS->error_diag();
1421
1422   if ($csv->version >= 1.18) {
1423     # get rid of stupid datev warnings in "Validity program"
1424     $csv->quote_empty(1);
1425   }
1426
1427   my $csv_file = IO::File->new($self->export_path . '/' . $filename, '>:encoding(iso-8859-1)') or die "Can't open: $!";
1428   $csv->print($csv_file, $_) for @{ $params{data} };
1429   $csv_file->close;
1430
1431   return { download_token => $self->download_token, filenames => $params{filename} };
1432 }
1433 sub DESTROY {
1434   clean_temporary_directories();
1435 }
1436
1437 1;
1438
1439 __END__
1440
1441 =encoding utf-8
1442
1443 =head1 NAME
1444
1445 SL::DATEV - kivitendo DATEV Export module
1446
1447 =head1 SYNOPSIS
1448
1449   use SL::DATEV qw(:CONSTANTS);
1450
1451   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1452   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
1453   my $datev = SL::DATEV->new(
1454     exporttype => DATEV_ET_BUCHUNGEN,
1455     format     => DATEV_FORMAT_KNE,
1456     from       => $startdate,
1457     to         => $enddate,
1458   );
1459
1460   # To only export transactions from a specific trans_id: (from and to are ignored)
1461   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1462   my $datev = SL::DATEV->new(
1463     exporttype => DATEV_ET_BUCHUNGEN,
1464     format     => DATEV_FORMAT_KNE,
1465     trans_id   => $invoice->trans_id,
1466   );
1467
1468   my $datev = SL::DATEV->new(
1469     exporttype => DATEV_ET_STAMM,
1470     format     => DATEV_FORMAT_KNE,
1471     accnofrom  => $start_account_number,
1472     accnoto    => $end_account_number,
1473   );
1474
1475   # get or set datev stamm
1476   my $hashref = $datev->get_datev_stamm;
1477   $datev->save_datev_stamm($hashref);
1478
1479   # manually clean up temporary directories older than 8 hours
1480   $datev->clean_temporary_directories;
1481
1482   # export
1483   $datev->export;
1484
1485   if ($datev->errors) {
1486     die join "\n", $datev->error;
1487   }
1488
1489   # get relevant data for saving the export:
1490   my $dl_token = $datev->download_token;
1491   my $path     = $datev->export_path;
1492   my @files    = $datev->filenames;
1493
1494   # retrieving an export at a later time
1495   my $datev = SL::DATEV->new(
1496     download_token => $dl_token_from_user,
1497   );
1498
1499   my $path     = $datev->export_path;
1500   my @files    = glob("$path/*");
1501
1502   # Only test the datev data of a specific trans_id, without generating an
1503   # export file, but filling $datev->errors if errors exist
1504
1505   my $datev = SL::DATEV->new(
1506     trans_id   => $invoice->trans_id,
1507   );
1508   $datev->generate_datev_data;
1509   # if ($datev->errors) { ...
1510
1511
1512 =head1 DESCRIPTION
1513
1514 This module implements the DATEV export standard. For usage see above.
1515
1516 =head1 FUNCTIONS
1517
1518 =over 4
1519
1520 =item new PARAMS
1521
1522 Generic constructor. See section attributes for information about what to pass.
1523
1524 =item generate_datev_data
1525
1526 Fetches all transactions from the database (via a trans_id or a date range),
1527 and does an initial transformation (e.g. filters out tax, determines
1528 the brutto amount, checks split transactions ...) and stores this data in
1529 $self->{DATEV}.
1530
1531 If any errors are found these are collected in $self->errors.
1532
1533 This function is needed for all the exports, but can be also called
1534 independently in order to check transactions for DATEV compatibility.
1535
1536 =item generate_datev_lines
1537
1538 Parse the data in $self->{DATEV} and transform it into a format that can be
1539 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1540
1541 The transformed data is returned as an arrayref, which is ready to be converted
1542 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1543
1544 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1545 entries with datevautomatik have an empty taxkey, as the taxkey is already
1546 determined by the chart.
1547
1548 =item get_datev_stamm
1549
1550 Loads DATEV Stammdaten and returns as hashref.
1551
1552 =item save_datev_stamm HASHREF
1553
1554 Saves DATEV Stammdaten from provided hashref.
1555
1556 =item exporttype
1557
1558 See L<CONSTANTS> for possible values
1559
1560 =item has_exporttype
1561
1562 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1563
1564 =item format
1565
1566 Specifies the designated format of the export. Currently only KNE export is implemented.
1567
1568 See L<CONSTANTS> for possible values
1569
1570 =item has_format
1571
1572 Returns true if a format has been set. Without format most report functions won't work.
1573
1574 =item download_token
1575
1576 Returns a download token for this DATEV object.
1577
1578 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1579
1580 =item export_path
1581
1582 Returns an export_path 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 filenames
1587
1588 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.
1589
1590 =item net_gross_differences
1591
1592 If there were any net gross differences during calculation they will be collected here.
1593
1594 =item sum_net_gross_differences
1595
1596 Sum of all differences.
1597
1598 =item clean_temporary_directories
1599
1600 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.
1601
1602 =item errors
1603
1604 Returns a list of errors that occured. If no errors occured, the export was a success.
1605
1606 =item export
1607
1608 Exports data. You have to have set L<exporttype> and L<format> or an error will
1609 occur. OBE exports are currently not implemented.
1610
1611 =item csv_export_for_tax_accountant
1612
1613 Generates up to four downloadable csv files containing data about sales and
1614 purchase invoices, and their respective payments:
1615
1616 Example:
1617   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
1618   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
1619   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1620   # {
1621   #   'download_token' => '1488551625-815654-22430',
1622   #   'filenames' => [
1623   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1624   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1625   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1626   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1627   #                  ]
1628   # };
1629
1630
1631 =item csv_buchungsexport
1632
1633 Generates the CSV-Format data for the CSV DATEV export and returns
1634 an 2-dimensional array as an array_ref.
1635
1636 Requires $self->fromto for a valid DATEV header.
1637
1638 Furthermore we assume that the first day of the fiscal year is
1639 the first of January and we cannot guarantee that our data in kivitendo
1640 is locked, that means a booking cannot be modified after a defined (vat tax)
1641 period.
1642 Some validity checks (max_length and regex) will be done if the
1643 data structure contains them and the field is defined.
1644
1645 To add or alter the structure of the data take a look at SL::DATEV::CSV.pm
1646
1647 =item _csv_buchungsexport_to_file
1648
1649 Generates one downloadable csv file wrapped in a zip archive.
1650 Basically this method is just a thin wrapper for TEXT::CSV_XS.pm
1651
1652 Generates a CSV-file with the same encodings as defined in DATEV Format CSV 2015:
1653  $ file
1654  $ EXTF_Buchungsstapel.csv: ISO-8859 text, with very long lines, with CRLF line terminators
1655
1656 Usage: _csv_buchungsexport_to_file($self, data => $self->csv_buchungsexport);
1657
1658
1659 =back
1660
1661 =head1 ATTRIBUTES
1662
1663 This is a list of attributes set in either the C<new> or a method of the same name.
1664
1665 =over 4
1666
1667 =item dbh
1668
1669 Set a database handle to use in the process. This allows for an export to be
1670 done on a transaction in progress without committing first.
1671
1672 Note: If you don't want this code to commit, simply providing a dbh is not
1673 enough enymore. You'll have to wrap the call into a transaction yourself, so
1674 that the internal transaction does not commit.
1675
1676 =item exporttype
1677
1678 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1679
1680 =item format
1681
1682 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1683
1684 =item download_token
1685
1686 Can be set on creation to retrieve a prior export for download.
1687
1688 =item from
1689
1690 =item to
1691
1692 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1693 set for the export to work.
1694
1695 =item trans_id
1696
1697 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1698 L<from> and L<to> are currently still needed for the query to be assembled
1699 correctly.
1700
1701 =item accnofrom
1702
1703 =item accnoto
1704
1705 Set boundary account numbers for the export. Only useful for a stammdaten export.
1706
1707 =back
1708
1709 =head1 CONSTANTS
1710
1711 =head2 Supplied to L<exporttype>
1712
1713 =over 4
1714
1715 =item DATEV_ET_BUCHUNGEN
1716
1717 =item DATEV_ET_STAMM
1718
1719 =back
1720
1721 =head2 Supplied to L<format>.
1722
1723 =over 4
1724
1725 =item DATEV_FORMAT_KNE
1726
1727 =item DATEV_FORMAT_OBE
1728
1729 =back
1730
1731 =head1 ERROR HANDLING
1732
1733 This module will die in the following cases:
1734
1735 =over 4
1736
1737 =item *
1738
1739 No or unrecognized exporttype or format was provided for an export
1740
1741 =item *
1742
1743 OBE export was called, which is not yet implemented.
1744
1745 =item *
1746
1747 general I/O errors
1748
1749 =back
1750
1751 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1752
1753 =over 4
1754
1755 =item *
1756
1757 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1758
1759 =item *
1760
1761 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
1762 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1763
1764 =back
1765
1766 =head1 BUGS AND CAVEATS
1767
1768 =over 4
1769
1770 =item *
1771
1772 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1773
1774 =item *
1775
1776 OBE export is currently not implemented.
1777
1778 =back
1779
1780 =head1 TODO
1781
1782 - handling of export_path and download token is a bit dodgy, clean that up.
1783
1784 =head1 SEE ALSO
1785
1786 L<SL::DATEV::KNEFile>
1787 L<SL::DATEV::CSV>
1788
1789 =head1 AUTHORS
1790
1791 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1792
1793 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1794
1795 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1796
1797 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1798
1799 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
1800
1801 Stephan Köhler
1802
1803 =cut