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       $datev_data{kost1} = $transaction->[$haben]->{'departmentdescription'};
 940       $datev_data{kost2} = $transaction->[$haben]->{'projectdescription'};
 941
 942       if ($transaction->[$haben]->{'name'} ne "") {
 943         $datev_data{buchungstext} = $transaction->[$haben]->{'name'};
 944       }
 945       if (($transaction->[$haben]->{'ustid'} // '') ne "") {
 946         $datev_data{ustid} = $transaction->[$haben]->{'ustid'};
 947       }
 948       if (($transaction->[$haben]->{'duedate'} // '') ne "") {
 949         $datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
 950       }
 951     }
 952
 953     $datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
 954
 955     # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
 956     # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
 957     # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
 958     # Skript angelegt werden.
 959     # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
 960     # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
 961     # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
 962     # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
 963     # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
 964     #
 965
 966     # only set buchungsschluessel if the following conditions are met:
 967     if (   ( $datevautomatik || $taxkey)
 968         && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
 969       # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
 970       $datev_data{buchungsschluessel} = $taxkey;
 971     }
 972
 973     push(@datev_lines, \%datev_data);
 974   }
 975
 976   # example of modifying export data:
 977   # foreach my $datev_line ( @datev_lines ) {
 978   #   if ( $datev_line{"konto"} eq '1234' ) {
 979   #     $datev_line{"konto"} = '9999';
 980   #   }
 981   # }
 982   #
 983
 984   return \@datev_lines;
 985 }
 986
 987
 988 sub kne_buchungsexport {
 989   $main::lxdebug->enter_sub();
 990
 991   my ($self) = @_;
 992
 993   my $form = $::form;
 994
 995   my @filenames;
 996
 997   my $filename    = "ED00001";
 998   my $evfile      = "EV01";
 999   my @ed_versionset;
1000   my $fileno      = 1;
1001   my $ed_filename = $self->export_path . $filename;
1002
1003   my $fromto = $self->fromto;
1004
1005   $self->generate_datev_data(from_to => $self->fromto); # fetches data from db, transforms data and fills $self->{DATEV}
1006   return if $self->errors;
1007
1008   my @datev_lines = @{ $self->generate_datev_lines };
1009
1010
1011   my $umsatzsumme = sum map { $_->{umsatz} } @datev_lines;
1012
1013   # prepare kne file, everything gets stored in ED00001
1014   my $header = $self->make_kne_data_header($form);
1015   my $kne_file = SL::DATEV::KNEFile->new();
1016   $kne_file->add_block($header);
1017
1018   my $iconv   = $::locale->{iconv_utf8};
1019   my %umlaute = ($iconv->convert('ä') => 'ae',
1020                  $iconv->convert('ö') => 'oe',
1021                  $iconv->convert('ü') => 'ue',
1022                  $iconv->convert('Ä') => 'Ae',
1023                  $iconv->convert('Ö') => 'Oe',
1024                  $iconv->convert('Ü') => 'Ue',
1025                  $iconv->convert('ß') => 'sz');
1026
1027   # add the data from @datev_lines to the kne_file, formatting as needed
1028   foreach my $kne ( @datev_lines ) {
1029     $kne_file->add_block("+" . $kne_file->format_amount(abs($kne->{umsatz}), 0));
1030
1031     # only add buchungsschluessel if it was previously defined
1032     $kne_file->add_block("\x6C" . $kne->{buchungsschluessel}) if defined $kne->{buchungsschluessel};
1033
1034     # ($kne->{gegenkonto}) = $kne->{gegenkonto} =~ /^(\d+)/;
1035     $kne_file->add_block("a" . trim_leading_zeroes($kne->{gegenkonto}));
1036
1037     if ( $kne->{belegfeld1} ) {
1038       my $invnumber = $kne->{belegfeld1};
1039       foreach my $umlaut (keys(%umlaute)) {
1040         $invnumber =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1041       }
1042       $invnumber =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1043       $invnumber =  substr($invnumber, 0, 12);
1044       $invnumber =~ s/\ *$//;
1045       $kne_file->add_block("\xBD" . $invnumber . "\x1C");
1046     }
1047
1048     $kne_file->add_block("\xBE" . &datetofour($kne->{belegfeld2},1) . "\x1C");
1049
1050     $kne_file->add_block("d" . &datetofour($kne->{datum},0));
1051
1052     # ($kne->{konto}) = $kne->{konto} =~ /^(\d+)/;
1053     $kne_file->add_block("e" . trim_leading_zeroes($kne->{konto}));
1054
1055     my $name = $kne->{buchungstext};
1056     foreach my $umlaut (keys(%umlaute)) {
1057       $name =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1058     }
1059     $name =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
1060     $name =  substr($name, 0, 30);
1061     $name =~ s/\ *$//;
1062     $kne_file->add_block("\x1E" . $name . "\x1C");
1063
1064     $kne_file->add_block("\xBA" . $kne->{'ustid'}    . "\x1C") if $kne->{'ustid'};
1065
1066     $kne_file->add_block("\xB3" . $kne->{'waehrung'} . "\x1C" . "\x79");
1067   };
1068
1069   $umsatzsumme          = $kne_file->format_amount(abs($umsatzsumme), 0);
1070   my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
1071
1072   $kne_file->add_block($mandantenendsumme);
1073   $kne_file->flush();
1074
1075   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1076   print(ED $kne_file->get_data());
1077   close(ED);
1078
1079   $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
1080
1081   #Make EV Verwaltungsdatei
1082   my $ev_header   = $self->make_ev_header($form, $fileno);
1083   my $ev_filename = $self->export_path . $evfile;
1084   push(@filenames, $evfile);
1085   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1086   print(EV $ev_header);
1087
1088   foreach my $file (@ed_versionset) {
1089     print(EV $file);
1090   }
1091   close(EV);
1092   ###
1093
1094   $self->add_filenames(@filenames);
1095
1096   $main::lxdebug->leave_sub();
1097
1098   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1099 }
1100
1101 sub kne_stammdatenexport {
1102   $main::lxdebug->enter_sub();
1103
1104   my ($self) = @_;
1105   my $form = $::form;
1106
1107   $self->get_datev_stamm->{abrechnungsnr} = "99";
1108
1109   my @filenames;
1110
1111   my $filename    = "ED00000";
1112   my $evfile      = "EV01";
1113   my @ed_versionset;
1114   my $fileno          = 1;
1115   my $i               = 0;
1116   my $blockcount      = 1;
1117   my $remaining_bytes = 256;
1118   my $total_bytes     = 256;
1119   my $buchungssatz    = "";
1120   $filename++;
1121   my $ed_filename = $self->export_path . $filename;
1122   push(@filenames, $filename);
1123   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1124   my $header = $self->make_kne_data_header($form);
1125   $remaining_bytes -= length($header);
1126
1127   my $fuellzeichen;
1128
1129   my (@where, @values) = ((), ());
1130   if ($self->accnofrom) {
1131     push @where, 'c.accno >= ?';
1132     push @values, $self->accnofrom;
1133   }
1134   if ($self->accnoto) {
1135     push @where, 'c.accno <= ?';
1136     push @values, $self->accnoto;
1137   }
1138
1139   my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1140
1141   my $query     = qq|SELECT c.accno, c.description
1142                      FROM chart c
1143                      $where_str
1144                      ORDER BY c.accno|;
1145
1146   my $sth = $self->dbh->prepare($query);
1147   $sth->execute(@values) || $form->dberror($query);
1148
1149   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1150     if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1151       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1152       $buchungssatz .= "\x00" x $fuellzeichen;
1153       $blockcount++;
1154       $total_bytes = ($blockcount) * 256;
1155     }
1156     $buchungssatz .= "t" . $ref->{'accno'};
1157     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1158     $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1159     $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1160     $ref->{'description'} =~ s/\ *$//;
1161
1162     if (
1163         ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1164         ) <= 6
1165       ) {
1166       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1167       $buchungssatz .= "\x00" x $fuellzeichen;
1168       $blockcount++;
1169       $total_bytes = ($blockcount) * 256;
1170     }
1171     $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1172     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1173   }
1174
1175   $sth->finish;
1176   print(ED $header);
1177   print(ED $buchungssatz);
1178   $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1179   my $dateiende = "\x00" x $fuellzeichen;
1180   print(ED "z");
1181   print(ED $dateiende);
1182   close(ED);
1183
1184   #Make EV Verwaltungsdatei
1185   $ed_versionset[0] =
1186     $self->make_ed_versionset($header, $filename, $blockcount);
1187
1188   my $ev_header = $self->make_ev_header($form, $fileno);
1189   my $ev_filename = $self->export_path . $evfile;
1190   push(@filenames, $evfile);
1191   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1192   print(EV $ev_header);
1193
1194   foreach my $file (@ed_versionset) {
1195     print(EV $ed_versionset[$file]);
1196   }
1197   close(EV);
1198
1199   $self->add_filenames(@filenames);
1200
1201   $main::lxdebug->leave_sub();
1202
1203   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1204 }
1205
1206 sub _format_accno {
1207   my ($accno) = @_;
1208   return $accno . ('0' x (6 - min(length($accno), 6)));
1209 }
1210
1211 sub csv_export_for_tax_accountant {
1212   my ($self) = @_;
1213
1214   $self->generate_datev_data(from_to => $self->fromto);
1215
1216   foreach my $transaction (@{ $self->{DATEV} }) {
1217     foreach my $entry (@{ $transaction }) {
1218       $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1219     }
1220   }
1221
1222   my %transactions =
1223     partition_by { $_->[0]->{table} }
1224     sort_by      { $_->[0]->{sortkey} }
1225     grep         { 2 == scalar(@{ $_ }) }
1226     @{ $self->{DATEV} };
1227
1228   my %column_defs = (
1229     acc_trans_id      => { 'text' => $::locale->text('ID'), },
1230     amount            => { 'text' => $::locale->text('Amount'), },
1231     credit_accname    => { 'text' => $::locale->text('Credit Account Name'), },
1232     credit_accno      => { 'text' => $::locale->text('Credit Account'), },
1233     debit_accname     => { 'text' => $::locale->text('Debit Account Name'), },
1234     debit_accno       => { 'text' => $::locale->text('Debit Account'), },
1235     invnumber         => { 'text' => $::locale->text('Reference'), },
1236     name              => { 'text' => $::locale->text('Name'), },
1237     notes             => { 'text' => $::locale->text('Notes'), },
1238     tax               => { 'text' => $::locale->text('Tax'), },
1239     taxkey            => { 'text' => $::locale->text('Taxkey'), },
1240     tax_accname       => { 'text' => $::locale->text('Tax Account Name'), },
1241     tax_accno         => { 'text' => $::locale->text('Tax Account'), },
1242     transdate         => { 'text' => $::locale->text('Transdate'), },
1243     vcnumber          => { 'text' => $::locale->text('Customer/Vendor Number'), },
1244   );
1245
1246   my @columns = qw(
1247     acc_trans_id name           vcnumber
1248     transdate    invnumber      amount
1249     debit_accno  debit_accname
1250     credit_accno credit_accname
1251     tax
1252     tax_accno    tax_accname    taxkey
1253     notes
1254   );
1255
1256   my %filenames_by_type = (
1257     ar => $::locale->text('AR Transactions'),
1258     ap => $::locale->text('AP Transactions'),
1259     gl => $::locale->text('GL Transactions'),
1260   );
1261
1262   my @filenames;
1263   foreach my $type (qw(ap ar)) {
1264     my %csvs = (
1265       invoices   => {
1266         content  => '',
1267         filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1268         csv      => Text::CSV_XS->new({
1269           binary   => 1,
1270           eol      => "\n",
1271           sep_char => ";",
1272         }),
1273       },
1274       payments   => {
1275         content  => '',
1276         filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1277         csv      => Text::CSV_XS->new({
1278           binary   => 1,
1279           eol      => "\n",
1280           sep_char => ";",
1281         }),
1282       },
1283     );
1284
1285     foreach my $csv (values %csvs) {
1286       $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1287       $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1288
1289       push @filenames, $csv->{filename};
1290     }
1291
1292     foreach my $transaction (@{ $transactions{$type} }) {
1293       my $is_payment     = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1294       my $csv            = $is_payment ? $csvs{payments} : $csvs{invoices};
1295
1296       my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1297       my $tax            = defined($soll->{tax_accno})  ? $soll : $haben;
1298       my $amount         = defined($soll->{net_amount}) ? $soll : $haben;
1299       $haben->{notes}    = ($haben->{memo} || $soll->{memo}) if $is_payment;
1300       $haben->{notes}  //= '';
1301       $haben->{notes}    =  SL::HTML::Util->strip($haben->{notes});
1302       $haben->{notes}    =~ s{\r}{}g;
1303       $haben->{notes}    =~ s{\n+}{ }g;
1304
1305       my %row            = (
1306         amount           => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1307         debit_accno      => _format_accno($soll->{accno}),
1308         debit_accname    => $soll->{accname},
1309         credit_accno     => _format_accno($haben->{accno}),
1310         credit_accname   => $haben->{accname},
1311         tax              => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1312         notes            => $haben->{notes},
1313         (map { ($_ => $tax->{$_})                    } qw(taxkey tax_accname tax_accno)),
1314         (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1315       );
1316
1317       $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1318     }
1319
1320     $_->{out}->close for values %csvs;
1321   }
1322
1323   $self->add_filenames(@filenames);
1324
1325   return { download_token => $self->download_token, filenames => \@filenames };
1326 }
1327
1328 sub DESTROY {
1329   clean_temporary_directories();
1330 }
1331
1332 1;
1333
1334 __END__
1335
1336 =encoding utf-8
1337
1338 =head1 NAME
1339
1340 SL::DATEV - kivitendo DATEV Export module
1341
1342 =head1 SYNOPSIS
1343
1344   use SL::DATEV qw(:CONSTANTS);
1345
1346   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1347   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
1348   my $datev = SL::DATEV->new(
1349     exporttype => DATEV_ET_BUCHUNGEN,
1350     format     => DATEV_FORMAT_KNE,
1351     from       => $startdate,
1352     to         => $enddate,
1353   );
1354
1355   # To only export transactions from a specific trans_id: (from and to are ignored)
1356   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1357   my $datev = SL::DATEV->new(
1358     exporttype => DATEV_ET_BUCHUNGEN,
1359     format     => DATEV_FORMAT_KNE,
1360     trans_id   => $invoice->trans_id,
1361   );
1362
1363   my $datev = SL::DATEV->new(
1364     exporttype => DATEV_ET_STAMM,
1365     format     => DATEV_FORMAT_KNE,
1366     accnofrom  => $start_account_number,
1367     accnoto    => $end_account_number,
1368   );
1369
1370   # get or set datev stamm
1371   my $hashref = $datev->get_datev_stamm;
1372   $datev->save_datev_stamm($hashref);
1373
1374   # manually clean up temporary directories older than 8 hours
1375   $datev->clean_temporary_directories;
1376
1377   # export
1378   $datev->export;
1379
1380   if ($datev->errors) {
1381     die join "\n", $datev->error;
1382   }
1383
1384   # get relevant data for saving the export:
1385   my $dl_token = $datev->download_token;
1386   my $path     = $datev->export_path;
1387   my @files    = $datev->filenames;
1388
1389   # retrieving an export at a later time
1390   my $datev = SL::DATEV->new(
1391     download_token => $dl_token_from_user,
1392   );
1393
1394   my $path     = $datev->export_path;
1395   my @files    = glob("$path/*");
1396
1397   # Only test the datev data of a specific trans_id, without generating an
1398   # export file, but filling $datev->errors if errors exist
1399
1400   my $datev = SL::DATEV->new(
1401     trans_id   => $invoice->trans_id,
1402   );
1403   $datev->generate_datev_data;
1404   # if ($datev->errors) { ...
1405
1406
1407 =head1 DESCRIPTION
1408
1409 This module implements the DATEV export standard. For usage see above.
1410
1411 =head1 FUNCTIONS
1412
1413 =over 4
1414
1415 =item new PARAMS
1416
1417 Generic constructor. See section attributes for information about what to pass.
1418
1419 =item generate_datev_data
1420
1421 Fetches all transactions from the database (via a trans_id or a date range),
1422 and does an initial transformation (e.g. filters out tax, determines
1423 the brutto amount, checks split transactions ...) and stores this data in
1424 $self->{DATEV}.
1425
1426 If any errors are found these are collected in $self->errors.
1427
1428 This function is needed for all the exports, but can be also called
1429 independently in order to check transactions for DATEV compatibility.
1430
1431 =item generate_datev_lines
1432
1433 Parse the data in $self->{DATEV} and transform it into a format that can be
1434 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1435
1436 The transformed data is returned as an arrayref, which is ready to be converted
1437 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1438
1439 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1440 entries with datevautomatik have an empty taxkey, as the taxkey is already
1441 determined by the chart.
1442
1443 =item get_datev_stamm
1444
1445 Loads DATEV Stammdaten and returns as hashref.
1446
1447 =item save_datev_stamm HASHREF
1448
1449 Saves DATEV Stammdaten from provided hashref.
1450
1451 =item exporttype
1452
1453 See L<CONSTANTS> for possible values
1454
1455 =item has_exporttype
1456
1457 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1458
1459 =item format
1460
1461 Specifies the designated format of the export. Currently only KNE export is implemented.
1462
1463 See L<CONSTANTS> for possible values
1464
1465 =item has_format
1466
1467 Returns true if a format has been set. Without format most report functions won't work.
1468
1469 =item download_token
1470
1471 Returns a download token for this DATEV object.
1472
1473 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1474
1475 =item export_path
1476
1477 Returns an export_path for this DATEV object.
1478
1479 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1480
1481 =item filenames
1482
1483 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.
1484
1485 =item net_gross_differences
1486
1487 If there were any net gross differences during calculation they will be collected here.
1488
1489 =item sum_net_gross_differences
1490
1491 Sum of all differences.
1492
1493 =item clean_temporary_directories
1494
1495 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.
1496
1497 =item errors
1498
1499 Returns a list of errors that occured. If no errors occured, the export was a success.
1500
1501 =item export
1502
1503 Exports data. You have to have set L<exporttype> and L<format> or an error will
1504 occur. OBE exports are currently not implemented.
1505
1506 =item csv_export_for_tax_accountant
1507
1508 Generates up to four downloadable csv files containing data about sales and
1509 purchase invoices, and their respective payments:
1510
1511 Example:
1512   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
1513   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
1514   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1515   # {
1516   #   'download_token' => '1488551625-815654-22430',
1517   #   'filenames' => [
1518   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1519   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1520   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1521   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1522   #                  ]
1523   # };
1524
1525 =back
1526
1527 =head1 ATTRIBUTES
1528
1529 This is a list of attributes set in either the C<new> or a method of the same name.
1530
1531 =over 4
1532
1533 =item dbh
1534
1535 Set a database handle to use in the process. This allows for an export to be
1536 done on a transaction in progress without committing first.
1537
1538 Note: If you don't want this code to commit, simply providing a dbh is not
1539 enough enymore. You'll have to wrap the call into a transaction yourself, so
1540 that the internal transaction does not commit.
1541
1542 =item exporttype
1543
1544 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1545
1546 =item format
1547
1548 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1549
1550 =item download_token
1551
1552 Can be set on creation to retrieve a prior export for download.
1553
1554 =item from
1555
1556 =item to
1557
1558 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1559 set for the export to work.
1560
1561 =item trans_id
1562
1563 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1564 L<from> and L<to> are currently still needed for the query to be assembled
1565 correctly.
1566
1567 =item accnofrom
1568
1569 =item accnoto
1570
1571 Set boundary account numbers for the export. Only useful for a stammdaten export.
1572
1573 =back
1574
1575 =head1 CONSTANTS
1576
1577 =head2 Supplied to L<exporttype>
1578
1579 =over 4
1580
1581 =item DATEV_ET_BUCHUNGEN
1582
1583 =item DATEV_ET_STAMM
1584
1585 =back
1586
1587 =head2 Supplied to L<format>.
1588
1589 =over 4
1590
1591 =item DATEV_FORMAT_KNE
1592
1593 =item DATEV_FORMAT_OBE
1594
1595 =back
1596
1597 =head1 ERROR HANDLING
1598
1599 This module will die in the following cases:
1600
1601 =over 4
1602
1603 =item *
1604
1605 No or unrecognized exporttype or format was provided for an export
1606
1607 =item *
1608
1609 OBE export was called, which is not yet implemented.
1610
1611 =item *
1612
1613 general I/O errors
1614
1615 =back
1616
1617 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1618
1619 =over 4
1620
1621 =item *
1622
1623 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1624
1625 =item *
1626
1627 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
1628 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1629
1630 =back
1631
1632 =head1 BUGS AND CAVEATS
1633
1634 =over 4
1635
1636 =item *
1637
1638 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1639
1640 =item *
1641
1642 OBE export is currently not implemented.
1643
1644 =back
1645
1646 =head1 TODO
1647
1648 - handling of export_path and download token is a bit dodgy, clean that up.
1649
1650 =head1 SEE ALSO
1651
1652 L<SL::DATEV::KNEFile>
1653
1654 =head1 AUTHORS
1655
1656 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1657
1658 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1659
1660 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1661
1662 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1663
1664 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
1665
1666 Stephan Köhler
1667
1668 =cut