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
1464 sub check_vcnumbers_are_valid_pk_numbers {
1465   my ($self) = @_;
1466
1467   my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
1468   my $pk_length = $length_of_accounts + 1;
1469   my $query = <<"SQL";
1470    SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
1471    UNION
1472    SELECT vendornumber   AS vcnumber FROM vendor   WHERE vendornumber   !~ '^[[:digit:]]{$pk_length}\$'
1473    LIMIT 1;
1474 SQL
1475   my ($has_non_pk_accounts)  = selectrow_query($::form, SL::DB->client->dbh, $query);
1476   return defined $has_non_pk_accounts ? 0 : 1;
1477 }
1478
1479 sub DESTROY {
1480   clean_temporary_directories();
1481 }
1482
1483 1;
1484
1485 __END__
1486
1487 =encoding utf-8
1488
1489 =head1 NAME
1490
1491 SL::DATEV - kivitendo DATEV Export module
1492
1493 =head1 SYNOPSIS
1494
1495   use SL::DATEV qw(:CONSTANTS);
1496
1497   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1498   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
1499   my $datev = SL::DATEV->new(
1500     exporttype => DATEV_ET_BUCHUNGEN,
1501     format     => DATEV_FORMAT_KNE,
1502     from       => $startdate,
1503     to         => $enddate,
1504   );
1505
1506   # To only export transactions from a specific trans_id: (from and to are ignored)
1507   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1508   my $datev = SL::DATEV->new(
1509     exporttype => DATEV_ET_BUCHUNGEN,
1510     format     => DATEV_FORMAT_KNE,
1511     trans_id   => $invoice->trans_id,
1512   );
1513
1514   my $datev = SL::DATEV->new(
1515     exporttype => DATEV_ET_STAMM,
1516     format     => DATEV_FORMAT_KNE,
1517     accnofrom  => $start_account_number,
1518     accnoto    => $end_account_number,
1519   );
1520
1521   # get or set datev stamm
1522   my $hashref = $datev->get_datev_stamm;
1523   $datev->save_datev_stamm($hashref);
1524
1525   # manually clean up temporary directories older than 8 hours
1526   $datev->clean_temporary_directories;
1527
1528   # export
1529   $datev->export;
1530
1531   if ($datev->errors) {
1532     die join "\n", $datev->error;
1533   }
1534
1535   # get relevant data for saving the export:
1536   my $dl_token = $datev->download_token;
1537   my $path     = $datev->export_path;
1538   my @files    = $datev->filenames;
1539
1540   # retrieving an export at a later time
1541   my $datev = SL::DATEV->new(
1542     download_token => $dl_token_from_user,
1543   );
1544
1545   my $path     = $datev->export_path;
1546   my @files    = glob("$path/*");
1547
1548   # Only test the datev data of a specific trans_id, without generating an
1549   # export file, but filling $datev->errors if errors exist
1550
1551   my $datev = SL::DATEV->new(
1552     trans_id   => $invoice->trans_id,
1553   );
1554   $datev->generate_datev_data;
1555   # if ($datev->errors) { ...
1556
1557
1558 =head1 DESCRIPTION
1559
1560 This module implements the DATEV export standard. For usage see above.
1561
1562 =head1 FUNCTIONS
1563
1564 =over 4
1565
1566 =item new PARAMS
1567
1568 Generic constructor. See section attributes for information about what to pass.
1569
1570 =item generate_datev_data
1571
1572 Fetches all transactions from the database (via a trans_id or a date range),
1573 and does an initial transformation (e.g. filters out tax, determines
1574 the brutto amount, checks split transactions ...) and stores this data in
1575 $self->{DATEV}.
1576
1577 If any errors are found these are collected in $self->errors.
1578
1579 This function is needed for all the exports, but can be also called
1580 independently in order to check transactions for DATEV compatibility.
1581
1582 =item generate_datev_lines
1583
1584 Parse the data in $self->{DATEV} and transform it into a format that can be
1585 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1586
1587 The transformed data is returned as an arrayref, which is ready to be converted
1588 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1589
1590 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1591 entries with datevautomatik have an empty taxkey, as the taxkey is already
1592 determined by the chart.
1593
1594 =item get_datev_stamm
1595
1596 Loads DATEV Stammdaten and returns as hashref.
1597
1598 =item save_datev_stamm HASHREF
1599
1600 Saves DATEV Stammdaten from provided hashref.
1601
1602 =item exporttype
1603
1604 See L<CONSTANTS> for possible values
1605
1606 =item has_exporttype
1607
1608 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1609
1610 =item format
1611
1612 Specifies the designated format of the export. Currently only KNE export is implemented.
1613
1614 See L<CONSTANTS> for possible values
1615
1616 =item has_format
1617
1618 Returns true if a format has been set. Without format most report functions won't work.
1619
1620 =item download_token
1621
1622 Returns a download token for this DATEV object.
1623
1624 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1625
1626 =item export_path
1627
1628 Returns an export_path for this DATEV object.
1629
1630 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1631
1632 =item filenames
1633
1634 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.
1635
1636 =item net_gross_differences
1637
1638 If there were any net gross differences during calculation they will be collected here.
1639
1640 =item sum_net_gross_differences
1641
1642 Sum of all differences.
1643
1644 =item clean_temporary_directories
1645
1646 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.
1647
1648 =item errors
1649
1650 Returns a list of errors that occured. If no errors occured, the export was a success.
1651
1652 =item export
1653
1654 Exports data. You have to have set L<exporttype> and L<format> or an error will
1655 occur. OBE exports are currently not implemented.
1656
1657 =item csv_export_for_tax_accountant
1658
1659 Generates up to four downloadable csv files containing data about sales and
1660 purchase invoices, and their respective payments:
1661
1662 Example:
1663   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
1664   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
1665   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1666   # {
1667   #   'download_token' => '1488551625-815654-22430',
1668   #   'filenames' => [
1669   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1670   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1671   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1672   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1673   #                  ]
1674   # };
1675
1676
1677 =item csv_buchungsexport
1678
1679 Generates the CSV-Format data for the CSV DATEV export and returns
1680 an 2-dimensional array as an array_ref.
1681
1682 Requires $self->fromto for a valid DATEV header.
1683
1684 Furthermore we assume that the first day of the fiscal year is
1685 the first of January and we cannot guarantee that our data in kivitendo
1686 is locked, that means a booking cannot be modified after a defined (vat tax)
1687 period.
1688 Some validity checks (max_length and regex) will be done if the
1689 data structure contains them and the field is defined.
1690
1691 To add or alter the structure of the data take a look at SL::DATEV::CSV.pm
1692
1693 =item _csv_buchungsexport_to_file
1694
1695 Generates one downloadable csv file wrapped in a zip archive.
1696 Basically this method is just a thin wrapper for TEXT::CSV_XS.pm
1697
1698 Generates a CSV-file with the same encodings as defined in DATEV Format CSV 2015:
1699  $ file
1700  $ EXTF_Buchungsstapel.csv: ISO-8859 text, with very long lines, with CRLF line terminators
1701
1702 Usage: _csv_buchungsexport_to_file($self, data => $self->csv_buchungsexport);
1703
1704 =item check_vcnumbers_are_valid_pk_numbers
1705
1706 Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.
1707
1708 Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
1709 (e.g. 5), and checks the database for any customers or vendors whose customer-
1710 or vendornumber doesn't consist of only numbers with exactly that length. E.g.
1711 for a chart length of four "10001" would be ok, but not "10001b" or "1000".
1712
1713 All vcnumbers are checked, obsolete customers or vendors aren't exempt.
1714
1715 There is also no check for the typical customer range 10000-69999 and the
1716 typical vendor range 70000-99999.
1717
1718 =back
1719
1720 =head1 ATTRIBUTES
1721
1722 This is a list of attributes set in either the C<new> or a method of the same name.
1723
1724 =over 4
1725
1726 =item dbh
1727
1728 Set a database handle to use in the process. This allows for an export to be
1729 done on a transaction in progress without committing first.
1730
1731 Note: If you don't want this code to commit, simply providing a dbh is not
1732 enough enymore. You'll have to wrap the call into a transaction yourself, so
1733 that the internal transaction does not commit.
1734
1735 =item exporttype
1736
1737 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1738
1739 =item format
1740
1741 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1742
1743 =item download_token
1744
1745 Can be set on creation to retrieve a prior export for download.
1746
1747 =item from
1748
1749 =item to
1750
1751 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1752 set for the export to work.
1753
1754 =item trans_id
1755
1756 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1757 L<from> and L<to> are currently still needed for the query to be assembled
1758 correctly.
1759
1760 =item accnofrom
1761
1762 =item accnoto
1763
1764 Set boundary account numbers for the export. Only useful for a stammdaten export.
1765
1766 =back
1767
1768 =head1 CONSTANTS
1769
1770 =head2 Supplied to L<exporttype>
1771
1772 =over 4
1773
1774 =item DATEV_ET_BUCHUNGEN
1775
1776 =item DATEV_ET_STAMM
1777
1778 =back
1779
1780 =head2 Supplied to L<format>.
1781
1782 =over 4
1783
1784 =item DATEV_FORMAT_KNE
1785
1786 =item DATEV_FORMAT_OBE
1787
1788 =back
1789
1790 =head1 ERROR HANDLING
1791
1792 This module will die in the following cases:
1793
1794 =over 4
1795
1796 =item *
1797
1798 No or unrecognized exporttype or format was provided for an export
1799
1800 =item *
1801
1802 OBE export was called, which is not yet implemented.
1803
1804 =item *
1805
1806 general I/O errors
1807
1808 =back
1809
1810 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1811
1812 =over 4
1813
1814 =item *
1815
1816 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1817
1818 =item *
1819
1820 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
1821 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1822
1823 =back
1824
1825 =head1 BUGS AND CAVEATS
1826
1827 =over 4
1828
1829 =item *
1830
1831 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1832
1833 =item *
1834
1835 OBE export is currently not implemented.
1836
1837 =back
1838
1839 =head1 TODO
1840
1841 - handling of export_path and download token is a bit dodgy, clean that up.
1842
1843 =head1 SEE ALSO
1844
1845 L<SL::DATEV::KNEFile>
1846 L<SL::DATEV::CSV>
1847
1848 =head1 AUTHORS
1849
1850 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1851
1852 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1853
1854 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1855
1856 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1857
1858 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
1859
1860 Stephan Köhler
1861
1862 =cut