SL/BackgroundJob/SelfTest/NovoclonStrict.pm

   1 package SL::BackgroundJob::SelfTest::NovoclonStrict;
   2
   3 use utf8;
   4 use strict;
   5 use parent qw(SL::BackgroundJob::SelfTest::Base);
   6
   7 use DateTime;
   8 use List::MoreUtils qw(none notall);
   9 use SL::DB::DeliveryOrder;
  10 use SL::DB::Order;
  11 use SL::DB::PurchaseInvoice;
  12
  13 use Rose::Object::MakeMethods::Generic (
  14   'scalar --get_set_init' => [ qw(start_date) ],
  15 );
  16
  17 sub init_start_date {
  18   DateTime->new(day => 1, month => 1, year => DateTime->today->year);
  19 }
  20
  21
  22 sub run {
  23   my ($self) = @_;
  24
  25   $self->tester->plan(tests => 8);
  26
  27   $self->check_no_missing_invoices;
  28   $self->check_no_missing_deliveries;
  29   $self->check_no_missing_order_confirmations;
  30   $self->check_invoices_mailed;
  31   $self->check_order_confirmations_mailed;
  32   $self->check_quotations_mailed;
  33   $self->check_purchase_invoices_sums_against_purchase_orders;
  34   $self->check_purchase_invoices_sums_against_sales_orders;
  35 }
  36
  37 sub check_no_missing_invoices {
  38   my ($self) = @_;
  39
  40   my $days_delta           = 4;
  41   my $title                = "Alle Verkaufslieferscheine sind $days_delta Werktage nach Lieferterimin geschlossen.";
  42
  43   my $latest_reqdate       = DateTime->today_local->subtract_businessdays(days => $days_delta);
  44   my $open_delivery_orders = SL::DB::Manager::DeliveryOrder->get_all_sorted(where => ['!customer_id'  => undef,
  45                                                                                       '!cusordnumber' => { ilike => ['muster'] },
  46                                                                                       delivered       => 1,
  47                                                                                       or              => [closed => undef, closed => 0],
  48                                                                                       reqdate         => {le => $latest_reqdate},
  49                                                                                       transdate       => {ge => $self->start_date},]
  50   );
  51
  52   if (@$open_delivery_orders) {
  53     $self->tester->ok(0, $title);
  54     $self->tester->diag("Folgende Verkaufslieferscheine sind geliefert und nach Liefertermin länger als $days_delta Werktage offen. Vermutlich fehlt die Rechnung:");
  55     $self->tester->diag("Lieferschein-Nummer: " . $_->donumber) for @$open_delivery_orders;
  56
  57   } else {
  58     $self->tester->ok(1, $title);
  59   }
  60 }
  61
  62 sub check_no_missing_deliveries {
  63   my ($self) = @_;
  64
  65   my $days_delta     = 2;
  66   my $title          = "Alle offenen Auftragsbestätigungen mit Liefertermin vor mindestens $days_delta Werktagen haben eine Lieferung.";
  67
  68   my $latest_reqdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
  69   my $orders         = SL::DB::Manager::Order->get_all_sorted(where => [record_type     => 'sales_order',
  70                                                                         or              => [closed    => undef, closed    => 0],
  71                                                                         reqdate         => {le => $latest_reqdate},
  72                                                                         transdate       => {ge => $self->start_date},]);
  73   my %not_delivered;
  74   foreach my $order (@$orders) {
  75     my $lr = $order->linked_records(to => 'DeliveryOrder');
  76     $lr    = [grep { !!$_->customer_id } @$lr];
  77
  78     if (scalar @$lr == 0) {
  79       push @{ $not_delivered{no_delivery_order} }, $order->ordnumber;
  80       next;
  81     }
  82
  83     if (none { $_->delivered } @$lr) {
  84       push @{ $not_delivered{none_delivered}    }, $order->ordnumber;
  85       next;
  86     }
  87
  88     if (notall { $_->delivered } @$lr) {
  89       push @{ $not_delivered{notall_delivered}  }, $order->ordnumber;
  90       next;
  91     }
  92   }
  93
  94   if (@{ $not_delivered{no_delivery_order} || [] } || @{ $not_delivered{none_delivered} || [] } || @{ $not_delivered{notall_delivered} || [] }) {
  95     $self->tester->ok(0, $title);
  96
  97     if (@{ $not_delivered{no_delivery_order} || [] }) {
  98       $self->tester->diag("Folgende offene fällige Auftragsbestätigungen haben keine Verkaufslieferscheine:");
  99       $self->tester->diag("Auftrags-Nummer: " . $_) for @{ $not_delivered{no_delivery_order} };
 100     }
 101     if (@{ $not_delivered{none_delivered} || [] }) {
 102       $self->tester->diag("Folgende offene fällige Auftragsbestätigungen haben Verkaufslieferscheine, von denen keine geliefert sind:");
 103       $self->tester->diag("Auftrags-Nummer: " . $_) for @{ $not_delivered{none_delivered} };
 104     }
 105     if (@{ $not_delivered{notall_delivered} || [] }) {
 106       $self->tester->diag("Folgende offene fällige Auftragsbestätigungen haben einen oder mehrere nicht gelieferte Verkaufslieferscheine:");
 107       $self->tester->diag("Auftrags-Nummer: " . $_) for @{ $not_delivered{notall_delivered} };
 108     }
 109
 110   } else {
 111     $self->tester->ok(1, $title);
 112   }
 113 }
 114
 115 sub check_no_missing_order_confirmations {
 116   my ($self) = @_;
 117
 118   my $days_delta       = 3;
 119   my $title            = "Alle offenen Auftragseingänge älter als $days_delta Werktage haben eine Auftragsbestätigung.";
 120
 121   my $latest_transdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
 122
 123   my $orders           = SL::DB::Manager::Order->get_all_sorted(where => [record_type     => 'sales_order_intake',
 124                                                                           or              => [closed    => undef, closed    => 0],
 125                                                                           transdate       => {le => $latest_transdate},
 126                                                                           transdate       => {ge => $self->start_date},]);
 127
 128   # Check, if order confirmations are in the worklfow.
 129   # (Maybe it is sufficient to list all order intakes which are not closed because
 130   # they will be closed when an related order confirmation is created.)
 131   my @not_confirmed_order_intakes;
 132   foreach my $order (@$orders) {
 133     my $lr = $order->linked_records(direction => 'to', recursive => 1);
 134     $lr    = [grep { 'SL::DB::Order' eq ref $_ && $_->is_type('sales_order') } @$lr];
 135     push @not_confirmed_order_intakes, $order->ordnumber if scalar @$lr == 0;
 136   }
 137
 138   if (@not_confirmed_order_intakes) {
 139     $self->tester->ok(0, $title);
 140
 141     $self->tester->diag("Folgende offene Auftragseingänge älter als $days_delta haben keine Auftragsbestätigung:");
 142     $self->tester->diag("Auftrageingangs-Nummer: " . $_) for @not_confirmed_order_intakes;
 143
 144   } else {
 145     $self->tester->ok(1, $title);
 146   }
 147
 148 }
 149
 150 sub check_invoices_mailed {
 151   my ($self) = @_;
 152
 153   my $title    = "Alle offenen Verkaufsrechnungen sind per Mail verschickt worden.";
 154
 155   my $invoices = SL::DB::Manager::Invoice->get_all_sorted(where => [invoice => 1,
 156                                                                     type      => 'invoice',
 157                                                                     or        => [storno => undef, storno => 0],
 158                                                                     transdate => {ge => $self->start_date},]);
 159   $invoices    = [grep { !$_->closed } @$invoices];
 160
 161   my @documents_not_mailed = $self->get_documents_not_mailed($invoices);
 162   $self->complain_documtens_not_mailed(
 163     \@documents_not_mailed,
 164     main_title => $title,
 165     sub_title  => "Folgende offenen Verkaufsrechungen sind nicht per Mail verschickt worden",
 166     nr_title   => "Rechnungs-Nummer"
 167   );
 168 }
 169
 170 sub check_order_confirmations_mailed {
 171   my ($self) = @_;
 172
 173   my $days_delta       = 1;
 174   my $title            = "Alle offenen Auftragsbestätigungen älter als $days_delta Werktage sind per Mail verschickt worden.";
 175
 176   my $latest_transdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
 177
 178   my $orders           = SL::DB::Manager::Order->get_all_sorted(where => [record_type     => 'sales_order',
 179                                                                           or              => [closed    => undef, closed    => 0],
 180                                                                           transdate       => {le => $latest_transdate},
 181                                                                           transdate       => {ge => $self->start_date},]);
 182
 183   my @documents_not_mailed = $self->get_documents_not_mailed($orders);
 184   $self->complain_documtens_not_mailed(
 185     \@documents_not_mailed,
 186     main_title => $title,
 187     sub_title  => "Folgende offenen Auftragsbestätigungen älter als $days_delta Werktage sind nicht per Mail verschickt worden",
 188     nr_title   => "Auftrags-Nummer"
 189   );
 190 }
 191
 192 sub check_quotations_mailed {
 193   my ($self) = @_;
 194
 195   my $days_delta       = 3;
 196   my $title            = "Alle offenen Angebote älter als $days_delta Werktage sind per Mail verschickt worden.";
 197
 198   my $latest_transdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
 199
 200   my $orders           = SL::DB::Manager::Order->get_all_sorted(where => [record_type     => 'request_quotion',
 201                                                                           or              => [closed    => undef, closed    => 0],
 202                                                                           transdate       => {le => $latest_transdate},
 203                                                                           transdate       => {ge => $self->start_date},]);
 204
 205   my @documents_not_mailed = $self->get_documents_not_mailed($orders);
 206   $self->complain_documtens_not_mailed(
 207     \@documents_not_mailed,
 208     main_title => $title,
 209     sub_title  => "Folgende offenen Angebote älter als $days_delta Werktage sind nicht per Mail verschickt worden",
 210     nr_title   => "Angebots-Nummer"
 211   );
 212 }
 213
 214 sub get_documents_not_mailed {
 215   my ($self, $objects) = @_;
 216
 217   my @documents_not_mailed;
 218   foreach my $object (@$objects) {
 219     my $mails = $object->linked_records(to => 'EmailJournal');
 220     push @documents_not_mailed, $object->record_number if scalar @$mails == 0;
 221   }
 222
 223   return @documents_not_mailed;
 224 }
 225
 226 sub complain_documtens_not_mailed {
 227   my ($self, $documents_not_mailed, %params) = @_;
 228
 229   my $main_title = $params{main_title} | '';
 230   my $sub_title  = $params{sub_title}  | '';
 231   my $nr_title   = $params{nr_title}   | '';
 232
 233   if (@{ $documents_not_mailed || [] }) {
 234     $self->tester->ok(0, $main_title);
 235
 236     $self->tester->diag($sub_title . ":");
 237     $self->tester->diag($nr_title . ": " . $_) for @$documents_not_mailed;
 238
 239   } else {
 240     $self->tester->ok(1, $main_title);
 241   }
 242 }
 243
 244 # Check for all purchase invoices if the sum of all related purchase
 245 # orders is greater than the sum of all related purchase invoices.
 246 sub check_purchase_invoices_sums_against_purchase_orders {
 247   my ($self) = @_;
 248
 249   my $title = "Die Netto-Summe der Einkaufsrechnungen ist kleiner oder gleich der Netto-Summe der Lieferantenaufträge.";
 250
 251   my $purchase_invoices = SL::DB::Manager::PurchaseInvoice->get_all_sorted(where => ['!storno' => 1,
 252                                                                                      invoice   => 1,
 253                                                                                      transdate => {ge => $self->start_date},]);
 254
 255   my @purchase_invoices_with_wrong_sums;
 256   foreach my $purchase_invoice (@$purchase_invoices) {
 257     if (!$purchase_invoice->check_sums_against_purchase_orders($purchase_invoice)) {
 258       push @purchase_invoices_with_wrong_sums, $purchase_invoice;
 259     }
 260   }
 261
 262   if (@purchase_invoices_with_wrong_sums) {
 263     $self->tester->ok(0, $title);
 264     $self->tester->diag("Folgende " . scalar @purchase_invoices_with_wrong_sums . " Einkaufsrechnungen ergeben eine viel höhere Netto-Summe alsergeben eine viel höhere Netto-Summe als ursprüngliche beauftragt:");
 265     $self->tester->diag("Einkaufsrechnungs-Nummer vom " . $_->transdate_as_date . ": " . $_->record_number) for @purchase_invoices_with_wrong_sums;
 266
 267   } else {
 268     $self->tester->ok(1, $title);
 269   }
 270 }
 271
 272 # Check for all purchase invoices if the sum of all related sales
 273 # orders is greater than the sum of all related purchase invoices.
 274 sub check_purchase_invoices_sums_against_sales_orders {
 275   my ($self) = @_;
 276
 277   my $title = "Die Summe der Einkaufsrechnungen ist kleiner oder gleich der Summe der Auftragsbestätigungen.";
 278
 279   my $purchase_invoices = SL::DB::Manager::PurchaseInvoice->get_all_sorted(where => ['!storno' => 1,
 280                                                                                      invoice   => 1,
 281                                                                                      transdate => {ge => $self->start_date},]);
 282
 283   my @purchase_invoices_with_wrong_sums;
 284   foreach my $purchase_invoice (@$purchase_invoices) {
 285     if (!$purchase_invoice->check_sums_against_sales_orders($purchase_invoice)) {
 286       push @purchase_invoices_with_wrong_sums, $purchase_invoice;
 287     }
 288   }
 289
 290   if (@purchase_invoices_with_wrong_sums) {
 291     $self->tester->ok(0, $title);
 292     $self->tester->diag("Folgende " . scalar @purchase_invoices_with_wrong_sums . " Einkaufsrechnungen haben eine zu hohe Summe:");
 293     $self->tester->diag("Einkaufsrechnungs vom " . $_->transdate_as_date . ": " . $_->record_number) for @purchase_invoices_with_wrong_sums;
 294
 295   } else {
 296     $self->tester->ok(1, $title);
 297   }
 298 }
 299
 300 1;
 301
 302 __END__
 303
 304 =encoding utf-8
 305
 306 =head1 NAME
 307
 308 SL::BackgroundJob::SelfTest::NovoclonStrict - special tests novoclon
 309
 310 =head1 DESCRIPTION
 311
 312 Special tests for novoclon.
 313
 314 =head1 AUTHOR
 315
 316 Bernd Bleßmann E<lt>bernd@kivitendo-premium.deE<gt>
 317
 318 =cut