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