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