Bug 26922: Regression tests
[koha.git] / t / db_dependent / Letters.t
blob613f5696d30aa74f01e56f74d08723050fa96d45
1 #!/usr/bin/perl
3 # This file is part of Koha.
5 # Copyright (C) 2013 Equinox Software, Inc.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Modern::Perl;
21 use Test::More tests => 83;
22 use Test::MockModule;
23 use Test::Warn;
25 use Email::Sender::Failure;
27 use MARC::Record;
29 use utf8;
31 my ( $email_object, $sendmail_params );
33 my $email_sender_module = Test::MockModule->new('Email::Stuffer');
34 $email_sender_module->mock(
35 'send_or_die',
36 sub {
37 ( $email_object, $sendmail_params ) = @_;
38 my $str = $email_object->email->as_string;
39 unlike $str, qr/I =C3=A2=C2=99=C2=A5 Koha=/, "Content is not double encoded";
40 warn "Fake send_or_die";
44 use_ok('C4::Context');
45 use_ok('C4::Members');
46 use_ok('C4::Acquisition');
47 use_ok('C4::Biblio');
48 use_ok('C4::Letters');
49 use t::lib::Mocks;
50 use t::lib::TestBuilder;
51 use Koha::Database;
52 use Koha::DateUtils qw( dt_from_string output_pref );
53 use Koha::Acquisition::Booksellers;
54 use Koha::Acquisition::Bookseller::Contacts;
55 use Koha::Acquisition::Orders;
56 use Koha::Libraries;
57 use Koha::Notice::Templates;
58 use Koha::Patrons;
59 use Koha::Subscriptions;
60 my $schema = Koha::Database->schema;
61 $schema->storage->txn_begin();
63 my $builder = t::lib::TestBuilder->new;
64 my $dbh = C4::Context->dbh;
66 $dbh->do(q|DELETE FROM letter|);
67 $dbh->do(q|DELETE FROM message_queue|);
68 $dbh->do(q|DELETE FROM message_transport_types|);
70 my $library = $builder->build({
71 source => 'Branch',
72 value => {
73 branchemail => 'branchemail@address.com',
74 branchreplyto => 'branchreplyto@address.com',
75 branchreturnpath => 'branchreturnpath@address.com',
77 });
78 my $patron_category = $builder->build({ source => 'Category' })->{categorycode};
79 my $date = dt_from_string;
80 my $borrowernumber = Koha::Patron->new({
81 firstname => 'Jane',
82 surname => 'Smith',
83 categorycode => $patron_category,
84 branchcode => $library->{branchcode},
85 dateofbirth => $date,
86 smsalertnumber => undef,
87 })->store->borrowernumber;
89 my $marc_record = MARC::Record->new;
90 my( $biblionumber, $biblioitemnumber ) = AddBiblio( $marc_record, '' );
94 # GetMessageTransportTypes
95 my $mtts = C4::Letters::GetMessageTransportTypes();
96 is( @$mtts, 0, 'GetMessageTransportTypes returns the correct number of message types' );
98 $dbh->do(q|
99 INSERT INTO message_transport_types( message_transport_type ) VALUES ('email'), ('phone'), ('print'), ('sms')
101 $mtts = C4::Letters::GetMessageTransportTypes();
102 is_deeply( $mtts, ['email', 'phone', 'print', 'sms'], 'GetMessageTransportTypes returns all values' );
105 # EnqueueLetter
106 is( C4::Letters::EnqueueLetter(), undef, 'EnqueueLetter without argument returns undef' );
108 my $my_message = {
109 borrowernumber => $borrowernumber,
110 message_transport_type => 'sms',
111 to_address => undef,
112 from_address => 'from@example.com',
114 my $message_id = C4::Letters::EnqueueLetter($my_message);
115 is( $message_id, undef, 'EnqueueLetter without the letter argument returns undef' );
117 delete $my_message->{message_transport_type};
118 $my_message->{letter} = {
119 content => 'I ♥ Koha',
120 title => '啤酒 is great',
121 metadata => 'metadata',
122 code => 'TEST_MESSAGE',
123 content_type => 'text/plain',
126 $message_id = C4::Letters::EnqueueLetter($my_message);
127 is( $message_id, undef, 'EnqueueLetter without the message type argument argument returns undef' );
129 $my_message->{message_transport_type} = 'sms';
130 $message_id = C4::Letters::EnqueueLetter($my_message);
131 ok(defined $message_id && $message_id > 0, 'new message successfully queued');
134 # GetQueuedMessages
135 my $messages = C4::Letters::GetQueuedMessages();
136 is( @$messages, 1, 'GetQueuedMessages without argument returns all the entries' );
138 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
139 is( @$messages, 1, 'one message stored for the borrower' );
140 is( $messages->[0]->{message_id}, $message_id, 'EnqueueLetter returns the message id correctly' );
141 is( $messages->[0]->{borrowernumber}, $borrowernumber, 'EnqueueLetter stores the borrower number correctly' );
142 is( $messages->[0]->{subject}, $my_message->{letter}->{title}, 'EnqueueLetter stores the subject correctly' );
143 is( $messages->[0]->{content}, $my_message->{letter}->{content}, 'EnqueueLetter stores the content correctly' );
144 is( $messages->[0]->{message_transport_type}, $my_message->{message_transport_type}, 'EnqueueLetter stores the message type correctly' );
145 is( $messages->[0]->{status}, 'pending', 'EnqueueLetter stores the status pending correctly' );
146 isnt( $messages->[0]->{time_queued}, undef, 'Time queued inserted by default in message_queue table' );
147 is( $messages->[0]->{updated_on}, $messages->[0]->{time_queued}, 'Time status changed equals time queued when created in message_queue table' );
149 # Setting time_queued to something else than now
150 my $yesterday = dt_from_string->subtract( days => 1 );
151 Koha::Notice::Messages->find($messages->[0]->{message_id})->time_queued($yesterday)->store;
153 # SendQueuedMessages
154 my $messages_processed = C4::Letters::SendQueuedMessages( { type => 'email' });
155 is($messages_processed, 0, 'No queued messages processed if type limit passed with unused type');
156 $messages_processed = C4::Letters::SendQueuedMessages( { type => 'sms' });
157 is($messages_processed, 1, 'All queued messages processed, found correct number of messages with type limit');
158 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
160 $messages->[0]->{status},
161 'failed',
162 'message marked failed if tried to send SMS message for borrower with no smsalertnumber set (bug 11208)'
164 isnt($messages->[0]->{updated_on}, $messages->[0]->{time_queued}, 'Time status changed differs from time queued when status changes' );
165 is(dt_from_string($messages->[0]->{time_queued}), $yesterday, 'Time queued remaines inmutable' );
167 # ResendMessage
168 my $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
169 my $message = C4::Letters::GetMessage( $messages->[0]->{message_id});
170 is( $resent, 1, 'The message should have been resent' );
171 is($message->{status},'pending', 'ResendMessage sets status to pending correctly (bug 12426)');
172 $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
173 is( $resent, 0, 'The message should not have been resent again' );
174 $resent = C4::Letters::ResendMessage();
175 is( $resent, undef, 'ResendMessage should return undef if not message_id given' );
177 # GetLetters
178 my $letters = C4::Letters::GetLetters();
179 is( @$letters, 0, 'GetLetters returns the correct number of letters' );
181 my $title = q|<<branches.branchname>> - <<status>>|;
182 my $content = q{Dear <<borrowers.firstname>> <<borrowers.surname>>,
183 According to our current records, you have items that are overdue.Your library does not charge late fines, but please return or renew them at the branch below as soon as possible.
185 <<branches.branchname>>
186 <<branches.branchaddress1>>
187 URL: <<OPACBaseURL>>
189 The following item(s) is/are currently <<status>>:
191 <item> <<count>>. <<items.itemcallnumber>>, Barcode: <<items.barcode>> </item>
193 Thank-you for your prompt attention to this matter.
194 Don't forget your date of birth: <<borrowers.dateofbirth>>.
195 Look at this wonderful biblio timestamp: <<biblio.timestamp>>.
198 $dbh->do( q|INSERT INTO letter(branchcode,module,code,name,is_html,title,content,message_transport_type) VALUES (?,'my module','my code','my name',1,?,?,'email')|, undef, $library->{branchcode}, $title, $content );
199 $letters = C4::Letters::GetLetters();
200 is( @$letters, 1, 'GetLetters returns the correct number of letters' );
201 is( $letters->[0]->{module}, 'my module', 'GetLetters gets the module correctly' );
202 is( $letters->[0]->{code}, 'my code', 'GetLetters gets the code correctly' );
203 is( $letters->[0]->{name}, 'my name', 'GetLetters gets the name correctly' );
206 # getletter
207 subtest 'getletter' => sub {
208 plan tests => 16;
209 t::lib::Mocks::mock_preference('IndependentBranches', 0);
210 my $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
211 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
212 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
213 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
214 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
215 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
216 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
217 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
218 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
220 t::lib::Mocks::mock_userenv({ branchcode => "anotherlib", flags => 1 });
222 t::lib::Mocks::mock_preference('IndependentBranches', 1);
223 $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
224 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
225 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
226 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
227 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
228 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
229 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
230 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
231 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
236 # Regression test for Bug 14206
237 $dbh->do( q|INSERT INTO letter(branchcode,module,code,name,is_html,title,content,message_transport_type) VALUES ('FFL','my module','my code','my name',1,?,?,'print')|, undef, $title, $content );
238 my $letter14206_a = C4::Letters::getletter('my module', 'my code', 'FFL' );
239 is( $letter14206_a->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type not passed, correct mtt detected' );
240 my $letter14206_b = C4::Letters::getletter('my module', 'my code', 'FFL', 'print');
241 is( $letter14206_b->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type passed, correct mtt detected' );
243 # test for overdue_notices.pl
244 my $overdue_rules = {
245 letter1 => 'my code',
247 my $i = 1;
248 my $branchcode = 'FFL';
249 my $letter14206_c = C4::Letters::getletter('my module', $overdue_rules->{"letter$i"}, $branchcode);
250 is( $letter14206_c->{message_transport_type}, 'print', 'Bug 14206 - correct mtt detected for call from overdue_notices.pl' );
252 # GetPreparedLetter
253 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
254 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', '' );
256 my $sms_content = 'This is a SMS for an <<status>>';
257 $dbh->do( q|INSERT INTO letter(branchcode,module,code,name,is_html,title,content,message_transport_type) VALUES (?,'my module','my code','my name',1,'my title',?,'sms')|, undef, $library->{branchcode}, $sms_content );
259 my $tables = {
260 borrowers => $borrowernumber,
261 branches => $library->{branchcode},
262 biblio => $biblionumber,
264 my $substitute = {
265 status => 'overdue',
267 my $repeat = [
269 itemcallnumber => 'my callnumber1',
270 barcode => '1234',
273 itemcallnumber => 'my callnumber2',
274 barcode => '5678',
277 my $prepared_letter = GetPreparedLetter((
278 module => 'my module',
279 branchcode => $library->{branchcode},
280 letter_code => 'my code',
281 tables => $tables,
282 substitute => $substitute,
283 repeat => $repeat,
285 my $retrieved_library = Koha::Libraries->find($library->{branchcode});
286 my $my_title_letter = $retrieved_library->branchname . qq| - $substitute->{status}|;
287 my $biblio_timestamp = dt_from_string( GetBiblioData($biblionumber)->{timestamp} );
288 my $my_content_letter = qq|Dear Jane Smith,
289 According to our current records, you have items that are overdue.Your library does not charge late fines, but please return or renew them at the branch below as soon as possible.
291 |.$retrieved_library->branchname.qq|
292 |.$retrieved_library->branchaddress1.qq|
293 URL: http://thisisatest.com
295 The following item(s) is/are currently $substitute->{status}:
297 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
298 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
300 Thank-you for your prompt attention to this matter.
301 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
302 Look at this wonderful biblio timestamp: | . output_pref({ dt => $biblio_timestamp }) . ".\n";
304 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
305 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
307 $prepared_letter = GetPreparedLetter((
308 module => 'my module',
309 branchcode => $library->{branchcode},
310 letter_code => 'my code',
311 tables => $tables,
312 substitute => $substitute,
313 repeat => $repeat,
314 message_transport_type => 'sms',
316 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
317 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
319 $dbh->do(q{INSERT INTO letter (module, code, name, title, content) VALUES ('test_date','TEST_DATE','Test dates','A title with a timestamp: <<biblio.timestamp>>','This one only contains the date: <<biblio.timestamp | dateonly>>.');});
320 $prepared_letter = GetPreparedLetter((
321 module => 'test_date',
322 branchcode => '',
323 letter_code => 'test_date',
324 tables => $tables,
325 substitute => $substitute,
326 repeat => $repeat,
328 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 1' );
330 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp | dateonly>>.' WHERE code = 'test_date';});
331 $prepared_letter = GetPreparedLetter((
332 module => 'test_date',
333 branchcode => '',
334 letter_code => 'test_date',
335 tables => $tables,
336 substitute => $substitute,
337 repeat => $repeat,
339 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 2' );
341 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp|dateonly >>.' WHERE code = 'test_date';});
342 $prepared_letter = GetPreparedLetter((
343 module => 'test_date',
344 branchcode => '',
345 letter_code => 'test_date',
346 tables => $tables,
347 substitute => $substitute,
348 repeat => $repeat,
350 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 3' );
352 t::lib::Mocks::mock_preference( 'TimeFormat', '12hr' );
353 my $yesterday_night = $date->clone->add( days => -1 )->set_hour(22);
354 $dbh->do(q|UPDATE biblio SET timestamp = ? WHERE biblionumber = ?|, undef, $yesterday_night, $biblionumber );
355 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp>>.' WHERE code = 'test_date';});
356 $prepared_letter = GetPreparedLetter((
357 module => 'test_date',
358 branchcode => '',
359 letter_code => 'test_date',
360 tables => $tables,
361 substitute => $substitute,
362 repeat => $repeat,
364 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $yesterday_night }) . q|.|, 'dateonly test 3' );
366 $dbh->do(q{INSERT INTO letter (module, code, name, title, content) VALUES ('claimacquisition','TESTACQCLAIM','Acquisition Claim','Item Not Received','<<aqbooksellers.name>>|<<aqcontacts.name>>|<order>Ordernumber <<aqorders.ordernumber>> (<<biblio.title>>) (<<aqorders.quantity>> ordered)</order>');});
367 $dbh->do(q{INSERT INTO letter (module, code, name, title, content) VALUES ('orderacquisition','TESTACQORDER','Acquisition Order','Order','<<aqbooksellers.name>>|<<aqcontacts.name>>|<order>Ordernumber <<aqorders.ordernumber>> (<<biblio.title>>) (<<aqorders.quantity>> ordered)</order>');});
369 # Test that _parseletter doesn't modify its parameters bug 15429
371 my $values = { dateexpiry => '2015-12-13', };
372 C4::Letters::_parseletter($prepared_letter, 'borrowers', $values);
373 is( $values->{dateexpiry}, '2015-12-13', "_parseletter doesn't modify its parameters" );
376 # Correctly format dateexpiry
378 my $values = { dateexpiry => '2015-12-13', };
380 t::lib::Mocks::mock_preference('dateformat', 'metric');
381 t::lib::Mocks::mock_preference('timeformat', '24hr');
382 my $letter = C4::Letters::_parseletter({ content => "expiry on <<borrowers.dateexpiry>>"}, 'borrowers', $values);
383 is( $letter->{content}, 'expiry on 13/12/2015' );
385 t::lib::Mocks::mock_preference('dateformat', 'metric');
386 t::lib::Mocks::mock_preference('timeformat', '12hr');
387 $letter = C4::Letters::_parseletter({ content => "expiry on <<borrowers.dateexpiry>>"}, 'borrowers', $values);
388 is( $letter->{content}, 'expiry on 13/12/2015' );
391 my $bookseller = Koha::Acquisition::Bookseller->new(
393 name => "my vendor",
394 address1 => "bookseller's address",
395 phone => "0123456",
396 active => 1,
397 deliverytime => 5,
399 )->store;
400 my $booksellerid = $bookseller->id;
402 Koha::Acquisition::Bookseller::Contact->new( { name => 'John Smith', phone => '0123456x1', claimacquisition => 1, orderacquisition => 1, booksellerid => $booksellerid } )->store;
403 Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1, booksellerid => $booksellerid } )->store;
404 my $basketno = NewBasket($booksellerid, 1);
406 my $budgetid = C4::Budgets::AddBudget({
407 budget_code => "budget_code_test_letters",
408 budget_name => "budget_name_test_letters",
411 my $bib = MARC::Record->new();
412 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
413 $bib->append_fields(
414 MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
416 } else {
417 $bib->append_fields(
418 MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
422 my $logged_in_user = $builder->build_object(
424 class => 'Koha::Patrons',
425 value => {
426 branchcode => $library->{branchcode},
427 email => 'some@email.com'
432 t::lib::Mocks::mock_userenv({ patron => $logged_in_user });
434 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
435 my $order = Koha::Acquisition::Order->new(
437 basketno => $basketno,
438 quantity => 1,
439 biblionumber => $biblionumber,
440 budget_id => $budgetid,
442 )->store;
443 my $ordernumber = $order->ordernumber;
445 Koha::Acquisition::Baskets->find( $basketno )->close;
446 my $err;
447 warning_like {
448 $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
449 qr/^Bookseller .* without emails at/,
450 "SendAlerts prints a warning";
451 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
453 $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
454 $bookseller->contacts->next->email('testemail@mydomain.com')->store;
456 # Ensure that the preference 'LetterLog' is set to logging
457 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
459 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
460 t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'library@domain.com' );
463 warning_like {
464 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ) }
465 qr|Fake send_or_die|,
466 "SendAlerts is using the mocked send_or_die routine (orderacquisition)";
467 is($err, 1, "Successfully sent order.");
468 is($email_object->email->header('To'), 'testemail@mydomain.com', "mailto correct in sent order");
469 is($email_object->email->body, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Order notice text constructed successfully');
471 my $mocked_koha_email = Test::MockModule->new('Koha::Email');
472 $mocked_koha_email->mock( 'send_or_die', sub {
473 Email::Sender::Failure->throw('something went wrong');
476 warning_like {
477 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ); }
478 qr{something went wrong},
479 'Warning is printed';
481 is($err->{error}, 'something went wrong', "Send exception, error message returned");
483 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTACQORDER';});
484 warning_like {
485 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ) }
486 qr/No orderacquisition TESTACQORDER letter transported by email/,
487 "GetPreparedLetter warns about missing notice template";
488 is($err->{'error'}, 'no_letter', "No TESTACQORDER letter was defined.");
492 warning_like {
493 $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
494 qr|Fake send_or_die|,
495 "SendAlerts is using the mocked send_or_die routine";
497 is($err, 1, "Successfully sent claim");
498 is($email_object->email->header('To'), 'testemail@mydomain.com', "mailto correct in sent claim");
499 is($email_object->email->body, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
501 my $mocked_koha_email = Test::MockModule->new('Koha::Email');
502 $mocked_koha_email->mock( 'send_or_die', sub {
503 Email::Sender::Failure->throw('something went wrong');
506 warning_like {
507 $err = SendAlerts( 'claimacquisition', [ $ordernumber ] , 'TESTACQCLAIM' ); }
508 qr{something went wrong},
509 'Warning is printed';
511 is($err->{error}, 'something went wrong', "Send exception, error message returned");
515 use C4::Serials;
517 my $notes = 'notes';
518 my $internalnotes = 'intnotes';
519 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
520 my $subscriptionid = NewSubscription(
521 undef, "", undef, undef, undef, $biblionumber,
522 '2013-01-01', 1, undef, undef, undef,
523 undef, undef, undef, undef, undef, undef,
524 1, $notes,undef, '2013-01-01', undef, 1,
525 undef, undef, 0, $internalnotes, 0,
526 undef, undef, 0, undef, '2013-12-31', 0
528 $dbh->do(q{INSERT INTO letter (module, code, name, title, content) VALUES ('serial','RLIST','Serial issue notification','Serial issue notification','<<biblio.title>>,<<subscription.subscriptionid>>,<<serial.serialseq>>');});
529 my ($serials_count, @serials) = GetSerials($subscriptionid);
530 my $serial = $serials[0];
532 my $patron = Koha::Patron->new({
533 firstname => 'John',
534 surname => 'Smith',
535 categorycode => $patron_category,
536 branchcode => $library->{branchcode},
537 dateofbirth => $date,
538 email => 'john.smith@test.de',
539 })->store;
540 my $borrowernumber = $patron->borrowernumber;
541 my $subscription = Koha::Subscriptions->find( $subscriptionid );
542 $subscription->add_subscriber( $patron );
544 t::lib::Mocks::mock_userenv({ branch => $library->{branchcode} });
545 my $err2;
546 warning_like {
547 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
548 qr|Fake send_or_die|,
549 "SendAlerts is using the mocked send_or_die routine";
551 is($err2, 1, "Successfully sent serial notification");
552 is($email_object->email->header('To'), 'john.smith@test.de', "mailto correct in sent serial notification");
553 is($email_object->email->body, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
555 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'robert.tables@mail.com' );
557 my $err3;
558 warning_like {
559 $err3 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
560 qr|Fake send_or_die|,
561 "SendAlerts is using the mocked send_or_die routine";
562 is($email_object->email->header('To'), 'robert.tables@mail.com', "mailto address overwritten by SendAllMailsTo preference");
564 my $mocked_koha_email = Test::MockModule->new('Koha::Email');
565 $mocked_koha_email->mock( 'send_or_die', sub {
566 Email::Sender::Failure->throw('something went wrong');
569 warning_like {
570 $err = SendAlerts( 'issue', $serial->{serialid} , 'RLIST' ); }
571 qr{something went wrong},
572 'Warning is printed';
574 is($err->{error}, 'something went wrong', "Send exception, error message returned");
577 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', '' );
579 subtest 'SendAlerts - claimissue' => sub {
580 plan tests => 13;
582 use C4::Serials;
584 $dbh->do(q{INSERT INTO letter (module, code, name, title, content) VALUES ('claimissues','TESTSERIALCLAIM','Serial claim test','Serial claim test','<<serial.serialid>>|<<subscription.startdate>>|<<biblio.title>>|<<biblioitems.issn>>');});
586 my $bookseller = Koha::Acquisition::Bookseller->new(
588 name => "my vendor",
589 address1 => "bookseller's address",
590 phone => "0123456",
591 active => 1,
592 deliverytime => 5,
594 )->store;
595 my $booksellerid = $bookseller->id;
597 Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1, booksellerid => $booksellerid } )->store;
599 my $bib = MARC::Record->new();
600 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
601 $bib->append_fields(
602 MARC::Field->new('011', ' ', ' ', a => 'xxxx-yyyy'),
603 MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
605 } else {
606 $bib->append_fields(
607 MARC::Field->new('022', ' ', ' ', a => 'xxxx-yyyy'),
608 MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
611 my ($biblionumber) = AddBiblio($bib, '');
613 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
614 my $subscriptionid = NewSubscription(
615 undef, "", $booksellerid, undef, undef, $biblionumber,
616 '2013-01-01', 1, undef, undef, undef,
617 undef, undef, undef, undef, undef, undef,
618 1, 'public',undef, '2013-01-01', undef, 1,
619 undef, undef, 0, 'internal', 0,
620 undef, undef, 0, undef, '2013-12-31', 0
623 my ($serials_count, @serials) = GetSerials($subscriptionid);
624 my @serialids = ($serials[0]->{serialid});
626 my $err;
627 warning_like {
628 $err = SendAlerts( 'claimissues', \@serialids, 'TESTSERIALCLAIM' ) }
629 qr/^Bookseller .* without emails at/,
630 "Warn on vendor without email address";
632 $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
633 $bookseller->contacts->next->email('testemail@mydomain.com')->store;
635 # Ensure that the preference 'LetterLog' is set to logging
636 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
638 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
639 t::lib::Mocks::mock_userenv({ branchcode => $library->{branchcode} });
641 t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'library@domain.com' );
644 warning_like {
645 $err = SendAlerts( 'claimissues', \@serialids , 'TESTSERIALCLAIM' ) }
646 qr|Fake send_or_die|,
647 "SendAlerts is using the mocked send_or_die routine (claimissues)";
648 is( $err, 1, "Successfully sent claim" );
649 is( $email_object->email->header('To'),
650 'testemail@mydomain.com', "mailto correct in sent claim" );
652 $email_object->email->body,
653 "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy",
654 'Serial claim letter for 1 issue constructed successfully'
657 my $mocked_koha_email = Test::MockModule->new('Koha::Email');
658 $mocked_koha_email->mock( 'send_or_die', sub {
659 Email::Sender::Failure->throw('something went wrong');
662 warning_like {
663 $err = SendAlerts( 'claimissues', \@serialids , 'TESTSERIALCLAIM' ); }
664 qr{something went wrong},
665 'Warning is printed';
667 is($err->{error}, 'something went wrong', "Send exception, error message returned");
671 my $publisheddate = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
672 my $serialexpected = ( C4::Serials::findSerialsByStatus( 1, $subscriptionid ) )[0];
673 ModSerialStatus( $serials[0]->{serialid}, "No. 1", $publisheddate, $publisheddate, $publisheddate, '3', 'a note' );
674 ($serials_count, @serials) = GetSerials($subscriptionid);
675 push @serialids, ($serials[1]->{serialid});
677 warning_like { $err = SendAlerts( 'claimissues', \@serialids, 'TESTSERIALCLAIM' ); }
678 qr|Fake send_or_die|,
679 "SendAlerts is using the mocked send_or_die routine (claimissues)";
682 $email_object->email->body,
683 "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy"
684 . $email_object->email->crlf
685 . "$serialids[1]|2013-01-01|Silence in the library|xxxx-yyyy",
686 "Serial claim letter for 2 issues constructed successfully"
689 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTSERIALCLAIM';});
690 warning_like {
691 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTSERIALCLAIM' ) }
692 qr/No orderacquisition TESTSERIALCLAIM letter transported by email/,
693 "GetPreparedLetter warns about missing notice template";
694 is($err->{'error'}, 'no_letter', "No TESTSERIALCLAIM letter was defined");
699 subtest 'GetPreparedLetter' => sub {
700 plan tests => 4;
702 Koha::Notice::Template->new(
704 module => 'test',
705 code => 'test',
706 branchcode => '',
707 message_transport_type => 'email'
709 )->store;
710 my $letter;
711 warning_like {
712 $letter = C4::Letters::GetPreparedLetter(
713 module => 'test',
714 letter_code => 'test',
717 qr{^ERROR: nothing to substitute},
718 'GetPreparedLetter should warn if tables, substiture and repeat are not set';
719 is( $letter, undef,
720 'No letter should be returned by GetPreparedLetter if something went wrong'
723 warning_like {
724 $letter = C4::Letters::GetPreparedLetter(
725 module => 'test',
726 letter_code => 'test',
727 substitute => {}
730 qr{^ERROR: nothing to substitute},
731 'GetPreparedLetter should warn if tables, substiture and repeat are not set, even if the key is passed';
732 is( $letter, undef,
733 'No letter should be returned by GetPreparedLetter if something went wrong'
740 subtest 'TranslateNotices' => sub {
741 plan tests => 4;
743 t::lib::Mocks::mock_preference( 'TranslateNotices', '1' );
745 $dbh->do(
747 INSERT INTO letter (module, code, branchcode, name, title, content, message_transport_type, lang) VALUES
748 ('test', 'code', '', 'test', 'a test', 'just a test', 'email', 'default'),
749 ('test', 'code', '', 'test', 'una prueba', 'solo una prueba', 'email', 'es-ES');
750 | );
751 my $substitute = {};
752 my $letter = C4::Letters::GetPreparedLetter(
753 module => 'test',
754 tables => $tables,
755 letter_code => 'code',
756 message_transport_type => 'email',
757 substitute => $substitute,
760 $letter->{title},
761 'a test',
762 'GetPreparedLetter should return the default one if the lang parameter is not provided'
765 $letter = C4::Letters::GetPreparedLetter(
766 module => 'test',
767 tables => $tables,
768 letter_code => 'code',
769 message_transport_type => 'email',
770 substitute => $substitute,
771 lang => 'es-ES',
773 is( $letter->{title}, 'una prueba',
774 'GetPreparedLetter should return the required notice if it exists' );
776 $letter = C4::Letters::GetPreparedLetter(
777 module => 'test',
778 tables => $tables,
779 letter_code => 'code',
780 message_transport_type => 'email',
781 substitute => $substitute,
782 lang => 'fr-FR',
785 $letter->{title},
786 'a test',
787 'GetPreparedLetter should return the default notice if the one required does not exist'
790 t::lib::Mocks::mock_preference( 'TranslateNotices', '' );
792 $letter = C4::Letters::GetPreparedLetter(
793 module => 'test',
794 tables => $tables,
795 letter_code => 'code',
796 message_transport_type => 'email',
797 substitute => $substitute,
798 lang => 'es-ES',
800 is( $letter->{title}, 'a test',
801 'GetPreparedLetter should return the default notice if pref disabled but additional language exists' );
805 subtest 'SendQueuedMessages' => sub {
807 plan tests => 12;
809 t::lib::Mocks::mock_preference( 'SMSSendDriver', 'Email' );
810 t::lib::Mocks::mock_preference('EmailSMSSendDriverFromAddress', '');
812 my $patron = Koha::Patrons->find($borrowernumber);
813 $dbh->do(q|
814 INSERT INTO message_queue(borrowernumber, subject, content, message_transport_type, status, letter_code)
815 VALUES (?, 'subject', 'content', 'sms', 'pending', 'just_a_code')
816 |, undef, $borrowernumber
818 eval { C4::Letters::SendQueuedMessages(); };
819 is( $@, '', 'SendQueuedMessages should not explode if the patron does not have a sms provider set' );
821 my $sms_pro = $builder->build_object({ class => 'Koha::SMS::Providers', value => { domain => 'kidclamp.rocks' } });
822 $patron->set( { smsalertnumber => '5555555555', sms_provider_id => $sms_pro->id() } )->store;
823 $message_id = C4::Letters::EnqueueLetter($my_message); #using datas set around line 95 and forward
825 warning_like { C4::Letters::SendQueuedMessages(); }
826 qr|Fake send_or_die|,
827 "SendAlerts is using the mocked send_or_die routine (claimissues)";
829 my $message = $schema->resultset('MessageQueue')->search({
830 borrowernumber => $borrowernumber,
831 status => 'sent'
832 })->next();
834 is( $message->to_address(), '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address not set' );
836 $message->from_address(),
837 'from@example.com',
838 'SendQueuedMessages uses message queue item \"from address\" for SMS by email when EmailSMSSendDriverFromAddress system preference is not set'
841 $schema->resultset('MessageQueue')->search({borrowernumber => $borrowernumber, status => 'sent'})->delete(); #clear borrower queue
843 t::lib::Mocks::mock_preference('EmailSMSSendDriverFromAddress', 'override@example.com');
845 $message_id = C4::Letters::EnqueueLetter($my_message);
846 warning_like { C4::Letters::SendQueuedMessages(); }
847 qr|Fake send_or_die|,
848 "SendAlerts is using the mocked send_or_die routine (claimissues)";
850 $message = $schema->resultset('MessageQueue')->search({
851 borrowernumber => $borrowernumber,
852 status => 'sent'
853 })->next();
856 $message->from_address(),
857 'override@example.com',
858 'SendQueuedMessages uses EmailSMSSendDriverFromAddress value for SMS by email when EmailSMSSendDriverFromAddress is set'
861 $schema->resultset('MessageQueue')->search({borrowernumber => $borrowernumber,status => 'sent'})->delete(); #clear borrower queue
862 $my_message->{to_address} = 'fixme@kidclamp.iswrong';
863 $message_id = C4::Letters::EnqueueLetter($my_message);
865 my $number_attempted = C4::Letters::SendQueuedMessages({
866 borrowernumber => -1, # -1 still triggers the borrowernumber condition
867 letter_code => 'PASSWORD_RESET',
869 is ( $number_attempted, 0, 'There were no password reset messages for SendQueuedMessages to attempt.' );
871 warning_like { C4::Letters::SendQueuedMessages(); }
872 qr|Fake send_or_die|,
873 "SendAlerts is using the mocked send_or_die routine (claimissues)";
875 my $sms_message_address = $schema->resultset('MessageQueue')->search({
876 borrowernumber => $borrowernumber,
877 status => 'sent'
878 })->next()->to_address();
879 is( $sms_message_address, '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address is set incorrectly' );
883 subtest 'get_item_content' => sub {
884 plan tests => 2;
886 t::lib::Mocks::mock_preference('dateformat', 'metric');
887 t::lib::Mocks::mock_preference('timeformat', '24hr');
888 my @items = (
889 {date_due => '2041-01-01 12:34', title => 'a first title', barcode => 'a_first_barcode', author => 'a_first_author', itemnumber => 1 },
890 {date_due => '2042-01-02 23:45', title => 'a second title', barcode => 'a_second_barcode', author => 'a_second_author', itemnumber => 2 },
892 my @item_content_fields = qw( date_due title barcode author itemnumber );
894 my $items_content;
895 for my $item ( @items ) {
896 $items_content .= C4::Letters::get_item_content( { item => $item, item_content_fields => \@item_content_fields } );
899 my $expected_items_content = <<EOF;
900 01/01/2041 12:34\ta first title\ta_first_barcode\ta_first_author\t1
901 02/01/2042 23:45\ta second title\ta_second_barcode\ta_second_author\t2
903 is( $items_content, $expected_items_content, 'get_item_content should return correct items info with time (default)' );
906 $items_content = q||;
907 for my $item ( @items ) {
908 $items_content .= C4::Letters::get_item_content( { item => $item, item_content_fields => \@item_content_fields, dateonly => 1, } );
911 $expected_items_content = <<EOF;
912 01/01/2041\ta first title\ta_first_barcode\ta_first_author\t1
913 02/01/2042\ta second title\ta_second_barcode\ta_second_author\t2
915 is( $items_content, $expected_items_content, 'get_item_content should return correct items info without time (if dateonly => 1)' );
918 subtest 'Test limit parameter for SendQueuedMessages' => sub {
919 plan tests => 3;
921 my $dbh = C4::Context->dbh;
923 my $borrowernumber = Koha::Patron->new({
924 firstname => 'Jane',
925 surname => 'Smith',
926 categorycode => $patron_category,
927 branchcode => $library->{branchcode},
928 dateofbirth => $date,
929 smsalertnumber => undef,
930 })->store->borrowernumber;
932 $dbh->do(q|DELETE FROM message_queue|);
933 $my_message = {
934 'letter' => {
935 'content' => 'a message',
936 'metadata' => 'metadata',
937 'code' => 'TEST_MESSAGE',
938 'content_type' => 'text/plain',
939 'title' => 'message title'
941 'borrowernumber' => $borrowernumber,
942 'to_address' => undef,
943 'message_transport_type' => 'sms',
944 'from_address' => 'from@example.com'
946 C4::Letters::EnqueueLetter($my_message);
947 C4::Letters::EnqueueLetter($my_message);
948 C4::Letters::EnqueueLetter($my_message);
949 C4::Letters::EnqueueLetter($my_message);
950 C4::Letters::EnqueueLetter($my_message);
951 my $messages_processed = C4::Letters::SendQueuedMessages( { limit => 1 } );
952 is( $messages_processed, 1,
953 'Processed 1 message with limit of 1 and 5 unprocessed messages' );
954 $messages_processed = C4::Letters::SendQueuedMessages( { limit => 2 } );
955 is( $messages_processed, 2,
956 'Processed 2 message with limit of 2 and 4 unprocessed messages' );
957 $messages_processed = C4::Letters::SendQueuedMessages( { limit => 3 } );
958 is( $messages_processed, 2,
959 'Processed 2 message with limit of 3 and 2 unprocessed messages' );