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: Verkaufsrechnungen, bei denen Steuern verbucht wurden, obwohl
 292 # kein Steuerschlüssel eingetragen ist.
 293 sub _check_missing_taxkeys_in_invoices {
 294   $::lxdebug->enter_sub;
 295
 296   my $self        = shift;
 297   my %params      = @_;
 298   my $transaction = $params{transaction};
 299   my $found_broken = 0;
 300
 301   $::lxdebug->leave_sub and return 0
 302     if    !$transaction->[0]->{invoice};
 303
 304   my @sub_transactions = $self->_group_sub_transactions($transaction);
 305
 306   for my $sub_transaction (@sub_transactions) {
 307     $::lxdebug->leave_sub and return 0
 308       if    _is_split_transaction($sub_transaction)
 309          || _is_simple_transaction($sub_transaction);
 310
 311     my $split_side_entries = _get_splitted_side($sub_transaction);
 312     my $num_tax_rows;
 313     my $num_taxed_rows;
 314     for my $entry (@{ $split_side_entries }) {
 315       my $is_tax = grep { m/(?:AP_tax|AR_tax)/ } keys %{ $entry->{chartlinks} };
 316
 317       $num_tax_rows++   if  $is_tax;
 318       $num_taxed_rows++ if !$is_tax && $entry->{tax_key} != 0;
 319     }
 320
 321     # now if this has tax rows but NO taxed rows, something is wrong.
 322     if ($num_tax_rows > 0 && $num_taxed_rows == 0) {
 323       $params{problem}->{type} = 'missing_taxkeys_in_invoices';
 324       push @{ $self->{missing_taxkeys_in_invoices} ||= [] }, $params{problem};
 325       $found_broken = 1;
 326     }
 327   }
 328
 329   $::lxdebug->leave_sub;
 330
 331   return $found_broken;
 332 }
 333
 334 # Problemfall: Kreditorenbuchungen, bei denen mit Umsatzsteuerschlüsseln
 335 # gebucht wurde und Debitorenbuchungen, bei denen mit Vorsteuerschlüsseln
 336 # gebucht wurde.
 337 sub _check_trans_ap_ar_wrong_taxkeys {
 338   $main::lxdebug->enter_sub();
 339
 340   my $self   = shift;
 341   my %params = @_;
 342
 343   my $retval = 0;
 344
 345   if (!$params{transaction}->[0]->{invoice}
 346       && ((   ($params{transaction}->[0]->{module} eq 'ap')
 347           && (first { my $taxkey = $_->{taxkey}; first { $taxkey == $_ } (2, 3, 12, 13) } @{ $params{transaction} }))
 348          ||
 349          (   ($params{transaction}->[0]->{module} eq 'ar')
 350           && (first { my $taxkey = $_->{taxkey}; first { $taxkey == $_ } (8, 9, 18, 19) } @{ $params{transaction} })))) {
 351     $params{problem}->{type} = 'ap_ar_wrong_taxkeys';
 352     push @{ $self->{ap_ar_taxkey_problems} }, $params{problem};
 353
 354     $retval = 1;
 355   }
 356
 357   $main::lxdebug->leave_sub();
 358
 359   return $retval;
 360 }
 361
 362 # Problemfall: Splitbuchungen, die mehrere Haben- und Sollkonten ansprechen.
 363 # Aber nur für Debitoren- und Kreditorenbuchungen, weil das bei Einkaufs- und
 364 # Verkaufsrechnungen hingegen völlig normal ist.
 365 sub _check_trans_split_multiple_credit_and_debit {
 366   $main::lxdebug->enter_sub();
 367
 368   my $self   = shift;
 369   my %params = @_;
 370
 371   my $retval = 0;
 372
 373   if (   !$params{transaction}->[0]->{invoice}
 374       && (1 < $params{data}->{credit}->{num})
 375       && (1 < $params{data}->{debit}->{num})) {
 376     $params{problem}->{type} = 'split_multiple_credit_and_debit';
 377     push @{ $self->{problems} }, $params{problem};
 378
 379     $retval = 1;
 380   }
 381
 382   $main::lxdebug->leave_sub();
 383
 384   return $retval;
 385 }
 386
 387 # Problemfall: Buchungen, bei denen Steuersummen nicht mit den Summen
 388 # übereinstimmen, die nach ausgewähltem Steuerschlüssel hätten auftreten müssen.
 389 sub _check_trans_wrong_taxkeys {
 390   $main::lxdebug->enter_sub();
 391
 392   my $self        = shift;
 393   my %params      = @_;
 394
 395   my $form        = $main::form;
 396
 397   my %data        = %{ $params{data} };
 398   my $transaction = $params{transaction};
 399
 400   if (   $transaction->[0]->{invoice}
 401       || $transaction->[0]->{ob_transaction}
 402       || $transaction->[0]->{cb_transaction}
 403       || (!scalar @{ $data{credit}->{entries} } && !scalar @{ $data{debit}->{entries} })
 404       || (   ($transaction->[0]->{module} eq 'gl')
 405           && (!scalar @{ $data{credit}->{entries} } || !scalar @{ $data{debit}->{entries} }))) {
 406     $main::lxdebug->leave_sub();
 407     return 0;
 408   }
 409
 410   my $retval = 0;
 411
 412   my ($side, $other_side);
 413   if (   (grep { $_->{taxkey} * 1 } @{ $data{credit}->{entries} })
 414       || (scalar @{ $data{credit}->{tax_entries} })) {
 415     $side       = 'credit';
 416     $other_side = 'debit';
 417
 418   } elsif (   (grep { $_->{taxkey} * 1 } @{ $data{debit}->{entries} })
 419            || (scalar @{ $data{debit}->{tax_entries} })) {
 420     $side       = 'debit';
 421     $other_side = 'credit';
 422   }
 423
 424   if (!$side) {
 425     $main::lxdebug->leave_sub();
 426     return 0;
 427   }
 428
 429   my $expected_tax          = 0;
 430   my %num_entries_per_chart = ();
 431   my $num_taxed_entries     = 0;
 432
 433   foreach my $entry (@{ $data{$side}->{entries} }) {
 434     my $taxinfo             = $params{all_taxes}->{taxkeys}->{$entry->{taxkey}} || { };
 435     $entry->{expected_tax}  = $entry->{amount} * $taxinfo->{taxrate};
 436     $expected_tax          += $entry->{expected_tax};
 437
 438     $num_taxed_entries++ if ($taxinfo->{taxrate} * 1);
 439
 440     my $chart_key = $entry->{chart_id} . "-" . $entry->{taxkey};
 441     $num_entries_per_chart{$chart_key} ||= 0;
 442     $num_entries_per_chart{$chart_key}++;
 443   }
 444
 445 #   $main::lxdebug->message(0, "side $side trans_id $transaction->[0]->{trans_id} expected tax $expected_tax actual tax $data{$side}->{tax_sum}");
 446
 447   if (abs($expected_tax - $data{$side}->{tax_sum}) >= (0.01 * ($num_taxed_entries + 1))) {
 448     if ($params{full_analysis}) {
 449       my $storno_mult = $data{$side}->{entries}->[0]->{is_storno} ? -1 : 1;
 450
 451       foreach my $entry (@{ $data{$other_side}->{entries} }) {
 452         $entry->{display_amount} = $form->round_amount(abs($entry->{amount}) * $storno_mult, 2);
 453       }
 454
 455       foreach my $entry (@{ $data{$side}->{entries} }) {
 456         $entry->{actual_tax}              = $form->round_amount(abs($entry->{tax_entry} ? $entry->{tax_entry}->{amount} : 0), 2);
 457         $entry->{expected_tax}            = $form->round_amount(abs($entry->{expected_tax}), 2);
 458         $entry->{taxkey_error}            =    ( $entry->{taxkey} && !$entry->{tax_entry})
 459                                             || (!$entry->{taxkey} &&  $entry->{tax_entry})
 460                                             || (abs($entry->{expected_tax} - $entry->{actual_tax}) >= 0.02);
 461         $entry->{tax_entry_acc_trans_id}  = $entry->{tax_entry}->{acc_trans_id};
 462         delete $entry->{tax_entry};
 463
 464         $entry->{display_amount}       = $form->round_amount(abs($entry->{amount}) * $storno_mult, 2);
 465         $entry->{display_actual_tax}   = $entry->{actual_tax}   * $storno_mult;
 466         $entry->{display_expected_tax} = $entry->{expected_tax} * $storno_mult;
 467
 468         if ($entry->{taxkey_error}) {
 469           $self->{negative_taxkey_filter} ||= {
 470             'ar' => { map { $_ => 1 } (   8, 9, 18, 19) },
 471             'ap' => { map { $_ => 1 } (1, 2, 3, 12, 13) },
 472             'gl' => { },
 473           };
 474
 475           $entry->{correct_taxkeys} = [];
 476
 477           my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $entry->{transdate});
 478
 479           foreach my $taxkey (sort { $a <=> $b } keys %{ $all_taxes{taxkeys} }) {
 480             next if ($self->{negative_taxkey_filter}->{ $entry->{module} }->{$taxkey});
 481
 482             my $tax_info = $all_taxes{taxkeys}->{$taxkey};
 483
 484             next if ((!$tax_info || (0 == $tax_info->{taxrate} * 1)) && $entry->{tax_entry_acc_trans_id});
 485
 486             push @{ $entry->{correct_taxkeys} }, {
 487               'taxkey'      => $taxkey,
 488               'tax'         => $form->round_amount(abs($entry->{amount}) * $tax_info->{taxrate}, 2),
 489               'description' => sprintf("%s %d%%", $tax_info->{taxdescription}, int($tax_info->{taxrate} * 100)),
 490             };
 491           }
 492         }
 493       }
 494     }
 495
 496     if (first { $_ > 1 } values %num_entries_per_chart) {
 497       $params{problem}->{type} = 'wrong_taxkeys';
 498     } else {
 499       $params{problem}->{type} = 'wrong_taxes';
 500     }
 501
 502     $params{problem}->{acc_trans} = { %data };
 503     push @{ $self->{problems} }, $params{problem};
 504
 505     $retval = 1;
 506   }
 507
 508   $main::lxdebug->leave_sub();
 509
 510   return $retval;
 511 }
 512
 513 # Inaktiver Code für das Erraten möglicher Verteilungen von
 514 # Steuerschlüsseln. Deaktiviert, weil er exponentiell Zeit
 515 # benötigt.
 516
 517 #       if (abs($expected_tax - $data{$side}->{tax_sum}) >= 0.02) {
 518 #         my @potential_taxkeys = $trans_type eq 'AP' ? (0, 8, 9) : (0, 1, 2, 3);
 519
 520 #         $main::lxdebug->dump(0, "pota", \@potential_taxkeys);
 521
 522 #         # Über alle Kombinationen aus Buchungssätzen und potenziellen Steuerschlüsseln
 523 #         # iterieren und jeweils die Summe ermitteln.
 524 #         my $num_entries    = scalar @{ $data{$side}->{entries} };
 525 #         my @taxkey_indices = (0) x $num_entries;
 526
 527 #         my @solutions      = ();
 528
 529 #         my $start_time     = time();
 530
 531 #         $main::lxdebug->message(0, "num_entries $num_entries");
 532
 533 #         while ($num_entries == scalar @taxkey_indices) {
 534 #           my @tax_cache = ();
 535
 536 #           # Berechnen der Steuersumme für die aktuell angenommenen Steuerschlüssel.
 537 #           my $tax_sum = 0;
 538 #           foreach my $i (0 .. $num_entries - 1) {
 539 #             my $taxkey      = $potential_taxkeys[$taxkey_indices[$i]];
 540 #             my $entry       = $data{$side}->{entries}->[$i];
 541 #             my $taxinfo     = $all_taxes{taxkeys}->{ $taxkey } || { };
 542 #             $tax_cache[$i]  = $entry->{amount} * $taxinfo->{taxrate};
 543 #             $tax_sum       += $tax_cache[$i];
 544 #           }
 545
 546 #           # Entspricht die Steuersumme mit den aktuell angenommenen Steuerschlüsseln
 547 #           # der verbuchten Steuersumme? Wenn ja, dann ist das eine potenzielle
 548 #           # Lösung.
 549 #           if (abs($tax_sum - $data{$side}->{tax_sum}) < 0.02) {
 550 #             push @solutions, {
 551 #               'taxkeys' => [ @potential_taxkeys[@taxkey_indices] ],
 552 #               'taxes'   => [ @tax_cache ],
 553 #             }
 554 #           }
 555
 556 #           # Weiterzählen der Steuerschlüsselindices zum Interieren über
 557 #           # alle möglichen Kombinationen.
 558 #           my $i = 0;
 559 #           while (1) {
 560 #             $taxkey_indices[$i]++;
 561 #             last if ($taxkey_indices[$i] < scalar @potential_taxkeys);
 562
 563 #             $taxkey_indices[$i] = 0;
 564 #             $i++;
 565 #           }
 566
 567 #           my $now = time();
 568 #           if (($now - $start_time) >= 5) {
 569 #             $main::lxdebug->message(0, "  " . join("", @taxkey_indices));
 570 #             $start_time = $now;
 571 #           }
 572 #         }
 573
 574 #         foreach my $solution (@solutions) {
 575 #           $solution->{rows}    = [];
 576 #           $solution->{changes} = [];
 577 #           my $error            = 0;
 578
 579 #           foreach my $i (0 .. $num_entries - 1) {
 580 #             if ($solution->{taxes}->[$i]) {
 581 #               my $tax_rounded          = $form->round_amount($solution->{taxes}->[$i] + $error, 2);
 582 #               $error                   = $solution->{taxes}->[$i] + $error - $tax_rounded;
 583 #               $solution->{taxes}->[$i] = $tax_rounded;
 584 #             }
 585
 586 #             my $entry     = $data{$side}->{entries}->[$i];
 587 #             my $tax_entry = $all_taxes{taxkeys}->{ $solution->{taxkeys}->[$i] };
 588
 589 #             push @{ $solution->{rows} }, {
 590 #               %{ $entry },
 591 #               %{ $tax_entry },
 592 #               'taxamount' => $solution->{taxes}->[$i],
 593 #             };
 594
 595 #             $solution->{rows}->[$i]->{taxdescription} .= ' ' . $form->format_amount(\%myconfig, $tax_entry->{taxrate} * 100) . ' %';
 596
 597 #             push @{ $solution->{changes} }, {
 598 #               'acc_trans_id'    => $entry->{acc_trans_id},
 599 #               'taxkey' => $solution->{taxkeys}->[$i],
 600 #             };
 601 #           }
 602
 603 #           push @{ $solution->{rows} }, @{ $data{$other_side}->{entries} };
 604
 605 #           delete @{ $solution }{ qw(taxes taxkeys) };
 606 #         }
 607
 608 #         $problem->{type}      = 'wrong_taxkeys';
 609 #         $problem->{solutions} = [ @solutions ];
 610 #         $problem->{acc_trans} = { %data };
 611 #         push @problems, $problem;
 612
 613 #         next;
 614 #       }
 615
 616 sub analyze {
 617   $main::lxdebug->enter_sub();
 618
 619   my $self         = shift;
 620   my %params       = @_;
 621
 622   my $myconfig     = \%main::myconfig;
 623   my $form         = $main::form;
 624
 625   my $dbh          = $params{dbh} || $form->get_standard_dbh($myconfig);
 626
 627   my @transactions = $self->_fetch_transactions(%params, 'dbh' => $dbh);
 628
 629   if (!scalar @transactions) {
 630     $main::lxdebug->leave_sub();
 631     return ();
 632   }
 633
 634   my $callback = $params{callback} ? '&callback=' . $params{callback} : '';
 635
 636   $self->{problems}                          = [];
 637   $self->{ap_ar_taxkey_problems}             = [];
 638   $self->{invoice_inventory_taxkey_problems} = [];
 639
 640   foreach my $transaction (@transactions) {
 641     my %common_args = $self->_prepare_data('transaction' => $transaction, 'callback' => $callback, 'full_analysis' => $params{full_analysis});
 642
 643     next if ($self->_check_trans_ap_ar_wrong_taxkeys(%common_args));
 644     next if ($self->_check_trans_invoices_inventory_with_taxkeys(%common_args));
 645     next if ($self->_check_trans_split_multiple_credit_and_debit(%common_args));
 646     next if ($self->_check_trans_wrong_taxkeys(%common_args));
 647   }
 648
 649   my @problems = @{ $self->{problems} };
 650
 651   if (0 != scalar @{ $self->{ap_ar_taxkey_problems} }) {
 652     my $problem = {
 653       'type'        => 'ap_ar_wrong_taxkeys',
 654       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{ap_ar_taxkey_problems} } ],
 655       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{ap_ar_taxkey_problems} } ],
 656     };
 657     unshift @problems, $problem;
 658   }
 659
 660   if (0 != scalar @{ $self->{invoice_inventory_taxkey_problems} }) {
 661     my $problem = {
 662       'type'        => 'invoice_inventory_with_taxkeys',
 663       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{invoice_inventory_taxkey_problems} } ],
 664       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{invoice_inventory_taxkey_problems} } ],
 665     };
 666     unshift @problems, $problem;
 667   }
 668
 669   if (0 != scalar @{ $self->{missing_taxkeys_in_invoices} }) {
 670     my $problem = {
 671       'type'        => 'missing_taxkeys_in_invoices',
 672       'ap_problems' => [ grep { $_->{data}->{module} eq 'ap' } @{ $self->{missing_taxkeys_in_invoices} } ],
 673       'ar_problems' => [ grep { $_->{data}->{module} eq 'ar' } @{ $self->{missing_taxkeys_in_invoices} } ],
 674     };
 675     unshift @problems, $problem;
 676   }
 677
 678   $main::lxdebug->leave_sub();
 679
 680 #  $::lxdebug->dump(0, 'problems:', \@problems);
 681
 682   return @problems;
 683 }
 684
 685 sub fix_ap_ar_wrong_taxkeys {
 686   $main::lxdebug->enter_sub();
 687
 688   my $self     = shift;
 689   my %params   = @_;
 690
 691   my $myconfig = \%main::myconfig;
 692   my $form     = $main::form;
 693
 694   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 695
 696   my $query    = qq|SELECT 'ap' AS module,
 697                       at.acc_trans_id, at.trans_id, at.chart_id, at.amount, at.taxkey, at.transdate,
 698                       c.link
 699                     FROM acc_trans at
 700                     LEFT JOIN chart c ON (at.chart_id = c.id)
 701                     WHERE (trans_id IN (SELECT id FROM ap WHERE NOT invoice))
 702                       AND (taxkey IN (2, 3, 12, 13))
 703
 704                     UNION
 705
 706                     SELECT 'ar' AS module,
 707                       at.acc_trans_id, at.trans_id, at.chart_id, at.amount, at.taxkey, at.transdate,
 708                       c.link
 709                     FROM acc_trans at
 710                     LEFT JOIN chart c ON (at.chart_id = c.id)
 711                     WHERE (trans_id IN (SELECT id FROM ar WHERE NOT invoice))
 712                       AND (taxkey IN (8, 9, 18, 19))
 713
 714                     ORDER BY trans_id, acc_trans_id|;
 715
 716   my $sth      = prepare_execute_query($form, $dbh, $query);
 717   my @transactions;
 718
 719   while (my $ref = $sth->fetchrow_hashref()) {
 720     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
 721       push @transactions, [];
 722     }
 723
 724     push @{ $transactions[-1] }, $ref;
 725   }
 726
 727   $sth->finish();
 728
 729   @transactions = grep { (scalar(@transactions) % 2) == 0 } @transactions;
 730
 731   my %taxkey_replacements = (
 732      2 =>  8,
 733      3 =>  9,
 734      8 =>  2,
 735      9 =>  3,
 736     12 => 18,
 737     13 => 19,
 738     18 => 12,
 739     19 => 13,
 740     );
 741
 742   my %bad_taxkeys = (
 743     'ap' => { map { $_ => 1 } (2, 3, 12, 13) },
 744     'ar' => { map { $_ => 1 } (8, 9, 18, 19) },
 745     );
 746
 747   my @corrections = ();
 748
 749   foreach my $transaction (@transactions) {
 750
 751     for (my $i = 0; $i < scalar @{ $transaction }; $i += 2) {
 752       my ($non_tax_idx, $tax_idx) = abs($transaction->[$i]->{amount}) > abs($transaction->[$i + 1]->{amount}) ? ($i, $i + 1) : ($i + 1, $i);
 753       my ($non_tax,     $tax)     = @{ $transaction }[$non_tax_idx, $tax_idx];
 754
 755       last if ($non_tax->{link} =~ m/(:?AP|AR)_tax(:?$|:)/);
 756       last if ($tax->{link}     !~ m/(:?AP|AR)_tax(:?$|:)/);
 757
 758       next if (!$bad_taxkeys{ $non_tax->{module} }->{ $non_tax->{taxkey} });
 759
 760       my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $non_tax->{transdate});
 761
 762       push @corrections, ({ 'acc_trans_id' => $non_tax->{acc_trans_id},
 763                             'taxkey'       => $taxkey_replacements{$non_tax->{taxkey}},
 764                           },
 765                           {
 766                             'acc_trans_id' => $tax->{acc_trans_id},
 767                             'taxkey'       => $taxkey_replacements{$non_tax->{taxkey}},
 768                             'chart_id'     => $all_taxes{taxkeys}->{ $taxkey_replacements{$non_tax->{taxkey}} }->{taxchart_id},
 769                           });
 770     }
 771   }
 772
 773   if (scalar @corrections) {
 774     my $q_taxkey_only     = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
 775     my $h_taxkey_only     = prepare_query($form, $dbh, $q_taxkey_only);
 776
 777     my $q_taxkey_chart_id = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
 778     my $h_taxkey_chart_id = prepare_query($form, $dbh, $q_taxkey_chart_id);
 779
 780     foreach my $entry (@corrections) {
 781       if ($entry->{chart_id}) {
 782         do_statement($form, $h_taxkey_chart_id, $q_taxkey_chart_id, $entry->{taxkey}, $entry->{chart_id}, $entry->{acc_trans_id});
 783       } else {
 784         do_statement($form, $h_taxkey_only, $q_taxkey_only, $entry->{taxkey}, $entry->{acc_trans_id});
 785       }
 786     }
 787
 788     $h_taxkey_only->finish();
 789     $h_taxkey_chart_id->finish();
 790
 791     $dbh->commit() unless ($params{dbh});
 792   }
 793
 794   $main::lxdebug->leave_sub();
 795 }
 796
 797 sub fix_invoice_inventory_with_taxkeys {
 798   $main::lxdebug->enter_sub();
 799
 800   my $self     = shift;
 801   my %params   = @_;
 802
 803   my $myconfig = \%main::myconfig;
 804   my $form     = $main::form;
 805
 806   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 807
 808   my $query    = qq|SELECT at.*, c.link
 809                     FROM acc_trans at
 810                     LEFT JOIN ar      ON (at.trans_id = ar.id)
 811                     LEFT JOIN chart c ON (at.chart_id = c.id)
 812                     WHERE (ar.invoice)
 813
 814                     UNION
 815
 816                     SELECT at.*, c.link
 817                     FROM acc_trans at
 818                     LEFT JOIN ap      ON (at.trans_id = ap.id)
 819                     LEFT JOIN chart c ON (at.chart_id = c.id)
 820                     WHERE (ap.invoice)
 821
 822                     ORDER BY trans_id, acc_trans_id|;
 823
 824   my $sth      = prepare_execute_query($form, $dbh, $query);
 825   my @transactions;
 826
 827   while (my $ref = $sth->fetchrow_hashref()) {
 828     if ((!scalar @transactions) || ($ref->{trans_id} != $transactions[-1]->[0]->{trans_id})) {
 829       push @transactions, [];
 830     }
 831
 832     push @{ $transactions[-1] }, $ref;
 833   }
 834
 835   $sth->finish();
 836
 837   my @corrections = ();
 838
 839   foreach my $transaction (@transactions) {
 840     my @sub_transactions = $self->_group_sub_transactions($transaction);
 841
 842     foreach my $sub_transaction (@sub_transactions) {
 843       my $is_cogs = first { $_->{link} =~ m/IC_cogs/ } @{ $sub_transaction };
 844       next unless ($is_cogs);
 845
 846       foreach my $entry (@{ $sub_transaction }) {
 847         next if ($entry->{taxkey} == 0);
 848         push @corrections, $entry->{acc_trans_id};
 849       }
 850     }
 851   }
 852
 853   if (@corrections) {
 854     $query = qq|UPDATE acc_trans SET taxkey = 0 WHERE acc_trans_id = ?|;
 855     $sth   = prepare_query($form, $dbh, $query);
 856
 857     foreach my $acc_trans_id (@corrections) {
 858       do_statement($form, $sth, $query, $acc_trans_id);
 859     }
 860
 861     $sth->finish();
 862
 863     $dbh->commit() unless ($params{dbh});
 864 #     $dbh->rollback();
 865   }
 866
 867   $main::lxdebug->leave_sub();
 868 }
 869
 870 sub fix_wrong_taxkeys {
 871   $main::lxdebug->enter_sub();
 872
 873   my $self     = shift;
 874   my %params   = @_;
 875
 876   Common::check_params(\%params, qw(fixes));
 877
 878   my $myconfig = \%main::myconfig;
 879   my $form     = $main::form;
 880
 881   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 882
 883   my $q_taxkey_only  = qq|UPDATE acc_trans SET taxkey = ? WHERE acc_trans_id = ?|;
 884   my $h_taxkey_only  = prepare_query($form, $dbh, $q_taxkey_only);
 885
 886   my $q_taxkey_chart = qq|UPDATE acc_trans SET taxkey = ?, chart_id = ? WHERE acc_trans_id = ?|;
 887   my $h_taxkey_chart = prepare_query($form, $dbh, $q_taxkey_chart);
 888
 889   my $q_transdate    = qq|SELECT transdate FROM acc_trans WHERE acc_trans_id = ?|;
 890   my $h_transdate    = prepare_query($form, $dbh, $q_transdate);
 891
 892   foreach my $fix (@{ $params{fixes} }) {
 893     next unless ($fix->{acc_trans_id});
 894
 895     do_statement($form, $h_taxkey_only, $q_taxkey_only, conv_i($fix->{taxkey}), conv_i($fix->{acc_trans_id}));
 896
 897     next unless ($fix->{tax_entry_acc_trans_id});
 898
 899     do_statement($form, $h_transdate, $q_transdate, conv_i($fix->{tax_entry_acc_trans_id}));
 900     my ($transdate) = $h_transdate->fetchrow_array();
 901
 902     my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $transdate);
 903     my $tax_info  = $all_taxes{taxkeys}->{ $fix->{taxkey} };
 904
 905     next unless ($tax_info);
 906
 907     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}));
 908   }
 909
 910   $h_taxkey_only->finish();
 911   $h_taxkey_chart->finish();
 912   $h_transdate->finish();
 913
 914 #   $dbh->rollback();
 915   $dbh->commit() unless ($params{dbh});
 916
 917   $main::lxdebug->leave_sub();
 918 }
 919
 920 sub delete_transaction {
 921   $main::lxdebug->enter_sub();
 922
 923   my $self     = shift;
 924   my %params   = @_;
 925
 926   Common::check_params(\%params, qw(trans_id));
 927
 928   my $myconfig = \%main::myconfig;
 929   my $form     = $main::form;
 930
 931   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 932
 933   do_query($form, $dbh, qq|UPDATE ar SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
 934   do_query($form, $dbh, qq|UPDATE ap SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
 935   do_query($form, $dbh, qq|UPDATE gl SET storno_id = NULL WHERE storno_id = ?|, conv_i($params{trans_id}));
 936
 937   do_query($form, $dbh, qq|DELETE FROM ar        WHERE id       = ?|, conv_i($params{trans_id}));
 938   do_query($form, $dbh, qq|DELETE FROM ap        WHERE id       = ?|, conv_i($params{trans_id}));
 939   do_query($form, $dbh, qq|DELETE FROM gl        WHERE id       = ?|, conv_i($params{trans_id}));
 940   do_query($form, $dbh, qq|DELETE FROM acc_trans WHERE trans_id = ?|, conv_i($params{trans_id}));
 941
 942 #   $dbh->rollback();
 943   $dbh->commit() unless ($params{dbh});
 944
 945   $main::lxdebug->leave_sub();
 946 }
 947
 948 1;