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