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