SL/DATEV.pm

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