Revision 91b4308a
Von Bernd Bleßmann vor mehr als 1 Jahr hinzugefügt
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
novoclon: Selbsttests für strikte Prozesse