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