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