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