SL/DATEV.pm

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