SL/AccTransCorrections.pm

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