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   if (0 != scalar @{ $self->{ap_ar_taxkey_problems} }) {
 653     my $problem = {
 654       'type'        => 'ap_ar_wrong_taxkeys',
 655       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{ap_ar_taxkey_problems} } ],
 656       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{ap_ar_taxkey_problems} } ],
 657     };
 658     unshift @problems, $problem;
 659   }
 660
 661   if (0 != scalar @{ $self->{invoice_inventory_taxkey_problems} }) {
 662     my $problem = {
 663       'type'        => 'invoice_inventory_with_taxkeys',
 664       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{invoice_inventory_taxkey_problems} } ],
 665       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{invoice_inventory_taxkey_problems} } ],
 666     };
 667     unshift @problems, $problem;
 668   }
 669
 670   if (0 != scalar @{ $self->{missing_taxkeys_in_invoices} }) {
 671     my $problem = {
 672       'type'        => 'missing_taxkeys_in_invoices',
 673       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{missing_taxkeys_in_invoices} } ],
 674       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{missing_taxkeys_in_invoices} } ],
 675     };
 676     unshift @problems, $problem;
 677   }
 678
 679   $main::lxdebug->leave_sub();
 680
 681 #  $::lxdebug->dump(0, 'problems:', \@problems);
 682
 683   return @problems;
 684 }
 685
 686 sub fix_ap_ar_wrong_taxkeys {
 687   $main::lxdebug->enter_sub();
 688
 689   my $self     = shift;
 690   my %params   = @_;
 691
 692   my $myconfig = \%main::myconfig;
 693   my $form     = $main::form;
 694
 695   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 696
 697   my $query    = qq|SELECT 'ap' AS module,
 698                       at.acc_trans_id, at.trans_id, at.chart_id, at.amount, at.taxkey, at.transdate,
 699                       c.link
 700                     FROM acc_trans at
 701                     LEFT JOIN chart c ON (at.chart_id = c.id)
 702                     WHERE (trans_id IN (SELECT id FROM ap WHERE NOT invoice))
 703                       AND (taxkey IN (2, 3, 12, 13))
 704
 705                     UNION
 706
 707                     SELECT 'ar' AS module,
 708                       at.acc_trans_id, at.trans_id, at.chart_id, at.amount, at.taxkey, at.transdate,
 709                       c.link
 710                     FROM acc_trans at
 711                     LEFT JOIN chart c ON (at.chart_id = c.id)
 712                     WHERE (trans_id IN (SELECT id FROM ar WHERE NOT invoice))
 713                       AND (taxkey IN (8, 9, 18, 19))
 714
 715                     ORDER BY trans_id, acc_trans_id|;
 716
 717   my $sth      = prepare_execute_query($form, $dbh, $query);
 718   my @transactions;
 719
 720   while (my $ref = $sth->fetchrow_hashref()) {
 721     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
 722       push @transactions, [];
 723     }
 724
 725     push @{ $transactions[-1] }, $ref;
 726   }
 727
 728   $sth->finish();
 729
 730   @transactions = grep { (scalar(@transactions) % 2) == 0 } @transactions;
 731
 732   my %taxkey_replacements = (
 733      2 =>  8,
 734      3 =>  9,
 735      8 =>  2,
 736      9 =>  3,
 737     12 => 18,
 738     13 => 19,
 739     18 => 12,
 740     19 => 13,
 741     );
 742
 743   my %bad_taxkeys = (
 744     'ap' => { map { $_ => 1 } (2, 3, 12, 13) },
 745     'ar' => { map { $_ => 1 } (8, 9, 18, 19) },
 746     );
 747
 748   my @corrections = ();
 749
 750   foreach my $transaction (@transactions) {
 751
 752     for (my $i = 0; $i < scalar @{ $transaction }; $i += 2) {
 753       my ($non_tax_idx, $tax_idx) = abs($transaction->[$i]->{amount}) > abs($transaction->[$i + 1]->{amount}) ? ($i, $i + 1) : ($i + 1, $i);
 754       my ($non_tax,     $tax)     = @{ $transaction }[$non_tax_idx, $tax_idx];
 755
 756       last if ($non_tax->{link} =~ m/(:?AP|AR)_tax(:?$|:)/);
 757       last if ($tax->{link}     !~ m/(:?AP|AR)_tax(:?$|:)/);
 758
 759       next if (!$bad_taxkeys{ $non_tax->{module} }->{ $non_tax->{taxkey} });
 760
 761       my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $non_tax->{transdate});
 762
 763       push @corrections, ({ 'acc_trans_id' => $non_tax->{acc_trans_id},
 764                             'taxkey'       => $taxkey_replacements{$non_tax->{taxkey}},
 765                           },
 766                           {
 767                             'acc_trans_id' => $tax->{acc_trans_id},
 768                             'taxkey'       => $taxkey_replacements{$non_tax->{taxkey}},
 769                             'chart_id'     => $all_taxes{taxkeys}->{ $taxkey_replacements{$non_tax->{taxkey}} }->{taxchart_id},
 770                           });
 771     }
 772   }
 773
 774   if (scalar @corrections) {
 775     my $q_taxkey_only     = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
 776     my $h_taxkey_only     = prepare_query($form, $dbh, $q_taxkey_only);
 777
 778     my $q_taxkey_chart_id = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
 779     my $h_taxkey_chart_id = prepare_query($form, $dbh, $q_taxkey_chart_id);
 780
 781     foreach my $entry (@corrections) {
 782       if ($entry->{chart_id}) {
 783         do_statement($form, $h_taxkey_chart_id, $q_taxkey_chart_id, $entry->{taxkey}, $entry->{chart_id}, $entry->{acc_trans_id});
 784       } else {
 785         do_statement($form, $h_taxkey_only, $q_taxkey_only, $entry->{taxkey}, $entry->{acc_trans_id});
 786       }
 787     }
 788
 789     $h_taxkey_only->finish();
 790     $h_taxkey_chart_id->finish();
 791
 792     $dbh->commit() unless ($params{dbh});
 793   }
 794
 795   $main::lxdebug->leave_sub();
 796 }
 797
 798 sub fix_invoice_inventory_with_taxkeys {
 799   $main::lxdebug->enter_sub();
 800
 801   my $self     = shift;
 802   my %params   = @_;
 803
 804   my $myconfig = \%main::myconfig;
 805   my $form     = $main::form;
 806
 807   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 808
 809   my $query    = qq|SELECT at.*, c.link
 810                     FROM acc_trans at
 811                     LEFT JOIN ar      ON (at.trans_id = ar.id)
 812                     LEFT JOIN chart c ON (at.chart_id = c.id)
 813                     WHERE (ar.invoice)
 814
 815                     UNION
 816
 817                     SELECT at.*, c.link
 818                     FROM acc_trans at
 819                     LEFT JOIN ap      ON (at.trans_id = ap.id)
 820                     LEFT JOIN chart c ON (at.chart_id = c.id)
 821                     WHERE (ap.invoice)
 822
 823                     ORDER BY trans_id, acc_trans_id|;
 824
 825   my $sth      = prepare_execute_query($form, $dbh, $query);
 826   my @transactions;
 827
 828   while (my $ref = $sth->fetchrow_hashref()) {
 829     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
 830       push @transactions, [];
 831     }
 832
 833     push @{ $transactions[-1] }, $ref;
 834   }
 835
 836   $sth->finish();
 837
 838   my @corrections = ();
 839
 840   foreach my $transaction (@transactions) {
 841     my @sub_transactions = $self->_group_sub_transactions($transaction);
 842
 843     foreach my $sub_transaction (@sub_transactions) {
 844       my $is_cogs = first { $_->{link} =~ m/IC_cogs/ } @{ $sub_transaction };
 845       next unless ($is_cogs);
 846
 847       foreach my $entry (@{ $sub_transaction }) {
 848         next if ($entry->{taxkey} == 0);
 849         push @corrections, $entry->{acc_trans_id};
 850       }
 851     }
 852   }
 853
 854   if (@corrections) {
 855     $query = qq|UPDATE acc_trans SET taxkey = 0 WHERE acc_trans_id = ?|;
 856     $sth   = prepare_query($form, $dbh, $query);
 857
 858     foreach my $acc_trans_id (@corrections) {
 859       do_statement($form, $sth, $query, $acc_trans_id);
 860     }
 861
 862     $sth->finish();
 863
 864     $dbh->commit() unless ($params{dbh});
 865 #     $dbh->rollback();
 866   }
 867
 868   $main::lxdebug->leave_sub();
 869 }
 870
 871 sub fix_wrong_taxkeys {
 872   $main::lxdebug->enter_sub();
 873
 874   my $self     = shift;
 875   my %params   = @_;
 876
 877   Common::check_params(\%params, qw(fixes));
 878
 879   my $myconfig = \%main::myconfig;
 880   my $form     = $main::form;
 881
 882   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 883
 884   my $q_taxkey_only  = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
 885   my $h_taxkey_only  = prepare_query($form, $dbh, $q_taxkey_only);
 886
 887   my $q_taxkey_chart = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
 888   my $h_taxkey_chart = prepare_query($form, $dbh, $q_taxkey_chart);
 889
 890   my $q_transdate    = qq|SELECT transdate FROM acc_trans WHERE acc_trans_id = ?|;
 891   my $h_transdate    = prepare_query($form, $dbh, $q_transdate);
 892
 893   foreach my $fix (@{ $params{fixes} }) {
 894     next unless ($fix->{acc_trans_id});
 895
 896     do_statement($form, $h_taxkey_only, $q_taxkey_only, conv_i($fix->{taxkey}), conv_i($fix->{acc_trans_id}));
 897
 898     next unless ($fix->{tax_entry_acc_trans_id});
 899
 900     do_statement($form, $h_transdate, $q_transdate, conv_i($fix->{tax_entry_acc_trans_id}));
 901     my ($transdate) = $h_transdate->fetchrow_array();
 902
 903     my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $transdate);
 904     my $tax_info  = $all_taxes{taxkeys}->{ $fix->{taxkey} };
 905
 906     next unless ($tax_info);
 907
 908     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}));
 909   }
 910
 911   $h_taxkey_only->finish();
 912   $h_taxkey_chart->finish();
 913   $h_transdate->finish();
 914
 915 #   $dbh->rollback();
 916   $dbh->commit() unless ($params{dbh});
 917
 918   $main::lxdebug->leave_sub();
 919 }
 920
 921 sub delete_transaction {
 922   $main::lxdebug->enter_sub();
 923
 924   my $self     = shift;
 925   my %params   = @_;
 926
 927   Common::check_params(\%params, qw(trans_id));
 928
 929   my $myconfig = \%main::myconfig;
 930   my $form     = $main::form;
 931
 932   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 933
 934   do_query($form, $dbh, qq|UPDATE ar SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
 935   do_query($form, $dbh, qq|UPDATE ap SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
 936   do_query($form, $dbh, qq|UPDATE gl SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
 937
 938   do_query($form, $dbh, qq|DELETE FROM ar        WHERE id       = ?|, conv_i($params{trans_id}));
 939   do_query($form, $dbh, qq|DELETE FROM ap        WHERE id       = ?|, conv_i($params{trans_id}));
 940   do_query($form, $dbh, qq|DELETE FROM gl        WHERE id       = ?|, conv_i($params{trans_id}));
 941   do_query($form, $dbh, qq|DELETE FROM acc_trans WHERE trans_id = ?|, conv_i($params{trans_id}));
 942
 943 #   $dbh->rollback();
 944   $dbh->commit() unless ($params{dbh});
 945
 946   $main::lxdebug->leave_sub();
 947 }
 948
 949 1;