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{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
1034
1035     # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
1036     # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
1037     # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
1038     # Skript angelegt werden.
1039     # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
1040     # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
1041     # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
1042     # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
1043     # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
1044     #
1045
1046     # only set buchungsschluessel if the following conditions are met:
1047     if (   ( $datevautomatik || $taxkey)
1048         && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
1049       # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
1050       $datev_data{buchungsschluessel} = $taxkey;
1051     }
1052
1053     push(@datev_lines, \%datev_data) if $datev_data{umsatz};
1054   }
1055
1056   # example of modifying export data:
1057   # foreach my $datev_line ( @datev_lines ) {
1058   #   if ( $datev_line{"konto"} eq '1234' ) {
1059   #     $datev_line{"konto"} = '9999';
1060   #   }
1061   # }
1062   #
1063
1064   return \@datev_lines;
1065 }
1066
1067
1068 sub kne_buchungsexport {
1069   $main::lxdebug->enter_sub();
1070
1071   my ($self) = @_;
1072
1073   my $form = $::form;
1074
1075   my @filenames;
1076
1077   my $filename    = "ED00001";
1078   my $evfile      = "EV01";
1079   my @ed_versionset;
1080   my $fileno      = 1;
1081   my $ed_filename = $self->export_path . $filename;
1082
1083   my $fromto = $self->fromto;
1084
1085   $self->generate_datev_data(from_to => $self->fromto); # fetches data from db, transforms data and fills $self->{DATEV}
1086   return if $self->errors;
1087
1088   my @datev_lines = @{ $self->generate_datev_lines };
1089
1090
1091   my $umsatzsumme = sum map { $_->{umsatz} } @datev_lines;
1092
1093   # prepare kne file, everything gets stored in ED00001
1094   my $header = $self->make_kne_data_header($form);
1095   my $kne_file = SL::DATEV::KNEFile->new();
1096   $kne_file->add_block($header);
1097
1098   my $iconv   = $::locale->{iconv_utf8};
1099   my %umlaute = ($iconv->convert('ä') => 'ae',
1100                  $iconv->convert('ö') => 'oe',
1101                  $iconv->convert('ü') => 'ue',
1102                  $iconv->convert('Ä') => 'Ae',
1103                  $iconv->convert('Ö') => 'Oe',
1104                  $iconv->convert('Ü') => 'Ue',
1105                  $iconv->convert('ß') => 'sz');
1106
1107   # add the data from @datev_lines to the kne_file, formatting as needed
1108   foreach my $kne ( @datev_lines ) {
1109     $kne_file->add_block("+" . $kne_file->format_amount(abs($kne->{umsatz}), 0));
1110
1111     # only add buchungsschluessel if it was previously defined
1112     $kne_file->add_block("\x6C" . $kne->{buchungsschluessel}) if defined $kne->{buchungsschluessel};
1113
1114     # ($kne->{gegenkonto}) = $kne->{gegenkonto} =~ /^(\d+)/;
1115     $kne_file->add_block("a" . trim_leading_zeroes($kne->{gegenkonto}));
1116
1117     if ( $kne->{belegfeld1} ) {
1118       my $invnumber = $kne->{belegfeld1};
1119       foreach my $umlaut (keys(%umlaute)) {
1120         $invnumber =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1121       }
1122       $invnumber =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1123       $invnumber =  substr($invnumber, 0, 12);
1124       $invnumber =~ s/\ *$//;
1125       $kne_file->add_block("\xBD" . $invnumber . "\x1C");
1126     }
1127
1128     $kne_file->add_block("\xBE" . &datetofour($kne->{belegfeld2},1) . "\x1C");
1129
1130     $kne_file->add_block("d" . &datetofour($kne->{datum},0));
1131
1132     # ($kne->{konto}) = $kne->{konto} =~ /^(\d+)/;
1133     $kne_file->add_block("e" . trim_leading_zeroes($kne->{konto}));
1134
1135     my $name = $kne->{buchungstext};
1136     foreach my $umlaut (keys(%umlaute)) {
1137       $name =~ s/${umlaut}/${umlaute{$umlaut}}/g;
1138     }
1139     $name =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
1140     $name =  substr($name, 0, 30);
1141     $name =~ s/\ *$//;
1142     $kne_file->add_block("\x1E" . $name . "\x1C");
1143
1144     $kne_file->add_block("\xBA" . $kne->{'ustid'}    . "\x1C") if $kne->{'ustid'};
1145
1146     $kne_file->add_block("\xB3" . $kne->{'waehrung'} . "\x1C" . "\x79");
1147   };
1148
1149   $umsatzsumme          = $kne_file->format_amount(abs($umsatzsumme), 0);
1150   my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
1151
1152   $kne_file->add_block($mandantenendsumme);
1153   $kne_file->flush();
1154
1155   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1156   print(ED $kne_file->get_data());
1157   close(ED);
1158
1159   $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
1160
1161   #Make EV Verwaltungsdatei
1162   my $ev_header   = $self->make_ev_header($form, $fileno);
1163   my $ev_filename = $self->export_path . $evfile;
1164   push(@filenames, $evfile);
1165   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1166   print(EV $ev_header);
1167
1168   foreach my $file (@ed_versionset) {
1169     print(EV $file);
1170   }
1171   close(EV);
1172   ###
1173
1174   $self->add_filenames(@filenames);
1175
1176   $main::lxdebug->leave_sub();
1177
1178   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1179 }
1180
1181 sub kne_stammdatenexport {
1182   $main::lxdebug->enter_sub();
1183
1184   my ($self) = @_;
1185   my $form = $::form;
1186
1187   $self->get_datev_stamm->{abrechnungsnr} = "99";
1188
1189   my @filenames;
1190
1191   my $filename    = "ED00000";
1192   my $evfile      = "EV01";
1193   my @ed_versionset;
1194   my $fileno          = 1;
1195   my $i               = 0;
1196   my $blockcount      = 1;
1197   my $remaining_bytes = 256;
1198   my $total_bytes     = 256;
1199   my $buchungssatz    = "";
1200   $filename++;
1201   my $ed_filename = $self->export_path . $filename;
1202   push(@filenames, $filename);
1203   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
1204   my $header = $self->make_kne_data_header($form);
1205   $remaining_bytes -= length($header);
1206
1207   my $fuellzeichen;
1208
1209   my (@where, @values) = ((), ());
1210   if ($self->accnofrom) {
1211     push @where, 'c.accno >= ?';
1212     push @values, $self->accnofrom;
1213   }
1214   if ($self->accnoto) {
1215     push @where, 'c.accno <= ?';
1216     push @values, $self->accnoto;
1217   }
1218
1219   my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
1220
1221   my $query     = qq|SELECT c.accno, c.description
1222                      FROM chart c
1223                      $where_str
1224                      ORDER BY c.accno|;
1225
1226   my $sth = $self->dbh->prepare($query);
1227   $sth->execute(@values) || $form->dberror($query);
1228
1229   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1230     if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
1231       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1232       $buchungssatz .= "\x00" x $fuellzeichen;
1233       $blockcount++;
1234       $total_bytes = ($blockcount) * 256;
1235     }
1236     $buchungssatz .= "t" . $ref->{'accno'};
1237     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1238     $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
1239     $ref->{'description'} = substr($ref->{'description'}, 0, 40);
1240     $ref->{'description'} =~ s/\ *$//;
1241
1242     if (
1243         ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
1244         ) <= 6
1245       ) {
1246       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
1247       $buchungssatz .= "\x00" x $fuellzeichen;
1248       $blockcount++;
1249       $total_bytes = ($blockcount) * 256;
1250     }
1251     $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
1252     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
1253   }
1254
1255   $sth->finish;
1256   print(ED $header);
1257   print(ED $buchungssatz);
1258   $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
1259   my $dateiende = "\x00" x $fuellzeichen;
1260   print(ED "z");
1261   print(ED $dateiende);
1262   close(ED);
1263
1264   #Make EV Verwaltungsdatei
1265   $ed_versionset[0] =
1266     $self->make_ed_versionset($header, $filename, $blockcount);
1267
1268   my $ev_header = $self->make_ev_header($form, $fileno);
1269   my $ev_filename = $self->export_path . $evfile;
1270   push(@filenames, $evfile);
1271   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
1272   print(EV $ev_header);
1273
1274   foreach my $file (@ed_versionset) {
1275     print(EV $ed_versionset[$file]);
1276   }
1277   close(EV);
1278
1279   $self->add_filenames(@filenames);
1280
1281   $main::lxdebug->leave_sub();
1282
1283   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
1284 }
1285
1286 sub _format_accno {
1287   my ($accno) = @_;
1288   return $accno . ('0' x (6 - min(length($accno), 6)));
1289 }
1290
1291 sub csv_export_for_tax_accountant {
1292   my ($self) = @_;
1293
1294   $self->generate_datev_data(from_to => $self->fromto);
1295
1296   foreach my $transaction (@{ $self->{DATEV} }) {
1297     foreach my $entry (@{ $transaction }) {
1298       $entry->{sortkey} = join '-', map { lc } (DateTime->from_kivitendo($entry->{transdate})->strftime('%Y%m%d'), $entry->{name}, $entry->{reference});
1299     }
1300   }
1301
1302   my %transactions =
1303     partition_by { $_->[0]->{table} }
1304     sort_by      { $_->[0]->{sortkey} }
1305     grep         { 2 == scalar(@{ $_ }) }
1306     @{ $self->{DATEV} };
1307
1308   my %column_defs = (
1309     acc_trans_id      => { 'text' => $::locale->text('ID'), },
1310     amount            => { 'text' => $::locale->text('Amount'), },
1311     credit_accname    => { 'text' => $::locale->text('Credit Account Name'), },
1312     credit_accno      => { 'text' => $::locale->text('Credit Account'), },
1313     debit_accname     => { 'text' => $::locale->text('Debit Account Name'), },
1314     debit_accno       => { 'text' => $::locale->text('Debit Account'), },
1315     invnumber         => { 'text' => $::locale->text('Reference'), },
1316     name              => { 'text' => $::locale->text('Name'), },
1317     notes             => { 'text' => $::locale->text('Notes'), },
1318     tax               => { 'text' => $::locale->text('Tax'), },
1319     taxkey            => { 'text' => $::locale->text('Taxkey'), },
1320     tax_accname       => { 'text' => $::locale->text('Tax Account Name'), },
1321     tax_accno         => { 'text' => $::locale->text('Tax Account'), },
1322     transdate         => { 'text' => $::locale->text('Transdate'), },
1323     vcnumber          => { 'text' => $::locale->text('Customer/Vendor Number'), },
1324   );
1325
1326   my @columns = qw(
1327     acc_trans_id name           vcnumber
1328     transdate    invnumber      amount
1329     debit_accno  debit_accname
1330     credit_accno credit_accname
1331     tax
1332     tax_accno    tax_accname    taxkey
1333     notes
1334   );
1335
1336   my %filenames_by_type = (
1337     ar => $::locale->text('AR Transactions'),
1338     ap => $::locale->text('AP Transactions'),
1339     gl => $::locale->text('GL Transactions'),
1340   );
1341
1342   my @filenames;
1343   foreach my $type (qw(ap ar)) {
1344     my %csvs = (
1345       invoices   => {
1346         content  => '',
1347         filename => sprintf('%s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1348         csv      => Text::CSV_XS->new({
1349           binary   => 1,
1350           eol      => "\n",
1351           sep_char => ";",
1352         }),
1353       },
1354       payments   => {
1355         content  => '',
1356         filename => sprintf('Zahlungen %s %s - %s.csv', $filenames_by_type{$type}, $self->from->to_kivitendo, $self->to->to_kivitendo),
1357         csv      => Text::CSV_XS->new({
1358           binary   => 1,
1359           eol      => "\n",
1360           sep_char => ";",
1361         }),
1362       },
1363     );
1364
1365     foreach my $csv (values %csvs) {
1366       $csv->{out} = IO::File->new($self->export_path . '/' . $csv->{filename}, '>:encoding(utf8)') ;
1367       $csv->{csv}->print($csv->{out}, [ map { $column_defs{$_}->{text} } @columns ]);
1368
1369       push @filenames, $csv->{filename};
1370     }
1371
1372     foreach my $transaction (@{ $transactions{$type} }) {
1373       my $is_payment     = any { $_->{link} =~ m{A[PR]_paid} } @{ $transaction };
1374       my $csv            = $is_payment ? $csvs{payments} : $csvs{invoices};
1375
1376       my ($soll, $haben) = map { $transaction->[$_] } ($transaction->[0]->{amount} > 0 ? (1, 0) : (0, 1));
1377       my $tax            = defined($soll->{tax_accno})  ? $soll : $haben;
1378       my $amount         = defined($soll->{net_amount}) ? $soll : $haben;
1379       $haben->{notes}    = ($haben->{memo} || $soll->{memo}) if $is_payment;
1380       $haben->{notes}  //= '';
1381       $haben->{notes}    =  SL::HTML::Util->strip($haben->{notes});
1382       $haben->{notes}    =~ s{\r}{}g;
1383       $haben->{notes}    =~ s{\n+}{ }g;
1384
1385       my %row            = (
1386         amount           => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}), 2),
1387         debit_accno      => _format_accno($soll->{accno}),
1388         debit_accname    => $soll->{accname},
1389         credit_accno     => _format_accno($haben->{accno}),
1390         credit_accname   => $haben->{accname},
1391         tax              => $::form->format_amount({ numberformat => '1000,00' }, abs($amount->{amount}) - abs($amount->{net_amount}), 2),
1392         notes            => $haben->{notes},
1393         (map { ($_ => $tax->{$_})                    } qw(taxkey tax_accname tax_accno)),
1394         (map { ($_ => ($haben->{$_} // $soll->{$_})) } qw(acc_trans_id invnumber name vcnumber transdate)),
1395       );
1396
1397       $csv->{csv}->print($csv->{out}, [ map { $row{$_} } @columns ]);
1398     }
1399
1400     $_->{out}->close for values %csvs;
1401   }
1402
1403   $self->add_filenames(@filenames);
1404
1405   return { download_token => $self->download_token, filenames => \@filenames };
1406 }
1407
1408 sub check_vcnumbers_are_valid_pk_numbers {
1409   my ($self) = @_;
1410
1411   # better use a class variable and set this in sub new (also needed in DATEV::CSV)
1412   # calculation is also a bit more sane in sub check_valid_length_of_accounts
1413   my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
1414   my $pk_length = $length_of_accounts + 1;
1415   my $query = <<"SQL";
1416    SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
1417    UNION
1418    SELECT vendornumber   AS vcnumber FROM vendor   WHERE vendornumber   !~ '^[[:digit:]]{$pk_length}\$'
1419    LIMIT 1;
1420 SQL
1421   my ($has_non_pk_accounts)  = selectrow_query($::form, SL::DB->client->dbh, $query);
1422   return defined $has_non_pk_accounts ? 0 : 1;
1423 }
1424
1425
1426 sub check_valid_length_of_accounts {
1427   my ($self) = @_;
1428
1429   my $query = <<"SQL";
1430   SELECT DISTINCT char_length (accno) FROM chart WHERE charttype='A' AND id in (select chart_id from acc_trans);
1431 SQL
1432
1433   my $accno_length = selectall_hashref_query($::form, SL::DB->client->dbh, $query);
1434   if (1 < scalar @$accno_length) {
1435     $::form->error(t8("Invalid combination of ledger account number length." .
1436                       " Mismatch length of #1 with length of #2. Please check your account settings. ",
1437                       $accno_length->[0]->{char_length}, $accno_length->[1]->{char_length}));
1438   }
1439   return 1;
1440 }
1441
1442 sub DESTROY {
1443   clean_temporary_directories();
1444 }
1445
1446 1;
1447
1448 __END__
1449
1450 =encoding utf-8
1451
1452 =head1 NAME
1453
1454 SL::DATEV - kivitendo DATEV Export module
1455
1456 =head1 SYNOPSIS
1457
1458   use SL::DATEV qw(:CONSTANTS);
1459
1460   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
1461   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
1462   my $datev = SL::DATEV->new(
1463     exporttype => DATEV_ET_BUCHUNGEN,
1464     format     => DATEV_FORMAT_KNE,
1465     from       => $startdate,
1466     to         => $enddate,
1467   );
1468
1469   # To only export transactions from a specific trans_id: (from and to are ignored)
1470   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
1471   my $datev = SL::DATEV->new(
1472     exporttype => DATEV_ET_BUCHUNGEN,
1473     format     => DATEV_FORMAT_KNE,
1474     trans_id   => $invoice->trans_id,
1475   );
1476
1477   my $datev = SL::DATEV->new(
1478     exporttype => DATEV_ET_STAMM,
1479     format     => DATEV_FORMAT_KNE,
1480     accnofrom  => $start_account_number,
1481     accnoto    => $end_account_number,
1482   );
1483
1484   # get or set datev stamm
1485   my $hashref = $datev->get_datev_stamm;
1486   $datev->save_datev_stamm($hashref);
1487
1488   # manually clean up temporary directories older than 8 hours
1489   $datev->clean_temporary_directories;
1490
1491   # export
1492   $datev->export;
1493
1494   if ($datev->errors) {
1495     die join "\n", $datev->error;
1496   }
1497
1498   # get relevant data for saving the export:
1499   my $dl_token = $datev->download_token;
1500   my $path     = $datev->export_path;
1501   my @files    = $datev->filenames;
1502
1503   # retrieving an export at a later time
1504   my $datev = SL::DATEV->new(
1505     download_token => $dl_token_from_user,
1506   );
1507
1508   my $path     = $datev->export_path;
1509   my @files    = glob("$path/*");
1510
1511   # Only test the datev data of a specific trans_id, without generating an
1512   # export file, but filling $datev->errors if errors exist
1513
1514   my $datev = SL::DATEV->new(
1515     trans_id   => $invoice->trans_id,
1516   );
1517   $datev->generate_datev_data;
1518   # if ($datev->errors) { ...
1519
1520
1521 =head1 DESCRIPTION
1522
1523 This module implements the DATEV export standard. For usage see above.
1524
1525 =head1 FUNCTIONS
1526
1527 =over 4
1528
1529 =item new PARAMS
1530
1531 Generic constructor. See section attributes for information about what to pass.
1532
1533 =item generate_datev_data
1534
1535 Fetches all transactions from the database (via a trans_id or a date range),
1536 and does an initial transformation (e.g. filters out tax, determines
1537 the brutto amount, checks split transactions ...) and stores this data in
1538 $self->{DATEV}.
1539
1540 If any errors are found these are collected in $self->errors.
1541
1542 This function is needed for all the exports, but can be also called
1543 independently in order to check transactions for DATEV compatibility.
1544
1545 =item generate_datev_lines
1546
1547 Parse the data in $self->{DATEV} and transform it into a format that can be
1548 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1549
1550 The transformed data is returned as an arrayref, which is ready to be converted
1551 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1552
1553 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1554 entries with datevautomatik have an empty taxkey, as the taxkey is already
1555 determined by the chart.
1556
1557 =item get_datev_stamm
1558
1559 Loads DATEV Stammdaten and returns as hashref.
1560
1561 =item save_datev_stamm HASHREF
1562
1563 Saves DATEV Stammdaten from provided hashref.
1564
1565 =item exporttype
1566
1567 See L<CONSTANTS> for possible values
1568
1569 =item has_exporttype
1570
1571 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1572
1573 =item format
1574
1575 Specifies the designated format of the export. Currently only KNE export is implemented.
1576
1577 See L<CONSTANTS> for possible values
1578
1579 =item has_format
1580
1581 Returns true if a format has been set. Without format most report functions won't work.
1582
1583 =item download_token
1584
1585 Returns a download token for this DATEV object.
1586
1587 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1588
1589 =item export_path
1590
1591 Returns an export_path for this DATEV object.
1592
1593 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1594
1595 =item filenames
1596
1597 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.
1598
1599 =item net_gross_differences
1600
1601 If there were any net gross differences during calculation they will be collected here.
1602
1603 =item sum_net_gross_differences
1604
1605 Sum of all differences.
1606
1607 =item clean_temporary_directories
1608
1609 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.
1610
1611 =item errors
1612
1613 Returns a list of errors that occured. If no errors occured, the export was a success.
1614
1615 =item export
1616
1617 Exports data. You have to have set L<exporttype> and L<format> or an error will
1618 occur. OBE exports are currently not implemented.
1619
1620 =item csv_export_for_tax_accountant
1621
1622 Generates up to four downloadable csv files containing data about sales and
1623 purchase invoices, and their respective payments:
1624
1625 Example:
1626   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
1627   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
1628   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1629   # {
1630   #   'download_token' => '1488551625-815654-22430',
1631   #   'filenames' => [
1632   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1633   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1634   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1635   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1636   #                  ]
1637   # };
1638
1639
1640 =item check_vcnumbers_are_valid_pk_numbers
1641
1642 Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.
1643
1644 Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
1645 (e.g. 5), and checks the database for any customers or vendors whose customer-
1646 or vendornumber doesn't consist of only numbers with exactly that length. E.g.
1647 for a chart length of four "10001" would be ok, but not "10001b" or "1000".
1648
1649 All vcnumbers are checked, obsolete customers or vendors aren't exempt.
1650
1651 There is also no check for the typical customer range 10000-69999 and the
1652 typical vendor range 70000-99999.
1653
1654 =item check_valid_length_of_accounts
1655
1656 Returns 1 if all currently booked accounts have only one common number length domain (e.g. 4 or 6).
1657 Will throw an error if more than one distinct size is detected.
1658 The error message gives a short hint with the value of the (at least)
1659 two mismatching number length domains.
1660
1661 =back
1662
1663 =head1 ATTRIBUTES
1664
1665 This is a list of attributes set in either the C<new> or a method of the same name.
1666
1667 =over 4
1668
1669 =item dbh
1670
1671 Set a database handle to use in the process. This allows for an export to be
1672 done on a transaction in progress without committing first.
1673
1674 Note: If you don't want this code to commit, simply providing a dbh is not
1675 enough enymore. You'll have to wrap the call into a transaction yourself, so
1676 that the internal transaction does not commit.
1677
1678 =item exporttype
1679
1680 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1681
1682 =item format
1683
1684 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1685
1686 =item download_token
1687
1688 Can be set on creation to retrieve a prior export for download.
1689
1690 =item from
1691
1692 =item to
1693
1694 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1695 set for the export to work.
1696
1697 =item trans_id
1698
1699 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1700 L<from> and L<to> are currently still needed for the query to be assembled
1701 correctly.
1702
1703 =item accnofrom
1704
1705 =item accnoto
1706
1707 Set boundary account numbers for the export. Only useful for a stammdaten export.
1708
1709 =item locked
1710
1711 Boolean if the transactions are locked (read-only in kivitenod) or not.
1712 Default value is false
1713
1714 =back
1715
1716 =head1 CONSTANTS
1717
1718 =head2 Supplied to L<exporttype>
1719
1720 =over 4
1721
1722 =item DATEV_ET_BUCHUNGEN
1723
1724 =item DATEV_ET_STAMM
1725
1726 =back
1727
1728 =head2 Supplied to L<format>.
1729
1730 =over 4
1731
1732 =item DATEV_FORMAT_KNE
1733
1734 =item DATEV_FORMAT_OBE
1735
1736 =back
1737
1738 =head1 ERROR HANDLING
1739
1740 This module will die in the following cases:
1741
1742 =over 4
1743
1744 =item *
1745
1746 No or unrecognized exporttype or format was provided for an export
1747
1748 =item *
1749
1750 OBE export was called, which is not yet implemented.
1751
1752 =item *
1753
1754 general I/O errors
1755
1756 =back
1757
1758 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1759
1760 =over 4
1761
1762 =item *
1763
1764 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1765
1766 =item *
1767
1768 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
1769 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1770
1771 =back
1772
1773 =head1 BUGS AND CAVEATS
1774
1775 =over 4
1776
1777 =item *
1778
1779 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1780
1781 =item *
1782
1783 OBE export is currently not implemented.
1784
1785 =back
1786
1787 =head1 TODO
1788
1789 - handling of export_path and download token is a bit dodgy, clean that up.
1790
1791 =head1 SEE ALSO
1792
1793 L<SL::DATEV::KNEFile>
1794 L<SL::DATEV::CSV>
1795
1796 =head1 AUTHORS
1797
1798 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1799
1800 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1801
1802 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1803
1804 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1805
1806 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
1807
1808 Stephan Köhler
1809
1810 =cut