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