doc/ Trigram Erweiterung als Musskriterium für das Upgrade genannt
[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->client->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       1;
800     }) or do { die SL::DB->client->error };
801   }
802
803   $main::lxdebug->leave_sub();
804 }
805
806 sub fix_invoice_inventory_with_taxkeys {
807   $main::lxdebug->enter_sub();
808
809   my $self     = shift;
810   my %params   = @_;
811
812   # ist nur für bestandsmethode notwendig. bei der Aufwandsmethode
813   # können Warenkonten mit Steuerschlüssel sein (5400 in SKR04)
814   return 0 if $::instance_conf->get_inventory_system eq 'periodic';
815
816   my $myconfig = \%main::myconfig;
817   my $form     = $main::form;
818
819   my $dbh      = $params{dbh} || SL::DB->client->dbh;
820
821   my $query    = qq|SELECT at.*, c.link
822                     FROM acc_trans at
823                     LEFT JOIN ar      ON (at.trans_id = ar.id)
824                     LEFT JOIN chart c ON (at.chart_id = c.id)
825                     WHERE (ar.invoice)
826
827                     UNION
828
829                     SELECT at.*, c.link
830                     FROM acc_trans at
831                     LEFT JOIN ap      ON (at.trans_id = ap.id)
832                     LEFT JOIN chart c ON (at.chart_id = c.id)
833                     WHERE (ap.invoice)
834
835                     ORDER BY trans_id, acc_trans_id|;
836
837   my $sth      = prepare_execute_query($form, $dbh, $query);
838   my @transactions;
839
840   while (my $ref = $sth->fetchrow_hashref()) {
841     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
842       push @transactions, [];
843     }
844
845     push @{ $transactions[-1] }, $ref;
846   }
847
848   $sth->finish();
849
850   my @corrections = ();
851
852   foreach my $transaction (@transactions) {
853     my @sub_transactions = $self->_group_sub_transactions($transaction);
854
855     foreach my $sub_transaction (@sub_transactions) {
856       my $is_cogs = first { $_->{link} =~ m/IC_cogs/ } @{ $sub_transaction };
857       next unless ($is_cogs);
858
859       foreach my $entry (@{ $sub_transaction }) {
860         next if ($entry->{taxkey} == 0);
861         push @corrections, $entry->{acc_trans_id};
862       }
863     }
864   }
865
866   if (@corrections) {
867     SL::DB->client->with_transaction(sub {
868       $query = qq|UPDATE acc_trans SET taxkey = 0 WHERE acc_trans_id = ?|;
869       $sth   = prepare_query($form, $dbh, $query);
870
871       foreach my $acc_trans_id (@corrections) {
872         do_statement($form, $sth, $query, $acc_trans_id);
873       }
874
875       $sth->finish();
876       1;
877     }) or do { die SL::DB->client->error };
878   }
879
880   $main::lxdebug->leave_sub();
881 }
882
883 sub fix_wrong_taxkeys {
884   $main::lxdebug->enter_sub();
885
886   my $self     = shift;
887   my %params   = @_;
888
889   Common::check_params(\%params, qw(fixes));
890
891   my $myconfig = \%main::myconfig;
892   my $form     = $main::form;
893
894   my $dbh      = $params{dbh} || SL::DB->client->dbh;
895
896   SL::DB->client->with_transaction(sub {
897     my $q_taxkey_only  = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
898     my $h_taxkey_only  = prepare_query($form, $dbh, $q_taxkey_only);
899
900     my $q_taxkey_chart = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
901     my $h_taxkey_chart = prepare_query($form, $dbh, $q_taxkey_chart);
902
903     my $q_transdate    = qq|SELECT transdate FROM acc_trans WHERE acc_trans_id = ?|;
904     my $h_transdate    = prepare_query($form, $dbh, $q_transdate);
905
906     foreach my $fix (@{ $params{fixes} }) {
907       next unless ($fix->{acc_trans_id});
908
909       do_statement($form, $h_taxkey_only, $q_taxkey_only, conv_i($fix->{taxkey}), conv_i($fix->{acc_trans_id}));
910
911       next unless ($fix->{tax_entry_acc_trans_id});
912
913       do_statement($form, $h_transdate, $q_transdate, conv_i($fix->{tax_entry_acc_trans_id}));
914       my ($transdate) = $h_transdate->fetchrow_array();
915
916       my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $transdate);
917       my $tax_info  = $all_taxes{taxkeys}->{ $fix->{taxkey} };
918
919       next unless ($tax_info);
920
921       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}));
922     }
923
924     $h_taxkey_only->finish();
925     $h_taxkey_chart->finish();
926     $h_transdate->finish();
927     1;
928   }) or do { die SL::DB->client->error };
929
930   $main::lxdebug->leave_sub();
931 }
932
933 sub delete_transaction {
934   $main::lxdebug->enter_sub();
935
936   my $self     = shift;
937   my %params   = @_;
938
939   Common::check_params(\%params, qw(trans_id));
940
941   my $myconfig = \%main::myconfig;
942   my $form     = $main::form;
943
944   my $dbh      = $params{dbh} || SL::DB->client->dbh;
945
946   SL::DB->client->with_transaction(sub {
947     do_query($form, $dbh, qq|UPDATE ar SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
948     do_query($form, $dbh, qq|UPDATE ap SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
949     do_query($form, $dbh, qq|UPDATE gl SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
950
951     do_query($form, $dbh, qq|DELETE FROM ar        WHERE id       = ?|, conv_i($params{trans_id}));
952     do_query($form, $dbh, qq|DELETE FROM ap        WHERE id       = ?|, conv_i($params{trans_id}));
953     do_query($form, $dbh, qq|DELETE FROM gl        WHERE id       = ?|, conv_i($params{trans_id}));
954     do_query($form, $dbh, qq|DELETE FROM acc_trans WHERE trans_id = ?|, conv_i($params{trans_id}));
955     1;
956   }) or do { die SL::DB->client->error };
957
958   $main::lxdebug->leave_sub();
959 }
960
961 1;