Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 91b4308a

Von Bernd Bleßmann vor etwa 1 Jahr hinzugefügt

  • ID 91b4308acbe5c8060d01d3f5e7aea4b8c6dd74ea
  • Vorgänger fe66a56c
  • Nachfolger 19bfd0f2

novoclon: Selbsttests für strikte Prozesse

Unterschiede anzeigen:

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

  
12

  
13
sub run {
14
  my ($self) = @_;
15

  
16
  $self->tester->plan(tests => 6);
17

  
18
  $self->check_no_missing_invoices;
19
  $self->check_no_missing_deliveries;
20
  $self->check_no_missing_order_confirmations;
21
  $self->check_invoices_mailed;
22
  $self->check_order_confirmations_mailed;
23
  $self->check_quotations_mailed;
24
}
25

  
26
sub check_no_missing_invoices {
27
  my ($self) = @_;
28

  
29
  my $days_delta           = 4;
30
  my $title                = "Alle Verkaufslieferscheine sind $days_delta Werktage nach Lieferterimin geschlossen.";
31

  
32
  my $latest_reqdate       = DateTime->today_local->subtract_businessdays(days => $days_delta);
33
  my $open_delivery_orders = SL::DB::Manager::DeliveryOrder->get_all_sorted(where => ['!customer_id'  => undef,
34
                                                                                      '!cusordnumber' => { ilike => ['muster'] },
35
                                                                                      delivered       => 1,
36
                                                                                      or              => [closed => undef, closed => 0],
37
                                                                                      reqdate         => {le => $latest_reqdate}]
38
  );
39

  
40
  if (@$open_delivery_orders) {
41
    $self->tester->ok(0, $title);
42
    $self->tester->diag("Folgende Verkaufslieferscheine sind geliefert und nach Liefertermin länger als $days_delta Werktage offen. Vermutlich fehlt die Rechnung:");
43
    $self->tester->diag("Lieferschein-Nummer: " . $_->donumber) for @$open_delivery_orders;
44

  
45
  } else {
46
    $self->tester->ok(1, $title);
47
  }
48
}
49

  
50
sub check_no_missing_deliveries {
51
  my ($self) = @_;
52

  
53
  my $days_delta     = 2;
54
  my $title          = "Alle offenen Auftragsbestätigungen mit Liefertermin vor mindestens $days_delta Werktagen haben eine Lieferung.";
55

  
56
  my $latest_reqdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
57
  my $orders         = SL::DB::Manager::Order->get_all_sorted(where => ['!customer_id'  => undef,
58
                                                                        or              => [quotation => undef, quotation => 0],
59
                                                                        or              => [intake    => undef, intake    => 0],
60
                                                                        or              => [closed    => undef, closed    => 0],
61
                                                                        reqdate         => {le => $latest_reqdate}]);
62
  my %not_delivered;
63
  foreach my $order (@$orders) {
64
    my $lr = $order->linked_records(to => 'DeliveryOrder');
65
    $lr    = [grep { !!$_->customer_id } @$lr];
66

  
67
    if (scalar @$lr == 0) {
68
      push @{ $not_delivered{no_delivery_order} }, $order->ordnumber;
69
      next;
70
    }
71

  
72
    if (none { $_->delivered } @$lr) {
73
      push @{ $not_delivered{none_delivered}    }, $order->ordnumber;
74
      next;
75
    }
76

  
77
    if (notall { $_->delivered } @$lr) {
78
      push @{ $not_delivered{notall_delivered}  }, $order->ordnumber;
79
      next;
80
    }
81
  }
82

  
83
  if (@{ $not_delivered{no_delivery_order} || [] } || @{ $not_delivered{none_delivered} || [] } || @{ $not_delivered{notall_delivered} || [] }) {
84
    $self->tester->ok(0, $title);
85

  
86
    if (@{ $not_delivered{no_delivery_order} || [] }) {
87
      $self->tester->diag("Folgende offene fällige Auftragsbestätigungen haben keine Verkaufslieferscheine:");
88
      $self->tester->diag("Auftrags-Nummer: " . $_) for @{ $not_delivered{no_delivery_order} };
89
    }
90
    if (@{ $not_delivered{none_delivered} || [] }) {
91
      $self->tester->diag("Folgende offene fällige Auftragsbestätigungen haben Verkaufslieferscheine, von denen keine geliefert sind:");
92
      $self->tester->diag("Auftrags-Nummer: " . $_) for @{ $not_delivered{none_delivered} };
93
    }
94
    if (@{ $not_delivered{notall_delivered} || [] }) {
95
      $self->tester->diag("Folgende offene fällige Auftragsbestätigungen haben einen oder mehrere nicht gelieferte Verkaufslieferscheine:");
96
      $self->tester->diag("Auftrags-Nummer: " . $_) for @{ $not_delivered{notall_delivered} };
97
    }
98

  
99
  } else {
100
    $self->tester->ok(1, $title);
101
  }
102
}
103

  
104
sub check_no_missing_order_confirmations {
105
  my ($self) = @_;
106

  
107
  my $days_delta       = 3;
108
  my $title            = "Alle offenen Auftragseingänge älter als $days_delta Werktage haben eine Auftragsbestätigung.";
109

  
110
  my $latest_transdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
111

  
112
  my $orders           = SL::DB::Manager::Order->get_all_sorted(where => ['!customer_id'  => undef,
113
                                                                          intake          => 1,
114
                                                                          or              => [quotation => undef, quotation => 0],
115
                                                                          or              => [closed    => undef, closed    => 0],
116
                                                                          transdate       => {le => $latest_transdate}]);
117

  
118
  # Check, if order confirmations are in the worklfow.
119
  # (Maybe it is sufficient to list all order intakes which are not closed because
120
  # they will be closed when an related order confirmation is created.)
121
  my @not_confirmed_order_intakes;
122
  foreach my $order (@$orders) {
123
    my $lr = $order->linked_records(direction => 'to', recursive => 1);
124
    $lr    = [grep { 'SL::DB::Order' eq ref $_ && $_->is_type('sales_order') } @$lr];
125
    push @not_confirmed_order_intakes, $order->ordnumber if scalar @$lr == 0;
126
  }
127

  
128
  if (@not_confirmed_order_intakes) {
129
    $self->tester->ok(0, $title);
130

  
131
    $self->tester->diag("Folgende offene Auftragseingänge alter als $days_delta haben keine Auftragsbestätigung:");
132
    $self->tester->diag("Auftrageingangs-Nummer: " . $_) for @not_confirmed_order_intakes;
133

  
134
  } else {
135
    $self->tester->ok(1, $title);
136
  }
137

  
138
}
139

  
140
sub check_invoices_mailed {
141
  my ($self) = @_;
142

  
143
  my $title    = "Alle offenen Verkaufsrechnungen sind per Mail verschickt worden.";
144

  
145
  my $invoices = SL::DB::Manager::Invoice->get_all_sorted(where => [invoice => 1,
146
                                                                    type    => 'invoice',
147
                                                                    or      => [storno => undef, storno => 0]]);
148
  $invoices    = [grep { !$_->closed } @$invoices];
149

  
150
  my @documents_not_mailed = $self->get_documents_not_mailed($invoices);
151
  $self->complain_documtens_not_mailed(
152
    \@documents_not_mailed,
153
    main_title => $title,
154
    sub_title  => "Folgende offenen Verkaufsrechungen sind nicht per Mail verschickt worden",
155
    nr_title   => "Rechnungs-Nummer"
156
  );
157
}
158

  
159
sub check_order_confirmations_mailed {
160
  my ($self) = @_;
161

  
162
  my $days_delta       = 1;
163
  my $title            = "Alle offenen Auftragsbestätigungen älter als $days_delta Werktage sind per Mail verschickt worden.";
164

  
165
  my $latest_transdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
166

  
167
  my $orders           = SL::DB::Manager::Order->get_all_sorted(where => ['!customer_id'  => undef,
168
                                                                          or              => [quotation => undef, quotation => 0],
169
                                                                          or              => [intake    => undef, intake    => 0],
170
                                                                          or              => [closed    => undef, closed    => 0],
171
                                                                          transdate       => {le => $latest_transdate}]);
172

  
173
  my @documents_not_mailed = $self->get_documents_not_mailed($orders);
174
  $self->complain_documtens_not_mailed(
175
    \@documents_not_mailed,
176
    main_title => $title,
177
    sub_title  => "Folgende offenen Auftragsbestätigungen älter als $days_delta Werktage sind nicht per Mail verschickt worden",
178
    nr_title   => "Auftrags-Nummer"
179
  );
180
}
181

  
182
sub check_quotations_mailed {
183
  my ($self) = @_;
184

  
185
  my $days_delta       = 3;
186
  my $title            = "Alle offenen Angebote älter als $days_delta Werktage sind per Mail verschickt worden.";
187

  
188
  my $latest_transdate = DateTime->today_local->subtract_businessdays(days => $days_delta);
189

  
190
  my $orders           = SL::DB::Manager::Order->get_all_sorted(where => ['!customer_id'  => undef,
191
                                                                          quotation       => 1,
192
                                                                          or              => [intake    => undef, intake    => 0],
193
                                                                          or              => [closed    => undef, closed    => 0],
194
                                                                          transdate       => {le => $latest_transdate}]);
195

  
196
  my @documents_not_mailed = $self->get_documents_not_mailed($orders);
197
  $self->complain_documtens_not_mailed(
198
    \@documents_not_mailed,
199
    main_title => $title,
200
    sub_title  => "Folgende offenen Angebote älter als $days_delta Werktage sind nicht per Mail verschickt worden",
201
    nr_title   => "Angebots-Nummer"
202
  );
203
}
204

  
205
sub get_documents_not_mailed {
206
  my ($self, $objects) = @_;
207

  
208
  my @documents_not_mailed;
209
  foreach my $object (@$objects) {
210
    my $mails = $object->linked_records(to => 'EmailJournal');
211
    push @documents_not_mailed, $object->record_number if scalar @$mails == 0;
212
  }
213

  
214
  return @documents_not_mailed;
215
}
216

  
217
sub complain_documtens_not_mailed {
218
  my ($self, $documents_not_mailed, %params) = @_;
219

  
220
  my $main_title = $params{main_title} | '';
221
  my $sub_title  = $params{sub_title}  | '';
222
  my $nr_title   = $params{nr_title}   | '';
223

  
224
  if (@{ $documents_not_mailed || [] }) {
225
    $self->tester->ok(0, $main_title);
226

  
227
    $self->tester->diag($sub_title . ":");
228
    $self->tester->diag($nr_title . ": " . $_) for @$documents_not_mailed;
229

  
230
  } else {
231
    $self->tester->ok(1, $main_title);
232
  }
233
}
234

  
235

  
236
1;
237

  
238
__END__
239

  
240
=encoding utf-8
241

  
242
=head1 NAME
243

  
244
SL::BackgroundJob::SelfTest::NovoclonStrict - special tests novoclon
245

  
246
=head1 DESCRIPTION
247

  
248
Special tests for novoclon.
249

  
250
=head1 AUTHOR
251

  
252
Bernd Bleßmann E<lt>bernd@kivitendo-premium.deE<gt>
253

  
254
=cut

Auch abrufbar als: Unified diff