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