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