epic-s6ts
[kivitendo-erp.git] / 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::CSV;
35 use SL::DB;
36 use SL::HTML::Util ();
37 use SL::Iconv;
38 use SL::Locale::String qw(t8);
39 use SL::VATIDNr;
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 get_datev_stamm {
291   return $_[0]{stamm} ||= selectfirst_hashref_query($::form, $_[0]->dbh, 'SELECT * FROM datev');
292 }
293
294 sub save_datev_stamm {
295   my ($self, $data) = @_;
296
297   SL::DB->client->with_transaction(sub {
298     do_query($::form, $self->dbh, 'DELETE FROM datev');
299
300     my @columns = qw(beraternr beratername dfvkz mandantennr datentraegernr abrechnungsnr);
301
302     my $query = "INSERT INTO datev (" . join(', ', @columns) . ") VALUES (" . join(', ', ('?') x @columns) . ")";
303     do_query($::form, $self->dbh, $query, map { $data->{$_} } @columns);
304     1;
305   }) or do { die SL::DB->client->error };
306 }
307
308 sub export {
309   my ($self) = @_;
310
311   return $self->csv_export;
312 }
313
314 sub csv_export {
315   my ($self) = @_;
316   my $result;
317
318   die 'no exporttype set!' unless $self->has_exporttype;
319
320   if ($self->exporttype == DATEV_ET_BUCHUNGEN) {
321
322     $self->generate_datev_data(from_to => $self->fromto);
323     return if $self->errors;
324
325     my $datev_csv = SL::DATEV::CSV->new(
326       datev_lines  => $self->generate_datev_lines,
327       from         => $self->from,
328       to           => $self->to,
329       locked       => $self->locked,
330     );
331
332
333     my $filename = "EXTF_DATEV_kivitendo" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
334
335     my $csv = Text::CSV_XS->new({
336                 binary       => 1,
337                 sep_char     => ";",
338                 always_quote => 1,
339                 eol          => "\r\n",
340               }) or die "Cannot use CSV: ".Text::CSV_XS->error_diag();
341
342     # get encoding from defaults - use cp1252 if DATEV strict export is used
343     my $enc = ($::instance_conf->get_datev_export_format eq 'cp1252') ? 'cp1252' : 'utf-8';
344     my $csv_file = IO::File->new($self->export_path . '/' . $filename, ">:encoding($enc)") or die "Can't open: $!";
345
346     $csv->print($csv_file, $_) for @{ $datev_csv->header };
347     $csv->print($csv_file, $_) for @{ $datev_csv->lines  };
348     $csv_file->close;
349     $self->{warnings} = $datev_csv->warnings;
350
351     # convert utf-8 to cp1252//translit if set
352     if ($::instance_conf->get_datev_export_format eq 'cp1252-translit') {
353
354       my $filename_translit = "EXTF_DATEV_kivitendo_translit" . $self->from->ymd() . '-' . $self->to->ymd() . ".csv";
355       open my $fh_in,  '<:encoding(UTF-8)',  $self->export_path . '/' . $filename or die "could not open $filename for reading: $!";
356       open my $fh_out, '>', $self->export_path . '/' . $filename_translit         or die "could not open $filename_translit for writing: $!";
357
358       my $converter = SL::Iconv->new("utf-8", "cp1252//translit");
359
360       print $fh_out $converter->convert($_) while <$fh_in>;
361       close $fh_in;
362       close $fh_out;
363
364       unlink $self->export_path . '/' . $filename or warn "Could not unlink $filename: $!";
365       $filename = $filename_translit;
366     }
367
368     return { download_token => $self->download_token, filenames => $filename };
369
370   } else {
371     die 'unrecognized exporttype';
372   }
373
374   return $result;
375 }
376
377 sub fromto {
378   my ($self) = @_;
379
380   return unless $self->from && $self->to;
381
382   return "transdate >= '" . $self->from->to_lxoffice . "' and transdate <= '" . $self->to->to_lxoffice . "'";
383 }
384
385 sub _sign {
386   $_[0] <=> 0;
387 }
388
389 sub locked {
390  my $self = shift;
391
392  if (@_) {
393    $self->{locked} = $_[0];
394  }
395  return $self->{locked};
396 }
397 sub imported {
398  my $self = shift;
399
400  if (@_) {
401    $self->{imported} = $_[0];
402  }
403  return $self->{imported};
404 }
405
406 sub generate_datev_data {
407   $main::lxdebug->enter_sub();
408
409   my ($self, %params)   = @_;
410   my $fromto            = $params{from_to} // '';
411   my $progress_callback = $params{progress_callback} || sub {};
412
413   my $form     =  $main::form;
414
415   my $trans_id_filter = '';
416   my $ar_department_id_filter = '';
417   my $ap_department_id_filter = '';
418   my $gl_department_id_filter = '';
419   if ( $form->{department_id} ) {
420     $ar_department_id_filter = " AND ar.department_id = ? ";
421     $ap_department_id_filter = " AND ap.department_id = ? ";
422     $gl_department_id_filter = " AND gl.department_id = ? ";
423   }
424
425   my ($gl_itime_filter, $ar_itime_filter, $ap_itime_filter);
426   if ( $form->{gldatefrom} ) {
427     $gl_itime_filter = " AND gl.itime >= ? ";
428     $ar_itime_filter = " AND ar.itime >= ? ";
429     $ap_itime_filter = " AND ap.itime >= ? ";
430   } else {
431     $gl_itime_filter = "";
432     $ar_itime_filter = "";
433     $ap_itime_filter = "";
434   }
435
436   if ( $self->{trans_id} ) {
437     # ignore dates when trans_id is passed so that the entire transaction is
438     # checked, not just either the initial bookings or the subsequent payments
439     # (the transdates will likely differ)
440     $fromto = '';
441     $trans_id_filter = 'ac.trans_id = ' . $self->trans_id;
442   } else {
443     $fromto      =~ s/transdate/ac\.transdate/g;
444   };
445
446   my ($notsplitindex);
447
448   my $filter   = '';            # Useful for debugging purposes
449
450   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');
451
452   my $ar_accno = "c.accno";
453   my $ap_accno = "c.accno";
454   if ( $self->use_pk ) {
455     $ar_accno = "CASE WHEN ac.chart_link = 'AR' THEN ct.customernumber ELSE c.accno END as accno";
456     $ap_accno = "CASE WHEN ac.chart_link = 'AP' THEN ct.vendornumber   ELSE c.accno END as accno";
457   }
458   my $gl_imported;
459   if ( !$self->imported ) {
460     $gl_imported = " AND NOT imported";
461   }
462
463   my $query    =
464     qq|SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ar.id, ac.amount, ac.taxkey, ac.memo,
465          ar.invnumber, ar.duedate, ar.amount as umsatz, COALESCE(ar.tax_point, ar.deliverydate) AS deliverydate, ar.itime::date,
466          ct.name, ct.ustid, ct.customernumber AS vcnumber, ct.id AS customer_id, NULL AS vendor_id,
467          $ar_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
468          ar.invoice,
469          t.rate AS taxrate, t.taxdescription,
470          'ar' as table,
471          tc.accno AS tax_accno, tc.description AS tax_accname,
472          ar.department_id,
473          ar.notes,
474          project.projectnumber as projectnumber, project.description as projectdescription,
475          department.description as departmentdescription
476        FROM acc_trans ac
477        LEFT JOIN ar          ON (ac.trans_id    = ar.id)
478        LEFT JOIN customer ct ON (ar.customer_id = ct.id)
479        LEFT JOIN chart c     ON (ac.chart_id    = c.id)
480        LEFT JOIN tax t       ON (ac.tax_id      = t.id)
481        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
482        LEFT JOIN department  ON (department.id  = ar.department_id)
483        LEFT JOIN project     ON (project.id     = ar.globalproject_id)
484        WHERE (ar.id IS NOT NULL)
485          AND $fromto
486          $trans_id_filter
487          $ar_itime_filter
488          $ar_department_id_filter
489          $filter
490
491        UNION ALL
492
493        SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,ap.id, ac.amount, ac.taxkey, ac.memo,
494          ap.invnumber, ap.duedate, ap.amount as umsatz, COALESCE(ap.tax_point, ap.deliverydate) AS deliverydate, ap.itime::date,
495          ct.name, ct.ustid, ct.vendornumber AS vcnumber, NULL AS customer_id, ct.id AS vendor_id,
496          $ap_accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
497          ap.invoice,
498          t.rate AS taxrate, t.taxdescription,
499          'ap' as table,
500          tc.accno AS tax_accno, tc.description AS tax_accname,
501          ap.department_id,
502          ap.notes,
503          project.projectnumber as projectnumber, project.description as projectdescription,
504          department.description as departmentdescription
505        FROM acc_trans ac
506        LEFT JOIN ap        ON (ac.trans_id  = ap.id)
507        LEFT JOIN vendor ct ON (ap.vendor_id = ct.id)
508        LEFT JOIN chart c   ON (ac.chart_id  = c.id)
509        LEFT JOIN tax t     ON (ac.tax_id    = t.id)
510        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
511        LEFT JOIN department  ON (department.id  = ap.department_id)
512        LEFT JOIN project     ON (project.id     = ap.globalproject_id)
513        WHERE (ap.id IS NOT NULL)
514          AND $fromto
515          $trans_id_filter
516          $ap_itime_filter
517          $ap_department_id_filter
518          $filter
519
520        UNION ALL
521
522        SELECT ac.acc_trans_id, ac.transdate, ac.gldate, ac.trans_id,gl.id, ac.amount, ac.taxkey, ac.memo,
523          gl.reference AS invnumber, NULL AS duedate, ac.amount as umsatz, COALESCE(gl.tax_point, gl.deliverydate) AS deliverydate, gl.itime::date,
524          gl.description AS name, NULL as ustid, '' AS vcname, NULL AS customer_id, NULL AS vendor_id,
525          c.accno, c.description AS accname, c.taxkey_id as charttax, c.datevautomatik, c.id, ac.chart_link AS link,
526          FALSE AS invoice,
527          t.rate AS taxrate, t.taxdescription,
528          'gl' as table,
529          tc.accno AS tax_accno, tc.description AS tax_accname,
530          gl.department_id,
531          gl.notes,
532          '' as projectnumber, '' as projectdescription,
533          department.description as departmentdescription
534        FROM acc_trans ac
535        LEFT JOIN gl      ON (ac.trans_id  = gl.id)
536        LEFT JOIN chart c ON (ac.chart_id  = c.id)
537        LEFT JOIN tax t   ON (ac.tax_id    = t.id)
538        LEFT JOIN chart tc    ON (t.chart_id     = tc.id)
539        LEFT JOIN department  ON (department.id  = gl.department_id)
540        WHERE (gl.id IS NOT NULL)
541          AND $fromto
542          $trans_id_filter
543          $gl_itime_filter
544          $gl_department_id_filter
545          $gl_imported
546          AND NOT EXISTS (SELECT gl_id from ap_gl where gl_id = gl.id)
547          $filter
548
549        ORDER BY trans_id, acc_trans_id|;
550
551   my @query_args;
552   if ( $form->{gldatefrom} or $form->{department_id} ) {
553
554     for ( 1 .. 3 ) {
555       if ( $form->{gldatefrom} ) {
556         my $glfromdate = $::locale->parse_date_to_object($form->{gldatefrom});
557         die "illegal data" unless ref($glfromdate) eq 'DateTime';
558         push(@query_args, $glfromdate);
559       }
560       if ( $form->{department_id} ) {
561         push(@query_args, $form->{department_id});
562       }
563     }
564   }
565
566   my $sth = prepare_execute_query($form, $self->dbh, $query, @query_args);
567   $self->{DATEV} = [];
568
569   my $counter = 0;
570   my $continue = 1; #
571   my $name;
572   while ( $continue && (my $ref = $sth->fetchrow_hashref("NAME_lc")) ) {
573     last unless $ref;  # for single transactions
574     $counter++;
575     if (($counter % 500) == 0) {
576       $progress_callback->($counter);
577     }
578
579     my $trans    = [ $ref ];
580
581     my $count    = $ref->{amount};
582     my $firstrun = 1;
583
584     # if the amount of a booking in a group is smaller than 0.02, any tax
585     # amounts will likely be smaller than 1 cent, so go into subcent mode
586     my $subcent  = abs($count) < 0.02;
587
588     # records from acc_trans are ordered by trans_id and acc_trans_id
589     # first check for unbalanced ledger inside one trans_id
590     # there may be several groups inside a trans_id, e.g. the original booking and the payment
591     # each group individually should be exactly balanced and each group
592     # individually needs its own datev lines
593
594     # keep fetching new acc_trans lines until the end of a balanced group is reached
595     while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) {
596       my $ref2 = $sth->fetchrow_hashref("NAME_lc");
597       unless ( $ref2 ) {
598         $continue = 0;
599         last;
600       };
601
602       # check if trans_id of current acc_trans line is still the same as the
603       # trans_id of the first line in group, i.e. we haven't finished a 0-group
604       # before moving on to the next trans_id, error will likely be in the old
605       # trans_id.
606
607       if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
608         require SL::DB::Manager::AccTransaction;
609         if ( $trans->[0]->{trans_id} ) {
610           my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
611           $self->add_error(t8("Export error in transaction #1: Unbalanced ledger before next transaction (#2)",
612                               $acc_trans_obj->transaction_name, $ref2->{trans_id})
613           );
614         };
615         return;
616       }
617
618       push @{ $trans }, $ref2;
619
620       $count    += $ref2->{amount};
621       $firstrun  = 0;
622     }
623
624     foreach my $i (0 .. scalar(@{ $trans }) - 1) {
625       my $ref        = $trans->[$i];
626       my $prev_ref   = 0 < $i ? $trans->[$i - 1] : undef;
627       if (   $all_taxchart_ids{$ref->{id}}
628           && ($ref->{link} =~ m/(?:AP_tax|AR_tax)/)
629           && (   ($prev_ref && $prev_ref->{taxkey} && (_sign($ref->{amount}) == _sign($prev_ref->{amount})))
630               || $ref->{invoice})) {
631         $ref->{is_tax} = 1;
632       }
633
634       if (   !$ref->{invoice}   # we have a non-invoice booking (=gl)
635           &&  $ref->{is_tax}    # that has "is_tax" set
636           && !($prev_ref->{is_tax})  # previous line wasn't is_tax
637           &&  (_sign($ref->{amount}) == _sign($prev_ref->{amount}))) {  # and sign same as previous sign
638         $trans->[$i - 1]->{tax_amount} = $ref->{amount};
639       }
640     }
641
642     my $absumsatz     = 0;
643     if (scalar(@{$trans}) <= 2) {
644       push @{ $self->{DATEV} }, $trans;
645       next;
646     }
647
648     # determine at which array position the reference value (called absumsatz) is
649     # and which amount it has
650
651     for my $j (0 .. (scalar(@{$trans}) - 1)) {
652
653       # Three cases:
654       # 1: gl transaction (Dialogbuchung), invoice is false, no double split booking allowed
655
656       # 2: sales or vendor invoice (Verkaufs- und Einkaufsrechnung): invoice is
657       # true, instead of absumsatz use link AR/AP (there should only be one
658       # entry)
659
660       # 3. AR/AP transaction (Kreditoren- und Debitorenbuchung): invoice is false,
661       # instead of absumsatz use link AR/AP (there should only be one, so jump
662       # out of search as soon as you find it )
663
664       # case 1 and 2
665       # for gl-bookings no split is allowed and there is no AR/AP account, so we always use the maximum value as a reference
666       # for ap/ar bookings we can always search for AR/AP in link and use that
667       if ( ( not $trans->[$j]->{'invoice'} and abs($trans->[$j]->{'amount'}) > abs($absumsatz) )
668          or ($trans->[$j]->{'invoice'} and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP'))) {
669         $absumsatz     = $trans->[$j]->{'amount'};
670         $notsplitindex = $j;
671       }
672
673       # case 3
674       # Problem: we can't distinguish between AR and AP and normal invoices via boolean "invoice"
675       # for AR and AP transaction exit the loop as soon as an AR or AP account is found
676       # there must be only one AR or AP chart in the booking
677       # since it is possible to do this kind of things with GL too, make sure those don't get aborted in case someone
678       # manually pays an invoice in GL.
679       if ($trans->[$j]->{table} ne 'gl' and ($trans->[$j]->{'link'} eq 'AR' or $trans->[$j]->{'link'} eq 'AP')) {
680         $notsplitindex = $j;   # position in booking with highest amount
681         $absumsatz     = $trans->[$j]->{'amount'};
682         last;
683       };
684     }
685
686     my $ml             = ($trans->[0]->{'umsatz'} > 0) ? 1 : -1;
687     my $rounding_error = 0;
688     my @taxed;
689
690     # go through each line and determine if it is a tax booking or not
691     # skip all tax lines and notsplitindex line
692     # push all other accounts (e.g. income or expense) with corresponding taxkey
693
694     for my $j (0 .. (scalar(@{$trans}) - 1)) {
695       if (   ($j != $notsplitindex)
696           && !$trans->[$j]->{is_tax}
697           && (   $trans->[$j]->{'taxkey'} eq ""
698               || $trans->[$j]->{'taxkey'} eq "0"
699               || $trans->[$j]->{'taxkey'} eq "1"
700               || $trans->[$j]->{'taxkey'} eq "10"
701               || $trans->[$j]->{'taxkey'} eq "11")) {
702         my %new_trans = ();
703         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
704
705         $absumsatz               += $trans->[$j]->{'amount'};
706         $new_trans{'amount'}      = $trans->[$j]->{'amount'} * (-1);
707         $new_trans{'umsatz'}      = abs($trans->[$j]->{'amount'}) * $ml;
708         $trans->[$j]->{'umsatz'}  = abs($trans->[$j]->{'amount'}) * $ml;
709
710         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
711
712       } elsif (($j != $notsplitindex) && !$trans->[$j]->{is_tax}) {
713
714         my %new_trans = ();
715         map { $new_trans{$_} = $trans->[$notsplitindex]->{$_}; } keys %{ $trans->[$notsplitindex] };
716
717         my $tax_rate              = $trans->[$j]->{'taxrate'};
718         $new_trans{'net_amount'}  = $trans->[$j]->{'amount'} * -1;
719         $new_trans{'tax_rate'}    = 1 + $tax_rate;
720
721         if (!$trans->[$j]->{'invoice'}) {
722           $new_trans{'amount'}      = $form->round_amount(-1 * ($trans->[$j]->{amount} + $trans->[$j]->{tax_amount}), 2);
723           $new_trans{'umsatz'}      = abs($new_trans{'amount'}) * $ml;
724           $trans->[$j]->{'umsatz'}  = $new_trans{'umsatz'};
725           $absumsatz               += -1 * $new_trans{'amount'};
726
727         } else {
728           my $unrounded             = $trans->[$j]->{'amount'} * (1 + $tax_rate) * -1 + $rounding_error;
729           my $rounded               = $form->round_amount($unrounded, 2);
730
731           $rounding_error           = $unrounded - $rounded;
732           $new_trans{'amount'}      = $rounded;
733           $new_trans{'umsatz'}      = abs($rounded) * $ml;
734           $trans->[$j]->{'umsatz'}  = $new_trans{umsatz};
735           $absumsatz               -= $rounded;
736         }
737
738         push @{ $self->{DATEV} }, [ \%new_trans, $trans->[$j] ];
739         push @taxed, $self->{DATEV}->[-1];
740       }
741     }
742
743     my $idx        = 0;
744     my $correction = 0;
745     while ((abs($absumsatz) >= 0.01) && (abs($absumsatz) < 1.00)) {
746       if ($idx >= scalar @taxed) {
747         last if (!$correction);
748
749         $correction = 0;
750         $idx        = 0;
751       }
752
753       my $transaction = $taxed[$idx]->[0];
754
755       my $old_amount     = $transaction->{amount};
756       my $old_correction = $correction;
757       my @possible_diffs;
758
759       if (!$transaction->{diff}) {
760         @possible_diffs = (0.01, -0.01);
761       } else {
762         @possible_diffs = ($transaction->{diff});
763       }
764
765       foreach my $diff (@possible_diffs) {
766         my $net_amount = $form->round_amount(($transaction->{amount} + $diff) / $transaction->{tax_rate}, 2);
767         next if ($net_amount != $transaction->{net_amount});
768
769         $transaction->{diff}    = $diff;
770         $transaction->{amount} += $diff;
771         $transaction->{umsatz} += $diff;
772         $absumsatz             -= $diff;
773         $correction             = 1;
774
775         last;
776       }
777
778       $idx++;
779     }
780
781     $absumsatz = $form->round_amount($absumsatz, 2);
782     if (abs($absumsatz) >= (0.01 * (1 + scalar @taxed))) {
783       require SL::DB::Manager::AccTransaction;
784       my $acc_trans_obj  = SL::DB::Manager::AccTransaction->get_first(where => [ trans_id => $trans->[0]->{trans_id} ]);
785       $self->add_error(t8("Export error in transaction #1: Rounding error too large #2",
786                           $acc_trans_obj->transaction_name, $absumsatz)
787       );
788     } elsif (abs($absumsatz) >= 0.01) {
789       $self->add_net_gross_differences($absumsatz);
790     }
791   }
792
793   $sth->finish();
794
795   $::lxdebug->leave_sub;
796 }
797
798 sub generate_datev_lines {
799   my ($self) = @_;
800
801   my @datev_lines = ();
802
803   foreach my $transaction ( @{ $self->{DATEV} } ) {
804
805     # each $transaction entry contains data from several acc_trans entries
806     # belonging to the same trans_id
807
808     my %datev_data = (); # data for one transaction
809     my $trans_lines = scalar(@{$transaction});
810
811     my $umsatz         = 0;
812     my $gegenkonto     = "";
813     my $konto          = "";
814     my $belegfeld1     = "";
815     my $datum          = "";
816     my $waehrung       = "";
817     my $buchungstext   = "";
818     my $belegfeld2     = "";
819     my $datevautomatik = 0;
820     my $taxkey         = 0;
821     my $charttax       = 0;
822     my $ustid          ="";
823     my ($haben, $soll);
824     for (my $i = 0; $i < $trans_lines; $i++) {
825       if ($trans_lines == 2) {
826         if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) {
827           $umsatz = $transaction->[$i]->{'amount'};
828         }
829       } else {
830         if (abs($transaction->[$i]->{'umsatz'}) > abs($umsatz)) {
831           $umsatz = $transaction->[$i]->{'umsatz'};
832         }
833       }
834       if ($transaction->[$i]->{'datevautomatik'}) {
835         $datevautomatik = 1;
836       }
837       if ($transaction->[$i]->{'taxkey'}) {
838         $taxkey = $transaction->[$i]->{'taxkey'};
839         # $taxkey = 0 if $taxkey == 94; # taxbookings are in gl
840       }
841       if ($transaction->[$i]->{'charttax'}) {
842         $charttax = $transaction->[$i]->{'charttax'};
843       }
844       if ($transaction->[$i]->{'amount'} > 0) {
845         $haben = $i;
846       } else {
847         $soll = $i;
848       }
849     }
850
851     if ($trans_lines >= 2) {
852
853       # Personenkontenerweiterung: accno has already been replaced if use_pk was set
854       $datev_data{'gegenkonto'} = $transaction->[$haben]->{'accno'};
855       $datev_data{'konto'}      = $transaction->[$soll]->{'accno'};
856       if ($transaction->[$haben]->{'invnumber'} ne "") {
857         $datev_data{belegfeld1} = $transaction->[$haben]->{'invnumber'};
858       }
859       $datev_data{datum} = $transaction->[$haben]->{'transdate'};
860       $datev_data{waehrung} = 'EUR';
861       $datev_data{kost1} = $transaction->[$haben]->{'departmentdescription'};
862       $datev_data{kost2} = $transaction->[$haben]->{'projectdescription'};
863
864       if ($transaction->[$haben]->{'name'} ne "") {
865         $datev_data{buchungstext} = $transaction->[$haben]->{'name'};
866       }
867       if (($transaction->[$haben]->{'ustid'} // '') ne "") {
868         $datev_data{ustid} = SL::VATIDNr->normalize($transaction->[$haben]->{'ustid'});
869       }
870       if (($transaction->[$haben]->{'duedate'} // '') ne "") {
871         $datev_data{belegfeld2} = $transaction->[$haben]->{'duedate'};
872       }
873
874       # if deliverydate exists, add it to datev export if it is
875       # * an ar/ap booking that is not a payment
876       # * a gl booking
877       if (    ($transaction->[$haben]->{'deliverydate'} // '') ne ''
878            && (
879                 (    $transaction->[$haben]->{'table'} =~ /^(ar|ap)$/
880                   && $transaction->[$haben]->{'link'}  !~ m/_paid/
881                   && $transaction->[$soll]->{'link'}   !~ m/_paid/
882                 )
883                 || $transaction->[$haben]->{'table'} eq 'gl'
884               )
885          ) {
886         $datev_data{leistungsdatum} = $transaction->[$haben]->{'deliverydate'};
887       }
888     }
889     $datev_data{umsatz} = abs($umsatz); # sales invoices without tax have a different sign???
890
891     # Dies ist die einzige Stelle die datevautomatik auswertet. Was soll gesagt werden?
892     # Im Prinzip hat jeder acc_trans Eintrag einen Steuerschlüssel, außer, bei gewissen Fällen
893     # wie: Kreditorenbuchung mit negativen Vorzeichen, SEPA-Export oder Rechnungen die per
894     # Skript angelegt werden.
895     # Also falls ein Steuerschlüssel da ist und NICHT datevautomatik diesen Block hinzufügen.
896     # Oder aber datevautomatik ist WAHR, aber der Steuerschlüssel in der acc_trans weicht
897     # von dem in der Chart ab: Also wahrscheinlich Programmfehler (NULL übergeben, statt
898     # DATEV-Steuerschlüssel) oder der Steuerschlüssel des Kontos weicht WIRKLICH von dem Eintrag in der
899     # acc_trans ab. Gibt es für diesen Fall eine plausiblen Grund?
900     #
901
902     # only set buchungsschluessel if the following conditions are met:
903     if (   ( $datevautomatik || $taxkey)
904         && (!$datevautomatik || ($datevautomatik && ($charttax ne $taxkey)))) {
905       # $datev_data{buchungsschluessel} = !$datevautomatik ? $taxkey : "4";
906       $datev_data{buchungsschluessel} = $taxkey;
907     }
908     # set lock for each transaction
909     $datev_data{locked} = $self->locked;
910
911     push(@datev_lines, \%datev_data) if $datev_data{umsatz};
912   }
913
914   # example of modifying export data:
915   # foreach my $datev_line ( @datev_lines ) {
916   #   if ( $datev_line{"konto"} eq '1234' ) {
917   #     $datev_line{"konto"} = '9999';
918   #   }
919   # }
920   #
921
922   return \@datev_lines;
923 }
924
925 sub check_vcnumbers_are_valid_pk_numbers {
926   my ($self) = @_;
927
928   # better use a class variable and set this in sub new (also needed in DATEV::CSV)
929   # calculation is also a bit more sane in sub check_valid_length_of_accounts
930   my $length_of_accounts = length(SL::DB::Manager::Chart->get_first(where => [charttype => 'A'])->accno) // 4;
931   my $pk_length = $length_of_accounts + 1;
932   my $query = <<"SQL";
933    SELECT customernumber AS vcnumber FROM customer WHERE customernumber !~ '^[[:digit:]]{$pk_length}\$'
934    UNION
935    SELECT vendornumber   AS vcnumber FROM vendor   WHERE vendornumber   !~ '^[[:digit:]]{$pk_length}\$'
936    LIMIT 1;
937 SQL
938   my ($has_non_pk_accounts)  = selectrow_query($::form, SL::DB->client->dbh, $query);
939   return defined $has_non_pk_accounts ? 0 : 1;
940 }
941
942
943 sub check_valid_length_of_accounts {
944   my ($self) = @_;
945
946   my $query = <<"SQL";
947   SELECT DISTINCT char_length (accno) FROM chart WHERE charttype='A' AND id in (select chart_id from acc_trans);
948 SQL
949
950   my $accno_length = selectall_hashref_query($::form, SL::DB->client->dbh, $query);
951   if (1 < scalar @$accno_length) {
952     $::form->error(t8("Invalid combination of ledger account number length." .
953                       " Mismatch length of #1 with length of #2. Please check your account settings. ",
954                       $accno_length->[0]->{char_length}, $accno_length->[1]->{char_length}));
955   }
956   return 1;
957 }
958
959 sub DESTROY {
960   clean_temporary_directories();
961 }
962
963 1;
964
965 __END__
966
967 =encoding utf-8
968
969 =head1 NAME
970
971 SL::DATEV - kivitendo DATEV Export module
972
973 =head1 SYNOPSIS
974
975   use SL::DATEV qw(:CONSTANTS);
976
977   my $startdate = DateTime->new(year => 2014, month => 9, day => 1);
978   my $enddate   = DateTime->new(year => 2014, month => 9, day => 31);
979   my $datev = SL::DATEV->new(
980     exporttype => DATEV_ET_BUCHUNGEN,
981     format     => DATEV_FORMAT_KNE,
982     from       => $startdate,
983     to         => $enddate,
984   );
985
986   # To only export transactions from a specific trans_id: (from and to are ignored)
987   my $invoice = SL::DB::Manager::Invoice->find_by( invnumber => '216' );
988   my $datev = SL::DATEV->new(
989     exporttype => DATEV_ET_BUCHUNGEN,
990     format     => DATEV_FORMAT_KNE,
991     trans_id   => $invoice->trans_id,
992   );
993
994   my $datev = SL::DATEV->new(
995     exporttype => DATEV_ET_STAMM,
996     format     => DATEV_FORMAT_KNE,
997     accnofrom  => $start_account_number,
998     accnoto    => $end_account_number,
999   );
1000
1001   # get or set datev stamm
1002   my $hashref = $datev->get_datev_stamm;
1003   $datev->save_datev_stamm($hashref);
1004
1005   # manually clean up temporary directories older than 8 hours
1006   $datev->clean_temporary_directories;
1007
1008   # export
1009   $datev->export;
1010
1011   if ($datev->errors) {
1012     die join "\n", $datev->error;
1013   }
1014
1015   # get relevant data for saving the export:
1016   my $dl_token = $datev->download_token;
1017   my $path     = $datev->export_path;
1018   my @files    = $datev->filenames;
1019
1020   # retrieving an export at a later time
1021   my $datev = SL::DATEV->new(
1022     download_token => $dl_token_from_user,
1023   );
1024
1025   my $path     = $datev->export_path;
1026   my @files    = glob("$path/*");
1027
1028   # Only test the datev data of a specific trans_id, without generating an
1029   # export file, but filling $datev->errors if errors exist
1030
1031   my $datev = SL::DATEV->new(
1032     trans_id   => $invoice->trans_id,
1033   );
1034   $datev->generate_datev_data;
1035   # if ($datev->errors) { ...
1036
1037
1038 =head1 DESCRIPTION
1039
1040 This module implements the DATEV export standard. For usage see above.
1041
1042 =head1 FUNCTIONS
1043
1044 =over 4
1045
1046 =item new PARAMS
1047
1048 Generic constructor. See section attributes for information about what to pass.
1049
1050 =item generate_datev_data
1051
1052 Fetches all transactions from the database (via a trans_id or a date range),
1053 and does an initial transformation (e.g. filters out tax, determines
1054 the brutto amount, checks split transactions ...) and stores this data in
1055 $self->{DATEV}.
1056
1057 If any errors are found these are collected in $self->errors.
1058
1059 This function is needed for all the exports, but can be also called
1060 independently in order to check transactions for DATEV compatibility.
1061
1062 =item generate_datev_lines
1063
1064 Parse the data in $self->{DATEV} and transform it into a format that can be
1065 used by DATEV, e.g. determines Konto and Gegenkonto, the taxkey, ...
1066
1067 The transformed data is returned as an arrayref, which is ready to be converted
1068 to a DATEV data format, e.g. KNE, OBE, CSV, ...
1069
1070 At this stage the "DATEV rule" has already been applied to the taxkeys, i.e.
1071 entries with datevautomatik have an empty taxkey, as the taxkey is already
1072 determined by the chart.
1073
1074 =item get_datev_stamm
1075
1076 Loads DATEV Stammdaten and returns as hashref.
1077
1078 =item save_datev_stamm HASHREF
1079
1080 Saves DATEV Stammdaten from provided hashref.
1081
1082 =item exporttype
1083
1084 See L<CONSTANTS> for possible values
1085
1086 =item has_exporttype
1087
1088 Returns true if an exporttype has been set. Without exporttype most report functions won't work.
1089
1090 =item format
1091
1092 Specifies the designated format of the export. Currently only KNE export is implemented.
1093
1094 See L<CONSTANTS> for possible values
1095
1096 =item has_format
1097
1098 Returns true if a format has been set. Without format most report functions won't work.
1099
1100 =item download_token
1101
1102 Returns a download token for this DATEV object.
1103
1104 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1105
1106 =item export_path
1107
1108 Returns an export_path for this DATEV object.
1109
1110 Note: If either a download_token or export_path were set at the creation these are infered, otherwise randomly generated.
1111
1112 =item filenames
1113
1114 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.
1115
1116 =item net_gross_differences
1117
1118 If there were any net gross differences during calculation they will be collected here.
1119
1120 =item sum_net_gross_differences
1121
1122 Sum of all differences.
1123
1124 =item clean_temporary_directories
1125
1126 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.
1127
1128 =item errors
1129
1130 Returns a list of errors that occurred. If no errors occurred, the export was a success.
1131
1132 =item export
1133
1134 Exports data. You have to have set L<exporttype> and L<format> or an error will
1135 occur. OBE exports are currently not implemented.
1136
1137 =item csv_export_for_tax_accountant
1138
1139 Generates up to four downloadable csv files containing data about sales and
1140 purchase invoices, and their respective payments:
1141
1142 Example:
1143   my $startdate = DateTime->new(year => 2012, month =>  1, day =>  1);
1144   my $enddate   = DateTime->new(year => 2012, month => 12, day => 31);
1145   SL::DATEV->new(from => $startdate, to => $enddate)->csv_export_for_tax_accountant;
1146   # {
1147   #   'download_token' => '1488551625-815654-22430',
1148   #   'filenames' => [
1149   #                    'Zahlungen Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1150   #                    'Kreditorenbuchungen 2012-01-01 - 2012-12-31.csv',
1151   #                    'Zahlungen Debitorenbuchungen 2012-01-01 - 2012-12-31.csv',
1152   #                    'Debitorenbuchungen 2012-01-01 - 2012-12-31.csv'
1153   #                  ]
1154   # };
1155
1156
1157 =item check_vcnumbers_are_valid_pk_numbers
1158
1159 Returns 1 if all vcnumbers are suitable for the DATEV export, 0 if not.
1160
1161 Finds the default length of charts (e.g. 4), adds 1 for the pk chart length
1162 (e.g. 5), and checks the database for any customers or vendors whose customer-
1163 or vendornumber doesn't consist of only numbers with exactly that length. E.g.
1164 for a chart length of four "10001" would be ok, but not "10001b" or "1000".
1165
1166 All vcnumbers are checked, obsolete customers or vendors aren't exempt.
1167
1168 There is also no check for the typical customer range 10000-69999 and the
1169 typical vendor range 70000-99999.
1170
1171 =item check_valid_length_of_accounts
1172
1173 Returns 1 if all currently booked accounts have only one common number length domain (e.g. 4 or 6).
1174 Will throw an error if more than one distinct size is detected.
1175 The error message gives a short hint with the value of the (at least)
1176 two mismatching number length domains.
1177
1178 =back
1179
1180 =head1 ATTRIBUTES
1181
1182 This is a list of attributes set in either the C<new> or a method of the same name.
1183
1184 =over 4
1185
1186 =item dbh
1187
1188 Set a database handle to use in the process. This allows for an export to be
1189 done on a transaction in progress without committing first.
1190
1191 Note: If you don't want this code to commit, simply providing a dbh is not
1192 enough enymore. You'll have to wrap the call into a transaction yourself, so
1193 that the internal transaction does not commit.
1194
1195 =item exporttype
1196
1197 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1198
1199 =item format
1200
1201 See L<CONSTANTS> for possible values. This MUST be set before export is called.
1202
1203 =item download_token
1204
1205 Can be set on creation to retrieve a prior export for download.
1206
1207 =item from
1208
1209 =item to
1210
1211 Set boundary dates for the export. Unless a trans_id is passed these MUST be
1212 set for the export to work.
1213
1214 =item trans_id
1215
1216 To check only one gl/ar/ap transaction, pass the trans_id. The attributes
1217 L<from> and L<to> are currently still needed for the query to be assembled
1218 correctly.
1219
1220 =item accnofrom
1221
1222 =item accnoto
1223
1224 Set boundary account numbers for the export. Only useful for a stammdaten export.
1225
1226 =item locked
1227
1228 Boolean if the transactions are locked (read-only in kivitenod) or not.
1229 Default value is false
1230
1231 =back
1232
1233 =head1 CONSTANTS
1234
1235 =head2 Supplied to L<exporttype>
1236
1237 =over 4
1238
1239 =item DATEV_ET_BUCHUNGEN
1240
1241 =item DATEV_ET_STAMM
1242
1243 =back
1244
1245 =head2 Supplied to L<format>.
1246
1247 =over 4
1248
1249 =item DATEV_FORMAT_KNE
1250
1251 =item DATEV_FORMAT_OBE
1252
1253 =back
1254
1255 =head1 ERROR HANDLING
1256
1257 This module will die in the following cases:
1258
1259 =over 4
1260
1261 =item *
1262
1263 No or unrecognized exporttype or format was provided for an export
1264
1265 =item *
1266
1267 OBE export was called, which is not yet implemented.
1268
1269 =item *
1270
1271 general I/O errors
1272
1273 =back
1274
1275 Errors that occur during th actual export will be collected in L<errors>. The following types can occur at the moment:
1276
1277 =over 4
1278
1279 =item *
1280
1281 C<Unbalanced Ledger!>. Exactly that, your ledger is unbalanced. Should never occur.
1282
1283 =item *
1284
1285 C<Datev-Export fehlgeschlagen! Bei Transaktion %d (%f).>  This error occurs if a
1286 transaction could not be reliably sorted out, or had rounding errors above the acceptable threshold.
1287
1288 =back
1289
1290 =head1 BUGS AND CAVEATS
1291
1292 =over 4
1293
1294 =item *
1295
1296 Handling of Vollvorlauf is currently not fully implemented. You must provide both from and to in order to get a working export.
1297
1298 =item *
1299
1300 OBE export is currently not implemented.
1301
1302 =back
1303
1304 =head1 TODO
1305
1306 - handling of export_path and download token is a bit dodgy, clean that up.
1307
1308 =head1 SEE ALSO
1309
1310 L<SL::DATEV::KNEFile>
1311 L<SL::DATEV::CSV>
1312
1313 =head1 AUTHORS
1314
1315 Philip Reetz E<lt>p.reetz@linet-services.deE<gt>,
1316
1317 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
1318
1319 Jan Büren E<lt>jan@lx-office-hosting.deE<gt>,
1320
1321 Geoffrey Richardson E<lt>information@lx-office-hosting.deE<gt>,
1322
1323 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
1324
1325 Stephan Köhler
1326
1327 =cut