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