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