AccTransCorrections: single-dbh
[kivitendo-erp.git] / SL / AccTransCorrections.pm
1 package AccTransCorrections;
2
3 use utf8;
4 use strict;
5
6 use List::Util qw(first);
7
8 use SL::DBUtils;
9 use SL::Taxkeys;
10 use SL::DB;
11
12 sub new {
13   my $type = shift;
14
15   my $self = {};
16
17   bless $self, $type;
18
19   $self->{taxkeys} = Taxkeys->new();
20
21   return $self;
22 }
23
24 sub _fetch_transactions {
25   $main::lxdebug->enter_sub();
26
27   my $self     = shift;
28   my %params   = @_;
29
30   my $myconfig = \%main::myconfig;
31   my $form     = $main::form;
32
33   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
34
35   my (@where, @values) = ((), ());
36
37   if ($params{transdate_from}) {
38     push @where,  qq|at.transdate >= ?|;
39     push @values, $params{transdate_from};
40   }
41
42   if ($params{transdate_to}) {
43     push @where,  qq|at.transdate <= ?|;
44     push @values, $params{transdate_to};
45   }
46
47   if ($params{trans_id}) {
48     push @where,  qq|at.trans_id = ?|;
49     push @values, $params{trans_id};
50   }
51
52   my $where = '';
53   if (scalar @where) {
54     $where = 'WHERE ' . join(' AND ', map { "($_)" } @where);
55   }
56
57   my $query = qq!
58     SELECT at.*,
59       c.accno, c.description AS chartdescription, c.charttype, c.category AS chartcategory, c.link AS chartlink,
60       COALESCE(gl.reference, COALESCE(ap.invnumber, ar.invnumber)) AS reference,
61       COALESCE(ap.invoice, COALESCE(ar.invoice, FALSE)) AS invoice,
62       CASE
63         WHEN gl.id IS NOT NULL THEN gl.storno AND (gl.storno_id IS NOT NULL)
64         WHEN ap.id IS NOT NULL THEN ap.storno AND (ap.storno_id IS NOT NULL)
65         ELSE                        ar.storno AND (ar.storno_id IS NOT NULL)
66       END AS is_storno,
67       CASE
68         WHEN gl.id IS NOT NULL THEN 'gl'
69         WHEN ap.id IS NOT NULL THEN 'ap'
70         ELSE                        'ar'
71       END AS module
72
73     FROM acc_trans at
74     LEFT JOIN chart c ON (at.chart_id = c.id)
75     LEFT JOIN gl      ON (at.trans_id = gl.id)
76     LEFT JOIN ap      ON (at.trans_id = ap.id)
77     LEFT JOIN ar      ON (at.trans_id = ar.id)
78     $where
79     ORDER BY at.trans_id, at.acc_trans_id
80 !;
81
82   my @transactions = ();
83   my $last_trans   = undef;
84
85   foreach my $entry (@{ selectall_hashref_query($form, $dbh, $query, @values) }) {
86     if (!$last_trans || ($last_trans->[0]->{trans_id} != $entry->{trans_id})) {
87       $last_trans = [];
88       push @transactions, $last_trans;
89     }
90
91     push @{ $last_trans }, $entry;
92   }
93
94   $main::lxdebug->leave_sub();
95
96   return @transactions;
97 }
98
99 sub _prepare_data {
100   $main::lxdebug->enter_sub();
101
102   my $self        = shift;
103   my %params      = @_;
104
105   my $transaction = $params{transaction};
106   my $callback    = $params{callback};
107
108   my $myconfig    = \%main::myconfig;
109   my $form        = $main::form;
110
111   my $data          = {
112     'credit'        => {
113       'num'         => 0,
114       'sum'         => 0,
115       'entries'     => [],
116       'tax_sum'     => 0,
117       'tax_entries' => [],
118     },
119     'debit'         => {
120       'num'         => 0,
121       'sum'         => 0,
122       'entries'     => [],
123       'tax_sum'     => 0,
124       'tax_entries' => [],
125     },
126     'payments'      => [],
127   };
128
129   foreach my $entry (@{ $transaction }) {
130     $entry->{chartlinks} = { map { $_ => 1 } split(m/:/, $entry->{chartlink}) };
131     delete $entry->{chartlink};
132   }
133
134   # Verknüpfungen zwischen Steuerschlüsseln und zum Zeitpunkt der Transaktion
135   # gültigen Steuersätze
136   my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $transaction->[0]->{transdate});
137
138   my ($trans_type, $previous_non_tax_entry);
139   my $sum             = 0;
140   my $first_sub_trans = 1;
141
142   my $storno_mult     = $transaction->[0]->{is_storno} ? -1 : 1;
143
144   # Aufteilung der Buchungspositionen in Soll-, Habenseite sowie
145   # getrennte Auflistung der Positionen, die auf Steuerkonten gebucht werden.
146   foreach my $entry (@{ $transaction }) {
147     if (!$first_sub_trans && ($entry->{chartlinks}->{AP_paid} || $entry->{chartlinks}->{AR_paid})) {
148       push @{ $data->{payments} }, $entry;
149       next;
150     }
151
152     my $tax_info = $all_taxes{taxkeys}->{ $entry->{taxkey} };
153     if ($tax_info) {
154       $entry->{taxdescription} = $tax_info->{taxdescription} . ' ' . $form->format_amount($myconfig, $tax_info->{taxrate} * 100) . ' %';
155     }
156
157     if ($entry->{chartlinks}->{AP}) {
158       $trans_type = 'AP';
159     } elsif ($entry->{chartlinks}->{AR}) {
160       $trans_type = 'AR';
161     }
162
163     my $idx = 0 < ($entry->{amount} * $storno_mult) ? 'credit' : 'debit';
164
165     if ($entry->{chartlinks}->{AP_tax} || $entry->{chartlinks}->{AR_tax}) {
166       $data->{$idx}->{tax_sum} += $entry->{amount};
167       push @{ $data->{$idx}->{tax_entries} }, $entry;
168
169       if ($previous_non_tax_entry) {
170         $previous_non_tax_entry->{tax_entry} = $entry;
171         undef $previous_non_tax_entry;
172       }
173
174     } else {
175       $data->{$idx}->{sum} += $entry->{amount};
176       push @{ $data->{$idx}->{entries} }, $entry;
177
178       $previous_non_tax_entry = $entry;
179     }
180
181     $sum += $entry->{amount};
182
183     if (abs($sum) < 0.02) {
184       $sum             = 0;
185       $first_sub_trans = 0;
186     }
187   }
188
189   # Alle Einträge entfernen, die die Gegenkonten zu Zahlungsein- und
190   # -ausgängen darstellen.
191   foreach my $payment (@{ $data->{payments} }) {
192     my $idx = 0 < $payment->{amount} ? 'debit' : 'credit';
193
194     foreach my $i (0 .. scalar(@{ $data->{$idx}->{entries} }) - 1) {
195       my $entry = $data->{$idx}->{entries}->[$i];
196
197       next if ((($payment->{amount} * -1) != $entry->{amount}) || ($payment->{transdate} ne $entry->{transdate}));
198
199       splice @{ $data->{$idx}->{entries} }, $i, 1;
200
201       last;
202     }
203   }
204
205   delete $data->{payments};
206
207   map { $data->{$_}->{num} = scalar @{ $data->{$_}->{entries} } } qw(credit debit);
208
209   my $info   = $transaction->[0];
210   my $script = ($info->{module} eq 'ar') && $info->{invoice} ? 'is'
211              : ($info->{module} eq 'ap') && $info->{invoice} ? 'ir'
212              :                                                 $info->{module};
213
214   my %common_args = (
215     'data'          => $data,
216     'trans_type'    => $trans_type,
217     'all_taxes'     => { %all_taxes },
218     'transaction'   => $transaction,
219     'full_analysis' => $params{full_analysis},
220     'problem'       => {
221       'data'        => $info,
222       'link'        => $script . ".pl?action=edit${callback}&id=" . $info->{trans_id},
223     },
224     );
225
226   $main::lxdebug->leave_sub();
227
228   return %common_args;
229 }
230
231 sub _group_sub_transactions {
232   $main::lxdebug->enter_sub();
233
234   my $self             = shift;
235   my $transaction      = shift;
236
237   my @sub_transactions = ();
238   my $sum              = 0;
239
240   foreach my $i (0 .. scalar(@{ $transaction }) - 1) {
241     my $entry = $transaction->[$i];
242
243     if (abs($sum) <= 0.01) {
244       push @sub_transactions, [];
245       $sum = 0;
246     }
247     $sum += $entry->{amount};
248
249     push @{ $sub_transactions[-1] }, $entry;
250   }
251
252   $main::lxdebug->leave_sub();
253
254   return @sub_transactions;
255 }
256
257 # Problemfall: Verkaufsrechnungen, bei denen Buchungen auf Warenbestandskonten
258 # mit Steuerschlüssel != 0 durchgeführt wurden. Richtig wäre, dass alle
259 # Steuerschlüssel für solche Warenbestandsbuchungen 0 sind.
260 sub _check_trans_invoices_inventory_with_taxkeys {
261   $main::lxdebug->enter_sub();
262
263   my $self   = shift;
264   my %params = @_;
265
266   # ist nur für bestandsmethode notwendig. bei der Aufwandsmethode
267   # können Warenkonten mit Steuerschlüssel sein (5400 in SKR04)
268   return 0 if $::instance_conf->get_inventory_system eq 'periodic';
269
270   if (!$params{transaction}->[0]->{invoice}) {
271     $main::lxdebug->leave_sub();
272     return 0;
273   }
274
275   my @sub_transactions = $self->_group_sub_transactions($params{transaction});
276
277   foreach my $sub_transaction (@sub_transactions) {
278     my $is_cogs = first { $_->{chartlinks}->{IC_cogs} } @{ $sub_transaction };
279     next unless ($is_cogs);
280
281     my $needs_fixing = first { $_->{taxkey} != 0 } @{ $sub_transaction };
282     next unless ($needs_fixing);
283
284     $params{problem}->{type} = 'invoice_inventory_with_taxkeys';
285     push @{ $self->{invoice_inventory_taxkey_problems} }, $params{problem};
286
287     $main::lxdebug->leave_sub();
288
289     return 1;
290   }
291
292   $main::lxdebug->leave_sub();
293
294   return 0;
295 }
296
297 # Problemfall: Verkaufsrechnungen, bei denen Steuern verbucht wurden, obwohl
298 # kein Steuerschlüssel eingetragen ist.
299 sub _check_missing_taxkeys_in_invoices {
300   $::lxdebug->enter_sub;
301
302   my $self        = shift;
303   my %params      = @_;
304   my $transaction = $params{transaction};
305   my $found_broken = 0;
306
307   $::lxdebug->leave_sub and return 0
308     if    !$transaction->[0]->{invoice};
309
310   my @sub_transactions = $self->_group_sub_transactions($transaction);
311
312   for my $sub_transaction (@sub_transactions) {
313     $::lxdebug->leave_sub and return 0
314       if    _is_split_transaction($sub_transaction)
315          || _is_simple_transaction($sub_transaction);
316
317     my $split_side_entries = _get_splitted_side($sub_transaction);
318     my $num_tax_rows;
319     my $num_taxed_rows;
320     for my $entry (@{ $split_side_entries }) {
321       my $is_tax = grep { m/(?:AP_tax|AR_tax)/ } keys %{ $entry->{chartlinks} };
322
323       $num_tax_rows++   if  $is_tax;
324       $num_taxed_rows++ if !$is_tax && $entry->{tax_key} != 0;
325     }
326
327     # now if this has tax rows but NO taxed rows, something is wrong.
328     if ($num_tax_rows > 0 && $num_taxed_rows == 0) {
329       $params{problem}->{type} = 'missing_taxkeys_in_invoices';
330       push @{ $self->{missing_taxkeys_in_invoices} ||= [] }, $params{problem};
331       $found_broken = 1;
332     }
333   }
334
335   $::lxdebug->leave_sub;
336
337   return $found_broken;
338 }
339
340 # Problemfall: Kreditorenbuchungen, bei denen mit Umsatzsteuerschlüsseln
341 # gebucht wurde und Debitorenbuchungen, bei denen mit Vorsteuerschlüsseln
342 # gebucht wurde.
343 sub _check_trans_ap_ar_wrong_taxkeys {
344   $main::lxdebug->enter_sub();
345
346   my $self   = shift;
347   my %params = @_;
348
349   my $retval = 0;
350
351   if (!$params{transaction}->[0]->{invoice}
352       && ((   ($params{transaction}->[0]->{module} eq 'ap')
353           && (first { my $taxkey = $_->{taxkey}; first { $taxkey == $_ } (2, 3, 12, 13) } @{ $params{transaction} }))
354          ||
355          (   ($params{transaction}->[0]->{module} eq 'ar')
356           && (first { my $taxkey = $_->{taxkey}; first { $taxkey == $_ } (8, 9, 18, 19) } @{ $params{transaction} })))) {
357     $params{problem}->{type} = 'ap_ar_wrong_taxkeys';
358     push @{ $self->{ap_ar_taxkey_problems} }, $params{problem};
359
360     $retval = 1;
361   }
362
363   $main::lxdebug->leave_sub();
364
365   return $retval;
366 }
367
368 # Problemfall: Splitbuchungen, die mehrere Haben- und Sollkonten ansprechen.
369 # Aber nur für Debitoren- und Kreditorenbuchungen, weil das bei Einkaufs- und
370 # Verkaufsrechnungen hingegen völlig normal ist.
371 sub _check_trans_split_multiple_credit_and_debit {
372   $main::lxdebug->enter_sub();
373
374   my $self   = shift;
375   my %params = @_;
376
377   my $retval = 0;
378
379   if (   !$params{transaction}->[0]->{invoice}
380       && (1 < $params{data}->{credit}->{num})
381       && (1 < $params{data}->{debit}->{num})) {
382     $params{problem}->{type} = 'split_multiple_credit_and_debit';
383     push @{ $self->{problems} }, $params{problem};
384
385     $retval = 1;
386   }
387
388   $main::lxdebug->leave_sub();
389
390   return $retval;
391 }
392
393 # Problemfall: Buchungen, bei denen Steuersummen nicht mit den Summen
394 # übereinstimmen, die nach ausgewähltem Steuerschlüssel hätten auftreten müssen.
395 sub _check_trans_wrong_taxkeys {
396   $main::lxdebug->enter_sub();
397
398   my $self        = shift;
399   my %params      = @_;
400
401   my $form        = $main::form;
402
403   my %data        = %{ $params{data} };
404   my $transaction = $params{transaction};
405
406   if (   $transaction->[0]->{invoice}
407       || $transaction->[0]->{ob_transaction}
408       || $transaction->[0]->{cb_transaction}
409       || (!scalar @{ $data{credit}->{entries} } && !scalar @{ $data{debit}->{entries} })
410       || (   ($transaction->[0]->{module} eq 'gl')
411           && (!scalar @{ $data{credit}->{entries} } || !scalar @{ $data{debit}->{entries} }))) {
412     $main::lxdebug->leave_sub();
413     return 0;
414   }
415
416   my $retval = 0;
417
418   my ($side, $other_side);
419   if (   (grep { $_->{taxkey} * 1 } @{ $data{credit}->{entries} })
420       || (scalar @{ $data{credit}->{tax_entries} })) {
421     $side       = 'credit';
422     $other_side = 'debit';
423
424   } elsif (   (grep { $_->{taxkey} * 1 } @{ $data{debit}->{entries} })
425            || (scalar @{ $data{debit}->{tax_entries} })) {
426     $side       = 'debit';
427     $other_side = 'credit';
428   }
429
430   if (!$side) {
431     $main::lxdebug->leave_sub();
432     return 0;
433   }
434
435   my $expected_tax          = 0;
436   my %num_entries_per_chart = ();
437   my $num_taxed_entries     = 0;
438
439   foreach my $entry (@{ $data{$side}->{entries} }) {
440     my $taxinfo             = $params{all_taxes}->{taxkeys}->{$entry->{taxkey}} || { };
441     $entry->{expected_tax}  = $entry->{amount} * $taxinfo->{taxrate};
442     $expected_tax          += $entry->{expected_tax};
443
444     $num_taxed_entries++ if ($taxinfo->{taxrate} * 1);
445
446     my $chart_key = $entry->{chart_id} . "-" . $entry->{taxkey};
447     $num_entries_per_chart{$chart_key} ||= 0;
448     $num_entries_per_chart{$chart_key}++;
449   }
450
451 #   $main::lxdebug->message(0, "side $side trans_id $transaction->[0]->{trans_id} expected tax $expected_tax actual tax $data{$side}->{tax_sum}");
452
453   if (abs($expected_tax - $data{$side}->{tax_sum}) >= (0.01 * ($num_taxed_entries + 1))) {
454     if ($params{full_analysis}) {
455       my $storno_mult = $data{$side}->{entries}->[0]->{is_storno} ? -1 : 1;
456
457       foreach my $entry (@{ $data{$other_side}->{entries} }) {
458         $entry->{display_amount} = $form->round_amount(abs($entry->{amount}) * $storno_mult, 2);
459       }
460
461       foreach my $entry (@{ $data{$side}->{entries} }) {
462         $entry->{actual_tax}              = $form->round_amount(abs($entry->{tax_entry} ? $entry->{tax_entry}->{amount} : 0), 2);
463         $entry->{expected_tax}            = $form->round_amount(abs($entry->{expected_tax}), 2);
464         $entry->{taxkey_error}            =    ( $entry->{taxkey} && !$entry->{tax_entry})
465                                             || (!$entry->{taxkey} &&  $entry->{tax_entry})
466                                             || (abs($entry->{expected_tax} - $entry->{actual_tax}) >= 0.02);
467         $entry->{tax_entry_acc_trans_id}  = $entry->{tax_entry}->{acc_trans_id};
468         delete $entry->{tax_entry};
469
470         $entry->{display_amount}       = $form->round_amount(abs($entry->{amount}) * $storno_mult, 2);
471         $entry->{display_actual_tax}   = $entry->{actual_tax}   * $storno_mult;
472         $entry->{display_expected_tax} = $entry->{expected_tax} * $storno_mult;
473
474         if ($entry->{taxkey_error}) {
475           $self->{negative_taxkey_filter} ||= {
476             'ar' => { map { $_ => 1 } (   8, 9, 18, 19) },
477             'ap' => { map { $_ => 1 } (1, 2, 3, 12, 13) },
478             'gl' => { },
479           };
480
481           $entry->{correct_taxkeys} = [];
482
483           my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $entry->{transdate});
484
485           foreach my $taxkey (sort { $a <=> $b } keys %{ $all_taxes{taxkeys} }) {
486             next if ($self->{negative_taxkey_filter}->{ $entry->{module} }->{$taxkey});
487
488             my $tax_info = $all_taxes{taxkeys}->{$taxkey};
489
490             next if ((!$tax_info || (0 == $tax_info->{taxrate} * 1)) && $entry->{tax_entry_acc_trans_id});
491
492             push @{ $entry->{correct_taxkeys} }, {
493               'taxkey'      => $taxkey,
494               'tax'         => $form->round_amount(abs($entry->{amount}) * $tax_info->{taxrate}, 2),
495               'description' => sprintf("%s %d%%", $tax_info->{taxdescription}, int($tax_info->{taxrate} * 100)),
496             };
497           }
498         }
499       }
500     }
501
502     if (first { $_ > 1 } values %num_entries_per_chart) {
503       $params{problem}->{type} = 'wrong_taxkeys';
504     } else {
505       $params{problem}->{type} = 'wrong_taxes';
506     }
507
508     $params{problem}->{acc_trans} = { %data };
509     push @{ $self->{problems} }, $params{problem};
510
511     $retval = 1;
512   }
513
514   $main::lxdebug->leave_sub();
515
516   return $retval;
517 }
518
519 # Inaktiver Code für das Erraten möglicher Verteilungen von
520 # Steuerschlüsseln. Deaktiviert, weil er exponentiell Zeit
521 # benötigt.
522
523 #       if (abs($expected_tax - $data{$side}->{tax_sum}) >= 0.02) {
524 #         my @potential_taxkeys = $trans_type eq 'AP' ? (0, 8, 9) : (0, 1, 2, 3);
525
526 #         $main::lxdebug->dump(0, "pota", \@potential_taxkeys);
527
528 #         # Über alle Kombinationen aus Buchungssätzen und potenziellen Steuerschlüsseln
529 #         # iterieren und jeweils die Summe ermitteln.
530 #         my $num_entries    = scalar @{ $data{$side}->{entries} };
531 #         my @taxkey_indices = (0) x $num_entries;
532
533 #         my @solutions      = ();
534
535 #         my $start_time     = time();
536
537 #         $main::lxdebug->message(0, "num_entries $num_entries");
538
539 #         while ($num_entries == scalar @taxkey_indices) {
540 #           my @tax_cache = ();
541
542 #           # Berechnen der Steuersumme für die aktuell angenommenen Steuerschlüssel.
543 #           my $tax_sum = 0;
544 #           foreach my $i (0 .. $num_entries - 1) {
545 #             my $taxkey      = $potential_taxkeys[$taxkey_indices[$i]];
546 #             my $entry       = $data{$side}->{entries}->[$i];
547 #             my $taxinfo     = $all_taxes{taxkeys}->{ $taxkey } || { };
548 #             $tax_cache[$i]  = $entry->{amount} * $taxinfo->{taxrate};
549 #             $tax_sum       += $tax_cache[$i];
550 #           }
551
552 #           # Entspricht die Steuersumme mit den aktuell angenommenen Steuerschlüsseln
553 #           # der verbuchten Steuersumme? Wenn ja, dann ist das eine potenzielle
554 #           # Lösung.
555 #           if (abs($tax_sum - $data{$side}->{tax_sum}) < 0.02) {
556 #             push @solutions, {
557 #               'taxkeys' => [ @potential_taxkeys[@taxkey_indices] ],
558 #               'taxes'   => [ @tax_cache ],
559 #             }
560 #           }
561
562 #           # Weiterzählen der Steuerschlüsselindices zum Interieren über
563 #           # alle möglichen Kombinationen.
564 #           my $i = 0;
565 #           while (1) {
566 #             $taxkey_indices[$i]++;
567 #             last if ($taxkey_indices[$i] < scalar @potential_taxkeys);
568
569 #             $taxkey_indices[$i] = 0;
570 #             $i++;
571 #           }
572
573 #           my $now = time();
574 #           if (($now - $start_time) >= 5) {
575 #             $main::lxdebug->message(0, "  " . join("", @taxkey_indices));
576 #             $start_time = $now;
577 #           }
578 #         }
579
580 #         foreach my $solution (@solutions) {
581 #           $solution->{rows}    = [];
582 #           $solution->{changes} = [];
583 #           my $error            = 0;
584
585 #           foreach my $i (0 .. $num_entries - 1) {
586 #             if ($solution->{taxes}->[$i]) {
587 #               my $tax_rounded          = $form->round_amount($solution->{taxes}->[$i] + $error, 2);
588 #               $error                   = $solution->{taxes}->[$i] + $error - $tax_rounded;
589 #               $solution->{taxes}->[$i] = $tax_rounded;
590 #             }
591
592 #             my $entry     = $data{$side}->{entries}->[$i];
593 #             my $tax_entry = $all_taxes{taxkeys}->{ $solution->{taxkeys}->[$i] };
594
595 #             push @{ $solution->{rows} }, {
596 #               %{ $entry },
597 #               %{ $tax_entry },
598 #               'taxamount' => $solution->{taxes}->[$i],
599 #             };
600
601 #             $solution->{rows}->[$i]->{taxdescription} .= ' ' . $form->format_amount(\%myconfig, $tax_entry->{taxrate} * 100) . ' %';
602
603 #             push @{ $solution->{changes} }, {
604 #               'acc_trans_id'    => $entry->{acc_trans_id},
605 #               'taxkey' => $solution->{taxkeys}->[$i],
606 #             };
607 #           }
608
609 #           push @{ $solution->{rows} }, @{ $data{$other_side}->{entries} };
610
611 #           delete @{ $solution }{ qw(taxes taxkeys) };
612 #         }
613
614 #         $problem->{type}      = 'wrong_taxkeys';
615 #         $problem->{solutions} = [ @solutions ];
616 #         $problem->{acc_trans} = { %data };
617 #         push @problems, $problem;
618
619 #         next;
620 #       }
621
622 sub analyze {
623   $main::lxdebug->enter_sub();
624
625   my $self         = shift;
626   my %params       = @_;
627
628   my $myconfig     = \%main::myconfig;
629   my $form         = $main::form;
630
631   my $dbh          = $params{dbh} || $form->get_standard_dbh($myconfig);
632
633   my @transactions = $self->_fetch_transactions(%params, 'dbh' => $dbh);
634
635   if (!scalar @transactions) {
636     $main::lxdebug->leave_sub();
637     return ();
638   }
639
640   my $callback = $params{callback} ? '&callback=' . $params{callback} : '';
641
642   $self->{problems}                          = [];
643   $self->{ap_ar_taxkey_problems}             = [];
644   $self->{invoice_inventory_taxkey_problems} = [];
645
646   foreach my $transaction (@transactions) {
647     my %common_args = $self->_prepare_data('transaction' => $transaction, 'callback' => $callback, 'full_analysis' => $params{full_analysis});
648
649     next if ($self->_check_trans_ap_ar_wrong_taxkeys(%common_args));
650     next if ($self->_check_trans_invoices_inventory_with_taxkeys(%common_args));
651     next if ($self->_check_trans_split_multiple_credit_and_debit(%common_args));
652     next if ($self->_check_trans_wrong_taxkeys(%common_args));
653   }
654
655   my @problems = @{ $self->{problems} };
656
657   map { $self->{$_} ||= [] } qw(ap_ar_taxkey_problems invoice_inventory_taxkey_problems missing_taxkeys_in_invoices);
658
659   if (0 != scalar @{ $self->{ap_ar_taxkey_problems} }) {
660     my $problem = {
661       'type'        => 'ap_ar_wrong_taxkeys',
662       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{ap_ar_taxkey_problems} } ],
663       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{ap_ar_taxkey_problems} } ],
664     };
665     unshift @problems, $problem;
666   }
667
668   if (0 != scalar @{ $self->{invoice_inventory_taxkey_problems} }) {
669     my $problem = {
670       'type'        => 'invoice_inventory_with_taxkeys',
671       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{invoice_inventory_taxkey_problems} } ],
672       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{invoice_inventory_taxkey_problems} } ],
673     };
674     unshift @problems, $problem;
675   }
676
677   if (0 != scalar @{ $self->{missing_taxkeys_in_invoices} }) {
678     my $problem = {
679       'type'        => 'missing_taxkeys_in_invoices',
680       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{missing_taxkeys_in_invoices} } ],
681       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{missing_taxkeys_in_invoices} } ],
682     };
683     unshift @problems, $problem;
684   }
685
686   $main::lxdebug->leave_sub();
687
688 #  $::lxdebug->dump(0, 'problems:', \@problems);
689
690   return @problems;
691 }
692
693 sub fix_ap_ar_wrong_taxkeys {
694   $main::lxdebug->enter_sub();
695
696   my $self     = shift;
697   my %params   = @_;
698
699   my $myconfig = \%main::myconfig;
700   my $form     = $main::form;
701
702   my $dbh      = $params{dbh} || SL::DB->client->dbh;
703
704   my $query    = qq|SELECT 'ap' AS module,
705                       at.acc_trans_id, at.trans_id, at.chart_id, at.amount, at.taxkey, at.transdate,
706                       c.link
707                     FROM acc_trans at
708                     LEFT JOIN chart c ON (at.chart_id = c.id)
709                     WHERE (trans_id IN (SELECT id FROM ap WHERE NOT invoice))
710                       AND (taxkey IN (2, 3, 12, 13))
711
712                     UNION
713
714                     SELECT 'ar' AS module,
715                       at.acc_trans_id, at.trans_id, at.chart_id, at.amount, at.taxkey, at.transdate,
716                       c.link
717                     FROM acc_trans at
718                     LEFT JOIN chart c ON (at.chart_id = c.id)
719                     WHERE (trans_id IN (SELECT id FROM ar WHERE NOT invoice))
720                       AND (taxkey IN (8, 9, 18, 19))
721
722                     ORDER BY trans_id, acc_trans_id|;
723
724   my $sth      = prepare_execute_query($form, $dbh, $query);
725   my @transactions;
726
727   while (my $ref = $sth->fetchrow_hashref()) {
728     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
729       push @transactions, [];
730     }
731
732     push @{ $transactions[-1] }, $ref;
733   }
734
735   $sth->finish();
736
737   @transactions = grep { (scalar(@transactions) % 2) == 0 } @transactions;
738
739   my %taxkey_replacements = (
740      2 =>  8,
741      3 =>  9,
742      8 =>  2,
743      9 =>  3,
744     12 => 18,
745     13 => 19,
746     18 => 12,
747     19 => 13,
748     );
749
750   my %bad_taxkeys = (
751     'ap' => { map { $_ => 1 } (2, 3, 12, 13) },
752     'ar' => { map { $_ => 1 } (8, 9, 18, 19) },
753     );
754
755   my @corrections = ();
756
757   foreach my $transaction (@transactions) {
758
759     for (my $i = 0; $i < scalar @{ $transaction }; $i += 2) {
760       my ($non_tax_idx, $tax_idx) = abs($transaction->[$i]->{amount}) > abs($transaction->[$i + 1]->{amount}) ? ($i, $i + 1) : ($i + 1, $i);
761       my ($non_tax,     $tax)     = @{ $transaction }[$non_tax_idx, $tax_idx];
762
763       last if ($non_tax->{link} =~ m/(:?AP|AR)_tax(:?$|:)/);
764       last if ($tax->{link}     !~ m/(:?AP|AR)_tax(:?$|:)/);
765
766       next if (!$bad_taxkeys{ $non_tax->{module} }->{ $non_tax->{taxkey} });
767
768       my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $non_tax->{transdate});
769
770       push @corrections, ({ 'acc_trans_id' => $non_tax->{acc_trans_id},
771                             'taxkey'       => $taxkey_replacements{$non_tax->{taxkey}},
772                           },
773                           {
774                             'acc_trans_id' => $tax->{acc_trans_id},
775                             'taxkey'       => $taxkey_replacements{$non_tax->{taxkey}},
776                             'chart_id'     => $all_taxes{taxkeys}->{ $taxkey_replacements{$non_tax->{taxkey}} }->{taxchart_id},
777                           });
778     }
779   }
780
781   if (scalar @corrections) {
782     SL::DB->with_transaction(sub {
783       my $q_taxkey_only     = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
784       my $h_taxkey_only     = prepare_query($form, $dbh, $q_taxkey_only);
785
786       my $q_taxkey_chart_id = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
787       my $h_taxkey_chart_id = prepare_query($form, $dbh, $q_taxkey_chart_id);
788
789       foreach my $entry (@corrections) {
790         if ($entry->{chart_id}) {
791           do_statement($form, $h_taxkey_chart_id, $q_taxkey_chart_id, $entry->{taxkey}, $entry->{chart_id}, $entry->{acc_trans_id});
792         } else {
793           do_statement($form, $h_taxkey_only, $q_taxkey_only, $entry->{taxkey}, $entry->{acc_trans_id});
794         }
795       }
796
797       $h_taxkey_only->finish();
798       $h_taxkey_chart_id->finish();
799     });
800   }
801
802   $main::lxdebug->leave_sub();
803 }
804
805 sub fix_invoice_inventory_with_taxkeys {
806   $main::lxdebug->enter_sub();
807
808   my $self     = shift;
809   my %params   = @_;
810
811   # ist nur für bestandsmethode notwendig. bei der Aufwandsmethode
812   # können Warenkonten mit Steuerschlüssel sein (5400 in SKR04)
813   return 0 if $::instance_conf->get_inventory_system eq 'periodic';
814
815   my $myconfig = \%main::myconfig;
816   my $form     = $main::form;
817
818   my $dbh      = $params{dbh} || SL::DB->client->dbh;
819
820   my $query    = qq|SELECT at.*, c.link
821                     FROM acc_trans at
822                     LEFT JOIN ar      ON (at.trans_id = ar.id)
823                     LEFT JOIN chart c ON (at.chart_id = c.id)
824                     WHERE (ar.invoice)
825
826                     UNION
827
828                     SELECT at.*, c.link
829                     FROM acc_trans at
830                     LEFT JOIN ap      ON (at.trans_id = ap.id)
831                     LEFT JOIN chart c ON (at.chart_id = c.id)
832                     WHERE (ap.invoice)
833
834                     ORDER BY trans_id, acc_trans_id|;
835
836   my $sth      = prepare_execute_query($form, $dbh, $query);
837   my @transactions;
838
839   while (my $ref = $sth->fetchrow_hashref()) {
840     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
841       push @transactions, [];
842     }
843
844     push @{ $transactions[-1] }, $ref;
845   }
846
847   $sth->finish();
848
849   my @corrections = ();
850
851   foreach my $transaction (@transactions) {
852     my @sub_transactions = $self->_group_sub_transactions($transaction);
853
854     foreach my $sub_transaction (@sub_transactions) {
855       my $is_cogs = first { $_->{link} =~ m/IC_cogs/ } @{ $sub_transaction };
856       next unless ($is_cogs);
857
858       foreach my $entry (@{ $sub_transaction }) {
859         next if ($entry->{taxkey} == 0);
860         push @corrections, $entry->{acc_trans_id};
861       }
862     }
863   }
864
865   if (@corrections) {
866     SL::DB->client->with_transaction(sub {
867       $query = qq|UPDATE acc_trans SET taxkey = 0 WHERE acc_trans_id = ?|;
868       $sth   = prepare_query($form, $dbh, $query);
869
870       foreach my $acc_trans_id (@corrections) {
871         do_statement($form, $sth, $query, $acc_trans_id);
872       }
873
874       $sth->finish();
875     });
876   }
877
878   $main::lxdebug->leave_sub();
879 }
880
881 sub fix_wrong_taxkeys {
882   $main::lxdebug->enter_sub();
883
884   my $self     = shift;
885   my %params   = @_;
886
887   Common::check_params(\%params, qw(fixes));
888
889   my $myconfig = \%main::myconfig;
890   my $form     = $main::form;
891
892   my $dbh      = $params{dbh} || SL::DB->client->dbh;
893
894   SL::DB->client->with_transaction(sub {
895     my $q_taxkey_only  = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
896     my $h_taxkey_only  = prepare_query($form, $dbh, $q_taxkey_only);
897
898     my $q_taxkey_chart = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
899     my $h_taxkey_chart = prepare_query($form, $dbh, $q_taxkey_chart);
900
901     my $q_transdate    = qq|SELECT transdate FROM acc_trans WHERE acc_trans_id = ?|;
902     my $h_transdate    = prepare_query($form, $dbh, $q_transdate);
903
904     foreach my $fix (@{ $params{fixes} }) {
905       next unless ($fix->{acc_trans_id});
906
907       do_statement($form, $h_taxkey_only, $q_taxkey_only, conv_i($fix->{taxkey}), conv_i($fix->{acc_trans_id}));
908
909       next unless ($fix->{tax_entry_acc_trans_id});
910
911       do_statement($form, $h_transdate, $q_transdate, conv_i($fix->{tax_entry_acc_trans_id}));
912       my ($transdate) = $h_transdate->fetchrow_array();
913
914       my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $transdate);
915       my $tax_info  = $all_taxes{taxkeys}->{ $fix->{taxkey} };
916
917       next unless ($tax_info);
918
919       do_statement($form, $h_taxkey_chart, $q_taxkey_chart, conv_i($fix->{taxkey}), conv_i($tax_info->{taxchart_id}), conv_i($fix->{tax_entry_acc_trans_id}));
920     }
921
922     $h_taxkey_only->finish();
923     $h_taxkey_chart->finish();
924     $h_transdate->finish();
925   });
926
927   $main::lxdebug->leave_sub();
928 }
929
930 sub delete_transaction {
931   $main::lxdebug->enter_sub();
932
933   my $self     = shift;
934   my %params   = @_;
935
936   Common::check_params(\%params, qw(trans_id));
937
938   my $myconfig = \%main::myconfig;
939   my $form     = $main::form;
940
941   my $dbh      = $params{dbh} || SL::DB->client->dbh;
942
943   SL::DB->client->with_transaction(sub {
944     do_query($form, $dbh, qq|UPDATE ar SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
945     do_query($form, $dbh, qq|UPDATE ap SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
946     do_query($form, $dbh, qq|UPDATE gl SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
947
948     do_query($form, $dbh, qq|DELETE FROM ar        WHERE id       = ?|, conv_i($params{trans_id}));
949     do_query($form, $dbh, qq|DELETE FROM ap        WHERE id       = ?|, conv_i($params{trans_id}));
950     do_query($form, $dbh, qq|DELETE FROM gl        WHERE id       = ?|, conv_i($params{trans_id}));
951     do_query($form, $dbh, qq|DELETE FROM acc_trans WHERE trans_id = ?|, conv_i($params{trans_id}));
952   });
953
954   $main::lxdebug->leave_sub();
955 }
956
957 1;