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