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