SL/DATEV.pm

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