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;