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