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