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