1 #=====================================================================
 
   6 #   Email: p.reetz@linet-services.de
 
   7 #     Web: http://www.lx-office.org
 
  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.
 
  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 #======================================================================
 
  25 #======================================================================
 
  33 use SL::DATEV::KNEFile;
 
  38 use Exporter qw(import);
 
  40 use List::Util qw(max sum);
 
  41 use Time::HiRes qw(gettimeofday);
 
  46     DATEV_ET_BUCHUNGEN => $i++,
 
  47     DATEV_ET_STAMM     => $i++,
 
  49     DATEV_FORMAT_KNE   => $i++,
 
  50     DATEV_FORMAT_OBE   => $i++,
 
  54 my @export_constants = qw(DATEV_ET_BUCHUNGEN DATEV_ET_STAMM DATEV_FORMAT_KNE DATEV_FORMAT_OBE);
 
  55 our @EXPORT_OK = (@export_constants);
 
  56 our %EXPORT_TAGS = (CONSTANTS => [ @export_constants ]);
 
  63   my $obj = bless {}, $class;
 
  65   $obj->$_($data{$_}) for keys %data;
 
  72   $self->{exporttype} = $_[0] if @_;
 
  73   return $self->{exporttype};
 
  77   defined $_[0]->{exporttype};
 
  82   $self->{format} = $_[0] if @_;
 
  83   return $self->{format};
 
  87   defined $_[0]->{format};
 
  90 sub _get_export_path {
 
  91   $main::lxdebug->enter_sub();
 
  93   my ($a, $b) = gettimeofday();
 
  94   my $path    = _get_path_for_download_token("${a}-${b}-${$}");
 
  96   mkpath($path) unless (-d $path);
 
  98   $main::lxdebug->leave_sub();
 
 103 sub _get_path_for_download_token {
 
 104   $main::lxdebug->enter_sub();
 
 106   my $token = shift || '';
 
 109   if ($token =~ m|^(\d+)-(\d+)-(\d+)$|) {
 
 110     $path = $::lx_office_conf{paths}->{userspath} . "/datev-export-${1}-${2}-${3}/";
 
 113   $main::lxdebug->leave_sub();
 
 118 sub _get_download_token_for_path {
 
 119   $main::lxdebug->enter_sub();
 
 124   if ($path =~ m|.*datev-export-(\d+)-(\d+)-(\d+)/?$|) {
 
 125     $token = "${1}-${2}-${3}";
 
 128   $main::lxdebug->leave_sub();
 
 135   $self->{download_token} = $_[0] if @_;
 
 136   return $self->{download_token} ||= _get_download_token_for_path($self->export_path);
 
 142   return  $self->{export_path} ||= _get_path_for_download_token($self->{download_token}) || _get_export_path();
 
 147   push @{ $self->{filenames} ||= [] }, @_;
 
 151   return @{ $_[0]{filenames} || [] };
 
 156   push @{ $self->{errors} ||= [] }, @_;
 
 160   return @{ $_[0]{errors} || [] };
 
 163 sub add_net_gross_differences {
 
 165   push @{ $self->{net_gross_differences} ||= [] }, @_;
 
 168 sub net_gross_differences {
 
 169   return @{ $_[0]{net_gross_differences} || [] };
 
 172 sub sum_net_gross_differences {
 
 173   return sum $_[0]->net_gross_differences;
 
 180    $self->{from} = $_[0];
 
 183  return $self->{from};
 
 200     $self->{trans_id} = $_[0];
 
 203   die "illegal trans_id passed for DATEV export: " . $self->{trans_id} . "\n" unless $self->{trans_id} =~ m/^\d+$/;
 
 205   return $self->{trans_id};
 
 212    $self->{accnofrom} = $_[0];
 
 215  return $self->{accnofrom};
 
 222    $self->{accnoto} = $_[0];
 
 225  return $self->{accnoto};
 
 233     $self->{dbh} = $_[0];
 
 234     $self->{provided_dbh} = 1;
 
 237   $self->{dbh} ||= SL::DB->client->dbh;
 
 244 sub clean_temporary_directories {
 
 245   $::lxdebug->enter_sub;
 
 247   foreach my $path (glob($::lx_office_conf{paths}->{userspath} . "/datev-export-*")) {
 
 248     next unless -d $path;
 
 250     my $mtime = (stat($path))[9];
 
 251     next if ((time() - $mtime) < 8 * 60 * 60);
 
 256   $::lxdebug->leave_sub;
 
 260   $main::lxdebug->enter_sub();
 
 262   my $text      = shift // '';
 
 263   my $field_len = shift;
 
 264   my $fill_char = shift;
 
 265   my $alignment = shift || 'right';
 
 267   my $text_len  = length $text;
 
 269   if ($field_len < $text_len) {
 
 270     $text = substr $text, 0, $field_len;
 
 272   } elsif ($field_len > $text_len) {
 
 273     my $filler = ($fill_char) x ($field_len - $text_len);
 
 274     $text      = $alignment eq 'right' ? $filler . $text : $text . $filler;
 
 277   $main::lxdebug->leave_sub();
 
 282 sub get_datev_stamm {
 
 283   return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
 
 286 sub save_datev_stamm {
 
 287   my ($self, $data) = @_;
 
 289   SL::DB->client->with_transaction(sub {
 
 290     do_query($::form, $self->dbh, 'DELETE FROM datev');
 
 292     my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
 
 294     my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
 
 295     do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
 
 297   }) or do { die SL::DB->client->error };
 
 304   die 'no format set!' unless $self->has_format;
 
 306   if ($self->format == DATEV_FORMAT_KNE) {
 
 307     $result = $self->kne_export;
 
 308   } elsif ($self->format == DATEV_FORMAT_OBE) {
 
 309     $result = $self->obe_export;
 
 311     die 'unrecognized export format';
 
 321   die 'no exporttype set!' unless $self->has_exporttype;
 
 323   if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
 
 324     $result = $self->kne_buchungsexport;
 
 325   } elsif ($self->exporttype == DATEV_ET_STAMM) {
 
 326     $result = $self->kne_stammdatenexport;
 
 328     die 'unrecognized exporttype';
 
 335   die 'not yet implemented';
 
 341   return unless $self->from && $self->to;
 
 343   return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
 
 350 sub _get_transactions {
 
 351   $main::lxdebug->enter_sub();
 
 354   my $progress_callback = shift || sub {};
 
 356   my $form     =  $main::form;
 
 358   my $trans_id_filter = '';
 
 360   if ( $self->{trans_id} ) {
 
 361     # ignore dates when trans_id is passed so that the entire transaction is
 
 362     # checked, not just either the initial bookings or the subsequent payments
 
 363     # (the transdates will likely differ)
 
 365     $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
 
 367     $fromto      =~ s/transdate/ac\.transdate/g;
 
 372   my $filter   = '';            # Useful for debugging purposes
 
 374   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');
 
 377     qq|SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ar.id, ac.amount, ac.taxkey,
 
 378          ar.invnumber, ar.duedate, ar.amount as umsatz, ar.deliverydate,
 
 380          c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 
 385        LEFT JOIN ar          ON (ac.trans_id    = ar.id)
 
 386        LEFT JOIN customer ct ON (ar.customer_id = ct.id)
 
 387        LEFT JOIN chart c     ON (ac.chart_id    = c.id)
 
 388        LEFT JOIN tax t       ON (ac.tax_id      = t.id)
 
 389        WHERE (ar.id IS NOT NULL)
 
 396        SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,ap.id, ac.amount, ac.taxkey,
 
 397          ap.invnumber, ap.duedate, ap.amount as umsatz, ap.deliverydate,
 
 399          c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 
 404        LEFT JOIN ap        ON (ac.trans_id  = ap.id)
 
 405        LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
 
 406        LEFT JOIN chart c   ON (ac.chart_id  = c.id)
 
 407        LEFT JOIN tax t     ON (ac.tax_id    = t.id)
 
 408        WHERE (ap.id IS NOT NULL)
 
 415        SELECT ac.acc_trans_id, ac.transdate, ac.trans_id,gl.id, ac.amount, ac.taxkey,
 
 416          gl.reference AS invnumber, gl.transdate AS duedate, ac.amount as umsatz, NULL as deliverydate,
 
 417          gl.description AS name, NULL as ustid,
 
 418          c.accno, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
 
 423        LEFT JOIN gl      ON (ac.trans_id  = gl.id)
 
 424        LEFT JOIN chart c ON (ac.chart_id  = c.id)
 
 425        LEFT JOIN tax t   ON (ac.tax_id    = t.id)
 
 426        WHERE (gl.id IS NOT NULL)
 
 431        ORDER BY trans_id, acc_trans_id|;
 
 433   my $sth = prepare_execute_query($form, $self->dbh, $query);
 
 439   while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
 
 440     last unless $ref;  # for single transactions
 
 442     if (($counter % 500) == 0) {
 
 443       $progress_callback->($counter);
 
 446     my $trans    = [ $ref ];
 
 448     my $count    = $ref->{amount};
 
 451     # if the amount of a booking in a group is smaller than 0.02, any tax
 
 452     # amounts will likely be smaller than 1 cent, so go into subcent mode
 
 453     my $subcent  = abs($count) < 0.02;
 
 455     # records from acc_trans are ordered by trans_id and acc_trans_id
 
 456     # first check for unbalanced ledger inside one trans_id
 
 457     # there may be several groups inside a trans_id, e.g. the original booking and the payment
 
 458     # each group individually should be exactly balanced and each group
 
 459     # individually needs its own datev lines
 
 461     # keep fetching new acc_trans lines until the end of a balanced group is reached
 
 462     while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
 
 463       my $ref2 = $sth->fetchrow_hashref("NAME_lc");
 
 469       # check if trans_id of current acc_trans line is still the same as the
 
 470       # trans_id of the first line in group, i.e. we haven't finished a 0-group
 
 471       # before moving on to the next trans_id, error will likely be in the old
 
 474       if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
 
 475         require SL::DB::Manager::AccTransaction;
 
 476         if ( $trans->[0]->{trans_id} ) {
 
 477           my $acc_trans_old_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
 
 478           $self->add_error("Unbalanced ledger! Old: " . $acc_trans_old_obj->transaction_name) if ref($acc_trans_old_obj);
 
 480         if ( $ref2->{trans_id} ) {
 
 481           my $acc_trans_curr_obj = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $ref2->{trans_id} ]);
 
 482           $self->add_error("Unbalanced ledger! New:" . $acc_trans_curr_obj->transaction_name) if ref($acc_trans_curr_obj);
 
 484         $self->add_error("count: $count");
 
 488       push @{ $trans }, $ref2;
 
 490       $count    += $ref2->{amount};
 
 494     foreach my $i (0 .. scalar(@{ $trans }) - 1) {
 
 495       my $ref        = $trans->[$i];
 
 496       my $prev_ref   = 0 < $i ? $trans->[$i - 1] : undef;
 
 497       if (   $all_taxchart_ids{$ref->{id}}
 
 498           && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
 
 499           && (   ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
 
 500               || $ref->{invoice})) {
 
 504       if (   !$ref->{invoice}   # we have a non-invoice booking (=gl)
 
 505           &&  $ref->{is_tax}    # that has "is_tax" set
 
 506           && !($prev_ref->{is_tax})  # previous line wasn't is_tax
 
 507           &&  (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) {  # and sign same as previous sign
 
 508         $trans->[$i - 1]->{tax_amount} = $ref->{amount};
 
 513     if (scalar(@{$trans}) <= 2) {
 
 514       push @{ $self->{DATEV} }, $trans;
 
 518     # determine at which array position the reference value (called absumsatz) is
 
 519     # and which amount it has
 
 521     for my $j (0 .. (scalar(@{$trans}) - 1)) {
 
 524       # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
 
 526       # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
 
 527       # true, instead of absumsatz use link AR/AP (there should only be one
 
 530       # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
 
 531       # instead of absumsatz use link AR/AP (there should only be one, so jump
 
 532       # out of search as soon as you find it )
 
 535       # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
 
 536       # for ap/ar bookings we can always search for AR/AP in link and use that
 
 537       if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
 
 538          or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
 
 539         $absumsatz     = $trans->[$j]->{'amount'};
 
 544       # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
 
 545       # for AR and AP transaction exit the loop as soon as an AR or AP account is found
 
 546       # there must be only one AR or AP chart in the booking
 
 547       # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
 
 548       # manually pays an invoice in GL.
 
 549       if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
 
 550         $notsplitindex = $j;   # position in booking with highest amount
 
 551         $absumsatz     = $trans->[$j]->{'amount'};
 
 556     my $ml             = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
 
 557     my $rounding_error = 0;
 
 560     # go through each line and determine if it is a tax booking or not
 
 561     # skip all tax lines and notsplitindex line
 
 562     # push all other accounts (e.g. income or expense) with corresponding taxkey
 
 564     for my $j (0 .. (scalar(@{$trans}) - 1)) {
 
 565       if (   ($j != $notsplitindex)
 
 566           && !$trans->[$j]->{is_tax}
 
 567           && (   $trans->[$j]->{'taxkey'} eq ""
 
 568               || $trans->[$j]->{'taxkey'} eq "0"
 
 569               || $trans->[$j]->{'taxkey'} eq "1"
 
 570               || $trans->[$j]->{'taxkey'} eq "10"
 
 571               || $trans->[$j]->{'taxkey'} eq "11")) {
 
 573         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
 
 575         $absumsatz               += $trans->[$j]->{'amount'};
 
 576         $new_trans{'amount'}      = $trans->[$j]->{'amount'} * (-1);
 
 577         $new_trans{'umsatz'}      = abs($trans->[$j]->{'amount'}) * $ml;
 
 578         $trans->[$j]->{'umsatz'}  = abs($trans->[$j]->{'amount'}) * $ml;
 
 580         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
 
 582       } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
 
 585         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
 
 587         my $tax_rate              = $trans->[$j]->{'taxrate'};
 
 588         $new_trans{'net_amount'}  = $trans->[$j]->{'amount'} * -1;
 
 589         $new_trans{'tax_rate'}    = 1 + $tax_rate;
 
 591         if (!$trans->[$j]->{'invoice'}) {
 
 592           $new_trans{'amount'}      = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
 
 593           $new_trans{'umsatz'}      = abs($new_trans{'amount'}) * $ml;
 
 594           $trans->[$j]->{'umsatz'}  = $new_trans{'umsatz'};
 
 595           $absumsatz               += -1 * $new_trans{'amount'};
 
 598           my $unrounded             = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
 
 599           my $rounded               = $form->round_amount($unrounded, 2);
 
 601           $rounding_error           = $unrounded - $rounded;
 
 602           $new_trans{'amount'}      = $rounded;
 
 603           $new_trans{'umsatz'}      = abs($rounded) * $ml;
 
 604           $trans->[$j]->{'umsatz'}  = $new_trans{umsatz};
 
 605           $absumsatz               -= $rounded;
 
 608         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
 
 609         push @taxed, $self->{DATEV}->[-1];
 
 615     while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
 
 616       if ($idx >= scalar @taxed) {
 
 617         last if (!$correction);
 
 623       my $transaction = $taxed[$idx]->[0];
 
 625       my $old_amount     = $transaction->{amount};
 
 626       my $old_correction = $correction;
 
 629       if (!$transaction->{diff}) {
 
 630         @possible_diffs = (0.01, -0.01);
 
 632         @possible_diffs = ($transaction->{diff});
 
 635       foreach my $diff (@possible_diffs) {
 
 636         my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
 
 637         next if ($net_amount != $transaction->{net_amount});
 
 639         $transaction->{diff}    = $diff;
 
 640         $transaction->{amount} += $diff;
 
 641         $transaction->{umsatz} += $diff;
 
 651     $absumsatz = $form->round_amount($absumsatz, 2);
 
 652     if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
 
 653       require SL::DB::Manager::AccTransaction;
 
 654       my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
 
 655       $self->add_error("Datev-Export fehlgeschlagen! Bei Transaktion " . $acc_trans_obj->transaction_name . " ($absumsatz)");
 
 657     } elsif (abs($absumsatz) >= 0.01) {
 
 658       $self->add_net_gross_differences($absumsatz);
 
 664   $::lxdebug->leave_sub;
 
 667 sub make_kne_data_header {
 
 668   $main::lxdebug->enter_sub();
 
 670   my ($self, $form) = @_;
 
 673   my $stamm = $self->get_datev_stamm;
 
 675   my $jahr = $self->from ? $self->from->year : DateTime->today->year;
 
 678   my $header  = "\x1D\x181";
 
 679   $header    .= _fill($stamm->{datentraegernr}, 3, ' ', 'left');
 
 680   $header    .= ($self->fromto) ? "11" : "13"; # Anwendungsnummer
 
 681   $header    .= _fill($stamm->{dfvkz}, 2, '0');
 
 682   $header    .= _fill($stamm->{beraternr}, 7, '0');
 
 683   $header    .= _fill($stamm->{mandantennr}, 5, '0');
 
 684   $header    .= _fill(($stamm->{abrechnungsnr} // '') . $jahr, 6, '0');
 
 686   $header .= $self->from ? $self->from->strftime('%d%m%y') : '';
 
 687   $header .= $self->to   ? $self->to->strftime('%d%m%y')   : '';
 
 691     $header .= $primanota;
 
 694   $header .= _fill($stamm->{passwort}, 4, '0');
 
 695   $header .= " " x 16;       # Anwendungsinfo
 
 696   $header .= " " x 16;       # Inputinfo
 
 700   my $versionssatz  = $self->exporttype == DATEV_ET_BUCHUNGEN ? "\xB5" . "1," : "\xB6" . "1,";
 
 702   my $query         = qq|SELECT accno FROM chart LIMIT 1|;
 
 703   my $ref           = selectfirst_hashref_query($form, $self->dbh, $query);
 
 705   $versionssatz    .= length $ref->{accno};
 
 706   $versionssatz    .= ",";
 
 707   $versionssatz    .= length $ref->{accno};
 
 708   $versionssatz    .= ",SELF" . "\x1C\x79";
 
 710   $header          .= $versionssatz;
 
 712   $main::lxdebug->leave_sub();
 
 718   $main::lxdebug->enter_sub();
 
 720   my ($date, $six) = @_;
 
 722   my ($day, $month, $year) = split(/\./, $date);
 
 725     $day = substr($day, 1, 1);
 
 727   if (length($month) < 2) {
 
 728     $month = "0" . $month;
 
 730   if (length($year) > 2) {
 
 731     $year = substr($year, -2, 2);
 
 735     $date = $day . $month . $year;
 
 737     $date = $day . $month;
 
 740   $main::lxdebug->leave_sub();
 
 745 sub trim_leading_zeroes {
 
 753 sub make_ed_versionset {
 
 754   $main::lxdebug->enter_sub();
 
 756   my ($self, $header, $filename, $blockcount) = @_;
 
 758   my $versionset  = "V" . substr($filename, 2, 5);
 
 759   $versionset    .= substr($header, 6, 22);
 
 762     $versionset .= "0000" . substr($header, 28, 19);
 
 764     my $datum = " " x 16;
 
 765     $versionset .= $datum . "001" . substr($header, 28, 4);
 
 768   $versionset .= _fill($blockcount, 5, '0');
 
 769   $versionset .= "001";
 
 771   $versionset .= substr($header, -12, 10) . "    ";
 
 772   $versionset .= " " x 53;
 
 774   $main::lxdebug->leave_sub();
 
 780   $main::lxdebug->enter_sub();
 
 782   my ($self, $form, $fileno) = @_;
 
 784   my $stamm = $self->get_datev_stamm;
 
 786   my $ev_header  = _fill($stamm->{datentraegernr}, 3, ' ', 'left');
 
 788   $ev_header    .= _fill($stamm->{beraternr}, 7, ' ', 'left');
 
 789   $ev_header    .= _fill($stamm->{beratername}, 9, ' ', 'left');
 
 791   $ev_header    .= (_fill($fileno, 5, '0')) x 2;
 
 792   $ev_header    .= " " x 95;
 
 794   $main::lxdebug->leave_sub();
 
 799 sub kne_buchungsexport {
 
 800   $main::lxdebug->enter_sub();
 
 808   my $filename    = "ED00000";
 
 813   my $fromto = $self->fromto;
 
 815   $self->_get_transactions($fromto);
 
 817   return if $self->errors;
 
 821   while (scalar(@{ $self->{DATEV} || [] })) {
 
 824     my $ed_filename = $self->export_path . $filename;
 
 825     push(@filenames, $filename);
 
 826     my $header = $self->make_kne_data_header($form);
 
 828     my $kne_file = SL::DATEV::KNEFile->new();
 
 829     $kne_file->add_block($header);
 
 831     while (scalar(@{ $self->{DATEV} }) > 0) {
 
 832       my $transaction = shift @{ $self->{DATEV} };
 
 833       my $trans_lines = scalar(@{$transaction});
 
 842       my $buchungstext   = "";
 
 844       my $datevautomatik = 0;
 
 849       my $iconv          = $::locale->{iconv_utf8};
 
 850       my %umlaute = ($iconv->convert('ä') => 'ae',
 
 851                      $iconv->convert('ö') => 'oe',
 
 852                      $iconv->convert('ü') => 'ue',
 
 853                      $iconv->convert('Ä') => 'Ae',
 
 854                      $iconv->convert('Ö') => 'Oe',
 
 855                      $iconv->convert('Ü') => 'Ue',
 
 856                      $iconv->convert('ß') => 'sz');
 
 857       for (my $i = 0; $i < $trans_lines; $i++) {
 
 858         if ($trans_lines == 2) {
 
 859           if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
 
 860             $umsatz = $transaction->[$i]->{'amount'};
 
 863           if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
 
 864             $umsatz = $transaction->[$i]->{'umsatz'};
 
 867         if ($transaction->[$i]->{'datevautomatik'}) {
 
 870         if ($transaction->[$i]->{'taxkey'}) {
 
 871           $taxkey = $transaction->[$i]->{'taxkey'};
 
 873         if ($transaction->[$i]->{'charttax'}) {
 
 874           $charttax = $transaction->[$i]->{'charttax'};
 
 876         if ($transaction->[$i]->{'amount'} > 0) {
 
 882       # Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
 
 883       foreach my $umlaut (keys(%umlaute)) {
 
 884         $transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
 
 885         $transaction->[$haben]->{'name'}      =~ s/${umlaut}/${umlaute{$umlaut}}/g;
 
 888       $transaction->[$haben]->{'invnumber'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
 
 889       $transaction->[$haben]->{'name'}      =~ s/[^0-9A-Za-z\$\%\&\*\+\-\ \/]//g;
 
 891       $transaction->[$haben]->{'invnumber'} =  substr($transaction->[$haben]->{'invnumber'}, 0, 12);
 
 892       $transaction->[$haben]->{'name'}      =  substr($transaction->[$haben]->{'name'}, 0, 30);
 
 893       $transaction->[$haben]->{'invnumber'} =~ s/\ *$//;
 
 894       $transaction->[$haben]->{'name'}      =~ s/\ *$//;
 
 896       if ($trans_lines >= 2) {
 
 898         $gegenkonto = "a" . trim_leading_zeroes($transaction->[$haben]->{'accno'});
 
 899         $konto      = "e" . trim_leading_zeroes($transaction->[$soll]->{'accno'});
 
 900         if ($transaction->[$haben]->{'invnumber'} ne "") {
 
 901           $belegfeld1 = "\xBD" . $transaction->[$haben]->{'invnumber'} . "\x1C";
 
 904         $datum .= &datetofour($transaction->[$haben]->{'transdate'}, 0);
 
 905         $waehrung = "\xB3" . "EUR" . "\x1C";
 
 906         if ($transaction->[$haben]->{'name'} ne "") {
 
 907           $buchungstext = "\x1E" . $transaction->[$haben]->{'name'} . "\x1C";
 
 909         if (($transaction->[$haben]->{'ustid'} // '') ne "") {
 
 910           $ustid = "\xBA" . $transaction->[$haben]->{'ustid'} . "\x1C";
 
 912         if (($transaction->[$haben]->{'duedate'} // '') ne "") {
 
 913           $belegfeld2 = "\xBE" . &datetofour($transaction->[$haben]->{'duedate'}, 1) . "\x1C";
 
 917       $umsatz       = $kne_file->format_amount(abs($umsatz), 0);
 
 918       $umsatzsumme += $umsatz;
 
 919       $kne_file->add_block("+" . $umsatz);
 
 921       # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
 
 922       # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
 
 923       # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
 
 924       # Skript angelegt werden.
 
 925       # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
 
 926       # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
 
 927       # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
 
 928       # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
 
 929       # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
 
 931       if (   ( $datevautomatik || $taxkey)
 
 932           && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
 
 933 #         $kne_file->add_block("\x6C" . (!$datevautomatik ? $taxkey : "4"));
 
 934         $kne_file->add_block("\x6C${taxkey}");
 
 937       $kne_file->add_block($gegenkonto);
 
 938       $kne_file->add_block($belegfeld1);
 
 939       $kne_file->add_block($belegfeld2);
 
 940       $kne_file->add_block($datum);
 
 941       $kne_file->add_block($konto);
 
 942       $kne_file->add_block($buchungstext);
 
 943       $kne_file->add_block($ustid);
 
 944       $kne_file->add_block($waehrung . "\x79");
 
 947     my $mandantenendsumme = "x" . $kne_file->format_amount($umsatzsumme / 100.0, 14) . "\x79\x7a";
 
 949     $kne_file->add_block($mandantenendsumme);
 
 952     open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
 
 953     print(ED $kne_file->get_data());
 
 956     $ed_versionset[$fileno] = $self->make_ed_versionset($header, $filename, $kne_file->get_block_count());
 
 960   #Make EV Verwaltungsdatei
 
 961   my $ev_header = $self->make_ev_header($form, $fileno);
 
 962   my $ev_filename = $self->export_path . $evfile;
 
 963   push(@filenames, $evfile);
 
 964   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
 
 965   print(EV $ev_header);
 
 967   foreach my $file (@ed_versionset) {
 
 973   $self->add_filenames(@filenames);
 
 975   $main::lxdebug->leave_sub();
 
 977   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
 
 980 sub kne_stammdatenexport {
 
 981   $main::lxdebug->enter_sub();
 
 986   $self->get_datev_stamm->{abrechnungsnr} = "99";
 
 990   my $filename    = "ED00000";
 
 996   my $remaining_bytes = 256;
 
 997   my $total_bytes     = 256;
 
 998   my $buchungssatz    = "";
 
1000   my $ed_filename = $self->export_path . $filename;
 
1001   push(@filenames, $filename);
 
1002   open(ED, ">", $ed_filename) or die "can't open outputfile: $!\n";
 
1003   my $header = $self->make_kne_data_header($form);
 
1004   $remaining_bytes -= length($header);
 
1008   my (@where, @values) = ((), ());
 
1009   if ($self->accnofrom) {
 
1010     push @where, 'c.accno >= ?';
 
1011     push @values, $self->accnofrom;
 
1013   if ($self->accnoto) {
 
1014     push @where, 'c.accno <= ?';
 
1015     push @values, $self->accnoto;
 
1018   my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
 
1020   my $query     = qq|SELECT c.accno, c.description
 
1025   my $sth = $self->dbh->prepare($query);
 
1026   $sth->execute(@values) || $form->dberror($query);
 
1028   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 
1029     if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
 
1030       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
 
1031       $buchungssatz .= "\x00" x $fuellzeichen;
 
1033       $total_bytes = ($blockcount) * 256;
 
1035     $buchungssatz .= "t" . $ref->{'accno'};
 
1036     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
 
1037     $ref->{'description'} =~ s/[^0-9A-Za-z\$\%\&\*\+\-\/]//g;
 
1038     $ref->{'description'} = substr($ref->{'description'}, 0, 40);
 
1039     $ref->{'description'} =~ s/\ *$//;
 
1042         ($remaining_bytes - length("\x1E" . $ref->{'description'} . "\x1C\x79")
 
1045       $fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
 
1046       $buchungssatz .= "\x00" x $fuellzeichen;
 
1048       $total_bytes = ($blockcount) * 256;
 
1050     $buchungssatz .= "\x1E" . $ref->{'description'} . "\x1C\x79";
 
1051     $remaining_bytes = $total_bytes - length($buchungssatz . $header);
 
1056   print(ED $buchungssatz);
 
1057   $fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
 
1058   my $dateiende = "\x00" x $fuellzeichen;
 
1060   print(ED $dateiende);
 
1063   #Make EV Verwaltungsdatei
 
1065     $self->make_ed_versionset($header, $filename, $blockcount);
 
1067   my $ev_header = $self->make_ev_header($form, $fileno);
 
1068   my $ev_filename = $self->export_path . $evfile;
 
1069   push(@filenames, $evfile);
 
1070   open(EV, ">", $ev_filename) or die "can't open outputfile: EV01\n";
 
1071   print(EV $ev_header);
 
1073   foreach my $file (@ed_versionset) {
 
1074     print(EV $ed_versionset[$file]);
 
1078   $self->add_filenames(@filenames);
 
1080   $main::lxdebug->leave_sub();
 
1082   return { 'download_token' => $self->download_token, 'filenames' => \@filenames };
 
1086   clean_temporary_directories();
 
1097 SL::DATEV - kivitendo DATEV Export module
 
1101   use SL::DATEV qw(:CONSTANTS);
 
1103   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
 
1104   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
 
1105   my $datev = SL::DATEV->new(
 
1106     exporttype => DATEV_ET_BUCHUNGEN,
 
1107     format     => DATEV_FORMAT_KNE,
 
1112   # To only export transactions from a specific trans_id: (from and to are ignored)
 
1113   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
 
1114   my $datev = SL::DATEV->new(
 
1115     exporttype => DATEV_ET_BUCHUNGEN,
 
1116     format     => DATEV_FORMAT_KNE,
 
1117     trans_id   => $invoice->trans_id,
 
1120   my $datev = SL::DATEV->new(
 
1121     exporttype => DATEV_ET_STAMM,
 
1122     format     => DATEV_FORMAT_KNE,
 
1123     accnofrom  => $start_account_number,
 
1124     accnoto    => $end_account_number,
 
1127   # get or set datev stamm
 
1128   my $hashref = $datev->get_datev_stamm;
 
1129   $datev->save_datev_stamm($hashref);
 
1131   # manually clean up temporary directories older than 8 hours
 
1132   $datev->clean_temporary_directories;
 
1137   if ($datev->errors) {
 
1138     die join "\n", $datev->error;
 
1141   # get relevant data for saving the export:
 
1142   my $dl_token = $datev->download_token;
 
1143   my $path     = $datev->export_path;
 
1144   my @files    = $datev->filenames;
 
1146   # retrieving an export at a later time
 
1147   my $datev = SL::DATEV->new(
 
1148     download_token => $dl_token_from_user,
 
1151   my $path     = $datev->export_path;
 
1152   my @files    = glob("$path/*");
 
1156 This module implements the DATEV export standard. For usage see above.
 
1164 Generic constructor. See section attributes for information about what to pass.
 
1166 =item get_datev_stamm
 
1168 Loads DATEV Stammdaten and returns as hashref.
 
1170 =item save_datev_stamm HASHREF
 
1172 Saves DATEV Stammdaten from provided hashref.
 
1176 See L<CONSTANTS> for possible values
 
1178 =item has_exporttype
 
1180 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
 
1184 Specifies the designated format of the export. Currently only KNE export is implemented.
 
1186 See L<CONSTANTS> for possible values
 
1190 Returns true if a format has been set. Without format most report functions won't work.
 
1192 =item download_token
 
1194 Returns a download token for this DATEV object.
 
1196 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
 
1200 Returns an export_path for this DATEV object.
 
1202 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
 
1206 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.
 
1208 =item net_gross_differences
 
1210 If there were any net gross differences during calculation they will be collected here.
 
1212 =item sum_net_gross_differences
 
1214 Sum of all differences.
 
1216 =item clean_temporary_directories
 
1218 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.
 
1222 Returns a list of errors that occured. If no errors occured, the export was a success.
 
1226 Exports data. You have to have set L<exporttype> and L<format> or an error will
 
1227 occur. OBE exports are currently not implemented.
 
1233 This is a list of attributes set in either the C<new> or a method of the same name.
 
1239 Set a database handle to use in the process. This allows for an export to be
 
1240 done on a transaction in progress without committing first.
 
1242 Note: If you don't want this code to commit, simply providing a dbh is not
 
1243 enough enymore. You'll have to wrap the call into a transaction yourself, so
 
1244 that the internal transaction does not commit.
 
1248 See L<CONSTANTS> for possible values. This MUST be set before export is called.
 
1252 See L<CONSTANTS> for possible values. This MUST be set before export is called.
 
1254 =item download_token
 
1256 Can be set on creation to retrieve a prior export for download.
 
1262 Set boundary dates for the export. Unless a trans_id is passed these MUST be
 
1263 set for the export to work.
 
1267 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
 
1268 L<from> and L<to> are currently still needed for the query to be assembled
 
1275 Set boundary account numbers for the export. Only useful for a stammdaten export.
 
1281 =head2 Supplied to L<exporttype>
 
1285 =item DATEV_ET_BUCHUNGEN
 
1287 =item DATEV_ET_STAMM
 
1291 =head2 Supplied to L<format>.
 
1295 =item DATEV_FORMAT_KNE
 
1297 =item DATEV_FORMAT_OBE
 
1301 =head1 ERROR HANDLING
 
1303 This module will die in the following cases:
 
1309 No or unrecognized exporttype or format was provided for an export
 
1313 OBE export was called, which is not yet implemented.
 
1321 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
 
1327 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
 
1331 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
 
1332 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
 
1336 =head1 BUGS AND CAVEATS
 
1342 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
 
1346 OBE export is currently not implemented.
 
1352 - handling of export_path and download token is a bit dodgy, clean that up.
 
1356 L<SL::DATEV::KNEFile>
 
1360 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
 
1362 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 
1364 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
 
1366 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
 
1368 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,