Bug 17776: (QA follow-up) Consistent regex for Plack detection
[koha.git] / t / db_dependent / Letters.t
bloba66491881d1a8af64a468ea216e0245d3cc030dc
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 => 65;
22 use Test::MockModule;
23 use Test::Warn;
25 use MARC::Record;
27 my %mail;
28 my $module = new Test::MockModule('Mail::Sendmail');
29 $module->mock(
30 'sendmail',
31 sub {
32 warn "Fake sendmail";
33 %mail = @_;
37 use_ok('C4::Context');
38 use_ok('C4::Members');
39 use_ok('C4::Acquisition');
40 use_ok('C4::Biblio');
41 use_ok('C4::Letters');
42 use t::lib::Mocks;
43 use t::lib::TestBuilder;
44 use Koha::Database;
45 use Koha::DateUtils qw( dt_from_string output_pref );
46 use Koha::Acquisition::Booksellers;
47 use Koha::Acquisition::Bookseller::Contacts;
48 use Koha::Acquisition::Orders;
49 use Koha::Libraries;
50 use Koha::Notice::Templates;
51 use Koha::Patrons;
52 use Koha::Subscriptions;
53 my $schema = Koha::Database->schema;
54 $schema->storage->txn_begin();
56 my $builder = t::lib::TestBuilder->new;
57 my $dbh = C4::Context->dbh;
58 $dbh->{RaiseError} = 1;
60 $dbh->do(q|DELETE FROM letter|);
61 $dbh->do(q|DELETE FROM message_queue|);
62 $dbh->do(q|DELETE FROM message_transport_types|);
64 my $library = $builder->build({
65 source => 'Branch',
66 });
67 my $patron_category = $builder->build({ source => 'Category' })->{categorycode};
68 my $date = dt_from_string;
69 my $borrowernumber = Koha::Patron->new({
70 firstname => 'Jane',
71 surname => 'Smith',
72 categorycode => $patron_category,
73 branchcode => $library->{branchcode},
74 dateofbirth => $date,
75 smsalertnumber => undef,
76 })->store->borrowernumber;
78 my $marc_record = MARC::Record->new;
79 my( $biblionumber, $biblioitemnumber ) = AddBiblio( $marc_record, '' );
83 # GetMessageTransportTypes
84 my $mtts = C4::Letters::GetMessageTransportTypes();
85 is( @$mtts, 0, 'GetMessageTransportTypes returns the correct number of message types' );
87 $dbh->do(q|
88 INSERT INTO message_transport_types( message_transport_type ) VALUES ('email'), ('phone'), ('print'), ('sms')
89 |);
90 $mtts = C4::Letters::GetMessageTransportTypes();
91 is_deeply( $mtts, ['email', 'phone', 'print', 'sms'], 'GetMessageTransportTypes returns all values' );
94 # EnqueueLetter
95 is( C4::Letters::EnqueueLetter(), undef, 'EnqueueLetter without argument returns undef' );
97 my $my_message = {
98 borrowernumber => $borrowernumber,
99 message_transport_type => 'sms',
100 to_address => undef,
101 from_address => 'from@example.com',
103 my $message_id = C4::Letters::EnqueueLetter($my_message);
104 is( $message_id, undef, 'EnqueueLetter without the letter argument returns undef' );
106 delete $my_message->{message_transport_type};
107 $my_message->{letter} = {
108 content => 'a message',
109 title => 'message title',
110 metadata => 'metadata',
111 code => 'TEST_MESSAGE',
112 content_type => 'text/plain',
115 $message_id = C4::Letters::EnqueueLetter($my_message);
116 is( $message_id, undef, 'EnqueueLetter without the message type argument argument returns undef' );
118 $my_message->{message_transport_type} = 'sms';
119 $message_id = C4::Letters::EnqueueLetter($my_message);
120 ok(defined $message_id && $message_id > 0, 'new message successfully queued');
123 # GetQueuedMessages
124 my $messages = C4::Letters::GetQueuedMessages();
125 is( @$messages, 1, 'GetQueuedMessages without argument returns all the entries' );
127 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
128 is( @$messages, 1, 'one message stored for the borrower' );
129 is( $messages->[0]->{message_id}, $message_id, 'EnqueueLetter returns the message id correctly' );
130 is( $messages->[0]->{borrowernumber}, $borrowernumber, 'EnqueueLetter stores the borrower number correctly' );
131 is( $messages->[0]->{subject}, $my_message->{letter}->{title}, 'EnqueueLetter stores the subject correctly' );
132 is( $messages->[0]->{content}, $my_message->{letter}->{content}, 'EnqueueLetter stores the content correctly' );
133 is( $messages->[0]->{message_transport_type}, $my_message->{message_transport_type}, 'EnqueueLetter stores the message type correctly' );
134 is( $messages->[0]->{status}, 'pending', 'EnqueueLetter stores the status pending correctly' );
137 # SendQueuedMessages
138 my $messages_processed = C4::Letters::SendQueuedMessages( { type => 'email' });
139 is($messages_processed, 0, 'No queued messages processed if type limit passed with unused type');
140 $messages_processed = C4::Letters::SendQueuedMessages( { type => 'sms' });
141 is($messages_processed, 1, 'All queued messages processed, found correct number of messages with type limit');
142 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
144 $messages->[0]->{status},
145 'failed',
146 'message marked failed if tried to send SMS message for borrower with no smsalertnumber set (bug 11208)'
149 # ResendMessage
150 my $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
151 my $message = C4::Letters::GetMessage( $messages->[0]->{message_id});
152 is( $resent, 1, 'The message should have been resent' );
153 is($message->{status},'pending', 'ResendMessage sets status to pending correctly (bug 12426)');
154 $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
155 is( $resent, 0, 'The message should not have been resent again' );
156 $resent = C4::Letters::ResendMessage();
157 is( $resent, undef, 'ResendMessage should return undef if not message_id given' );
159 # GetLetters
160 my $letters = C4::Letters::GetLetters();
161 is( @$letters, 0, 'GetLetters returns the correct number of letters' );
163 my $title = q|<<branches.branchname>> - <<status>>|;
164 my $content = q{Dear <<borrowers.firstname>> <<borrowers.surname>>,
165 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.
167 <<branches.branchname>>
168 <<branches.branchaddress1>>
169 URL: <<OPACBaseURL>>
171 The following item(s) is/are currently <<status>>:
173 <item> <<count>>. <<items.itemcallnumber>>, Barcode: <<items.barcode>> </item>
175 Thank-you for your prompt attention to this matter.
176 Don't forget your date of birth: <<borrowers.dateofbirth>>.
177 Look at this wonderful biblio timestamp: <<biblio.timestamp>>.
180 $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 );
181 $letters = C4::Letters::GetLetters();
182 is( @$letters, 1, 'GetLetters returns the correct number of letters' );
183 is( $letters->[0]->{module}, 'my module', 'GetLetters gets the module correctly' );
184 is( $letters->[0]->{code}, 'my code', 'GetLetters gets the code correctly' );
185 is( $letters->[0]->{name}, 'my name', 'GetLetters gets the name correctly' );
188 # getletter
189 subtest 'getletter' => sub {
190 plan tests => 16;
191 t::lib::Mocks::mock_preference('IndependentBranches', 0);
192 my $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
193 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
194 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
195 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
196 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
197 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
198 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
199 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
200 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
202 my $context = Test::MockModule->new('C4::Context');
203 $context->mock( 'userenv', sub {
204 return {
205 flags => 1,
206 branch => "anotherlib" }
209 t::lib::Mocks::mock_preference('IndependentBranches', 1);
210 $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 $context->unmock('userenv');
225 # Regression test for Bug 14206
226 $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 );
227 my $letter14206_a = C4::Letters::getletter('my module', 'my code', 'FFL' );
228 is( $letter14206_a->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type not passed, correct mtt detected' );
229 my $letter14206_b = C4::Letters::getletter('my module', 'my code', 'FFL', 'print');
230 is( $letter14206_b->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type passed, correct mtt detected' );
232 # test for overdue_notices.pl
233 my $overdue_rules = {
234 letter1 => 'my code',
236 my $i = 1;
237 my $branchcode = 'FFL';
238 my $letter14206_c = C4::Letters::getletter('my module', $overdue_rules->{"letter$i"}, $branchcode);
239 is( $letter14206_c->{message_transport_type}, 'print', 'Bug 14206 - correct mtt detected for call from overdue_notices.pl' );
241 # GetPreparedLetter
242 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
244 my $sms_content = 'This is a SMS for an <<status>>';
245 $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 );
247 my $tables = {
248 borrowers => $borrowernumber,
249 branches => $library->{branchcode},
250 biblio => $biblionumber,
252 my $substitute = {
253 status => 'overdue',
255 my $repeat = [
257 itemcallnumber => 'my callnumber1',
258 barcode => '1234',
261 itemcallnumber => 'my callnumber2',
262 barcode => '5678',
265 my $prepared_letter = GetPreparedLetter((
266 module => 'my module',
267 branchcode => $library->{branchcode},
268 letter_code => 'my code',
269 tables => $tables,
270 substitute => $substitute,
271 repeat => $repeat,
273 my $retrieved_library = Koha::Libraries->find($library->{branchcode});
274 my $my_title_letter = $retrieved_library->branchname . qq| - $substitute->{status}|;
275 my $biblio_timestamp = dt_from_string( GetBiblioData($biblionumber)->{timestamp} );
276 my $my_content_letter = qq|Dear Jane Smith,
277 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.
279 |.$retrieved_library->branchname.qq|
280 |.$retrieved_library->branchaddress1.qq|
281 URL: http://thisisatest.com
283 The following item(s) is/are currently $substitute->{status}:
285 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
286 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
288 Thank-you for your prompt attention to this matter.
289 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
290 Look at this wonderful biblio timestamp: | . output_pref({ dt => $biblio_timestamp }) . ".\n";
292 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
293 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
295 $prepared_letter = GetPreparedLetter((
296 module => 'my module',
297 branchcode => $library->{branchcode},
298 letter_code => 'my code',
299 tables => $tables,
300 substitute => $substitute,
301 repeat => $repeat,
302 message_transport_type => 'sms',
304 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
305 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
307 $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>>.');});
308 $prepared_letter = GetPreparedLetter((
309 module => 'test_date',
310 branchcode => '',
311 letter_code => 'test_date',
312 tables => $tables,
313 substitute => $substitute,
314 repeat => $repeat,
316 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 1' );
318 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp | dateonly>>.' WHERE code = 'test_date';});
319 $prepared_letter = GetPreparedLetter((
320 module => 'test_date',
321 branchcode => '',
322 letter_code => 'test_date',
323 tables => $tables,
324 substitute => $substitute,
325 repeat => $repeat,
327 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 2' );
329 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp|dateonly >>.' WHERE code = 'test_date';});
330 $prepared_letter = GetPreparedLetter((
331 module => 'test_date',
332 branchcode => '',
333 letter_code => 'test_date',
334 tables => $tables,
335 substitute => $substitute,
336 repeat => $repeat,
338 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 3' );
340 t::lib::Mocks::mock_preference( 'TimeFormat', '12hr' );
341 my $yesterday_night = $date->clone->add( days => -1 )->set_hour(22);
342 $dbh->do(q|UPDATE biblio SET timestamp = ? WHERE biblionumber = ?|, undef, $yesterday_night, $biblionumber );
343 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp>>.' WHERE code = 'test_date';});
344 $prepared_letter = GetPreparedLetter((
345 module => 'test_date',
346 branchcode => '',
347 letter_code => 'test_date',
348 tables => $tables,
349 substitute => $substitute,
350 repeat => $repeat,
352 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $yesterday_night }) . q|.|, 'dateonly test 3' );
354 $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>');});
355 $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>');});
357 # Test that _parseletter doesn't modify its parameters bug 15429
359 my $values = { dateexpiry => '2015-12-13', };
360 C4::Letters::_parseletter($prepared_letter, 'borrowers', $values);
361 is( $values->{dateexpiry}, '2015-12-13', "_parseletter doesn't modify its parameters" );
364 my $bookseller = Koha::Acquisition::Bookseller->new(
366 name => "my vendor",
367 address1 => "bookseller's address",
368 phone => "0123456",
369 active => 1,
370 deliverytime => 5,
372 )->store;
373 my $booksellerid = $bookseller->id;
375 Koha::Acquisition::Bookseller::Contact->new( { name => 'John Smith', phone => '0123456x1', claimacquisition => 1, orderacquisition => 1, booksellerid => $booksellerid } )->store;
376 Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1, booksellerid => $booksellerid } )->store;
377 my $basketno = NewBasket($booksellerid, 1);
379 my $budgetid = C4::Budgets::AddBudget({
380 budget_code => "budget_code_test_letters",
381 budget_name => "budget_name_test_letters",
384 my $bib = MARC::Record->new();
385 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
386 $bib->append_fields(
387 MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
389 } else {
390 $bib->append_fields(
391 MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
395 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
396 my $order = Koha::Acquisition::Order->new(
398 basketno => $basketno,
399 quantity => 1,
400 biblionumber => $biblionumber,
401 budget_id => $budgetid,
403 )->store;
404 my $ordernumber = $order->ordernumber;
406 C4::Acquisition::CloseBasket( $basketno );
407 my $err;
408 warning_like {
409 $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
410 qr/^Bookseller .* without emails at/,
411 "SendAlerts prints a warning";
412 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
414 $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
415 $bookseller->contacts->next->email('testemail@mydomain.com')->store;
417 # Ensure that the preference 'LetterLog' is set to logging
418 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
420 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
421 C4::Context->_new_userenv('DUMMY');
422 C4::Context->set_userenv( 0, 0, 0, 'firstname', 'surname', $library->{branchcode}, 'My Library', 0, '', '');
423 t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'library@domain.com' );
426 warning_is {
427 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ) }
428 "Fake sendmail",
429 "SendAlerts is using the mocked sendmail routine (orderacquisition)";
430 is($err, 1, "Successfully sent order.");
431 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent order");
432 is($mail{'Message'}, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Order notice text constructed successfully');
434 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTACQORDER';});
435 warning_like {
436 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ) }
437 qr/No orderacquisition TESTACQORDER letter transported by email/,
438 "GetPreparedLetter warns about missing notice template";
439 is($err->{'error'}, 'no_letter', "No TESTACQORDER letter was defined.");
443 warning_is {
444 $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
445 "Fake sendmail",
446 "SendAlerts is using the mocked sendmail routine";
448 is($err, 1, "Successfully sent claim");
449 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
450 is($mail{'Message'}, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
454 use C4::Serials;
456 my $notes = 'notes';
457 my $internalnotes = 'intnotes';
458 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
459 my $subscriptionid = NewSubscription(
460 undef, "", undef, undef, undef, $biblionumber,
461 '2013-01-01', 1, undef, undef, undef,
462 undef, undef, undef, undef, undef, undef,
463 1, $notes,undef, '2013-01-01', undef, 1,
464 undef, undef, 0, $internalnotes, 0,
465 undef, undef, 0, undef, '2013-12-31', 0
467 $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>>');});
468 my ($serials_count, @serials) = GetSerials($subscriptionid);
469 my $serial = $serials[0];
471 my $patron = Koha::Patron->new({
472 firstname => 'John',
473 surname => 'Smith',
474 categorycode => $patron_category,
475 branchcode => $library->{branchcode},
476 dateofbirth => $date,
477 email => 'john.smith@test.de',
478 })->store;
479 my $borrowernumber = $patron->borrowernumber;
480 my $subscription = Koha::Subscriptions->find( $subscriptionid );
481 $subscription->add_subscriber( $patron );
483 my $err2;
484 warning_is {
485 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
486 "Fake sendmail",
487 "SendAlerts is using the mocked sendmail routine";
488 is($err2, 1, "Successfully sent serial notification");
489 is($mail{'To'}, 'john.smith@test.de', "mailto correct in sent serial notification");
490 is($mail{'Message'}, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
493 subtest 'SendAlerts - claimissue' => sub {
494 plan tests => 8;
496 use C4::Serials;
498 $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>>');});
500 my $bookseller = Koha::Acquisition::Bookseller->new(
502 name => "my vendor",
503 address1 => "bookseller's address",
504 phone => "0123456",
505 active => 1,
506 deliverytime => 5,
508 )->store;
509 my $booksellerid = $bookseller->id;
511 Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1, booksellerid => $booksellerid } )->store;
513 my $bib = MARC::Record->new();
514 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
515 $bib->append_fields(
516 MARC::Field->new('011', ' ', ' ', a => 'xxxx-yyyy'),
517 MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
519 } else {
520 $bib->append_fields(
521 MARC::Field->new('022', ' ', ' ', a => 'xxxx-yyyy'),
522 MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
525 my ($biblionumber) = AddBiblio($bib, '');
527 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
528 my $subscriptionid = NewSubscription(
529 undef, "", $booksellerid, undef, undef, $biblionumber,
530 '2013-01-01', 1, undef, undef, undef,
531 undef, undef, undef, undef, undef, undef,
532 1, 'public',undef, '2013-01-01', undef, 1,
533 undef, undef, 0, 'internal', 0,
534 undef, undef, 0, undef, '2013-12-31', 0
537 my ($serials_count, @serials) = GetSerials($subscriptionid);
538 my @serialids = ($serials[0]->{serialid});
540 my $err;
541 warning_like {
542 $err = SendAlerts( 'claimissues', \@serialids, 'TESTSERIALCLAIM' ) }
543 qr/^Bookseller .* without emails at/,
544 "Warn on vendor without email address";
546 $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
547 $bookseller->contacts->next->email('testemail@mydomain.com')->store;
549 # Ensure that the preference 'LetterLog' is set to logging
550 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
552 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
553 C4::Context->_new_userenv('DUMMY');
554 C4::Context->set_userenv( 0, 0, 0, 'firstname', 'surname', $library->{branchcode}, 'My Library', 0, '', '');
555 t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'library@domain.com' );
558 warning_is {
559 $err = SendAlerts( 'claimissues', \@serialids , 'TESTSERIALCLAIM' ) }
560 "Fake sendmail",
561 "SendAlerts is using the mocked sendmail routine (claimissues)";
562 is($err, 1, "Successfully sent claim");
563 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
564 is($mail{'Message'}, "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy", 'Serial claim letter for 1 issue constructed successfully');
568 my $publisheddate = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
569 my $serialexpected = ( C4::Serials::findSerialsByStatus( 1, $subscriptionid ) )[0];
570 ModSerialStatus( $serials[0]->{serialid}, "No. 1", $publisheddate, $publisheddate, $publisheddate, '3', 'a note' );
571 ($serials_count, @serials) = GetSerials($subscriptionid);
572 push @serialids, ($serials[1]->{serialid});
574 $err = SendAlerts( 'claimissues', \@serialids , 'TESTSERIALCLAIM' );
575 is($mail{'Message'}, "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy\n$serialids[1]|2013-01-01|Silence in the library|xxxx-yyyy", "Serial claim letter for 2 issues constructed successfully");
577 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTSERIALCLAIM';});
578 warning_like {
579 $err = SendAlerts( 'orderacquisition', $basketno , 'TESTSERIALCLAIM' ) }
580 qr/No orderacquisition TESTSERIALCLAIM letter transported by email/,
581 "GetPreparedLetter warns about missing notice template";
582 is($err->{'error'}, 'no_letter', "No TESTSERIALCLAIM letter was defined");
587 subtest 'GetPreparedLetter' => sub {
588 plan tests => 4;
590 Koha::Notice::Template->new(
592 module => 'test',
593 code => 'test',
594 branchcode => '',
595 message_transport_type => 'email'
597 )->store;
598 my $letter;
599 warning_like {
600 $letter = C4::Letters::GetPreparedLetter(
601 module => 'test',
602 letter_code => 'test',
605 qr{^ERROR: nothing to substitute},
606 'GetPreparedLetter should warn if tables, substiture and repeat are not set';
607 is( $letter, undef,
608 'No letter should be returned by GetPreparedLetter if something went wrong'
611 warning_like {
612 $letter = C4::Letters::GetPreparedLetter(
613 module => 'test',
614 letter_code => 'test',
615 substitute => {}
618 qr{^ERROR: nothing to substitute},
619 'GetPreparedLetter should warn if tables, substiture and repeat are not set, even if the key is passed';
620 is( $letter, undef,
621 'No letter should be returned by GetPreparedLetter if something went wrong'
628 subtest 'TranslateNotices' => sub {
629 plan tests => 4;
631 t::lib::Mocks::mock_preference( 'TranslateNotices', '1' );
633 $dbh->do(
635 INSERT INTO letter (module, code, branchcode, name, title, content, message_transport_type, lang) VALUES
636 ('test', 'code', '', 'test', 'a test', 'just a test', 'email', 'default'),
637 ('test', 'code', '', 'test', 'una prueba', 'solo una prueba', 'email', 'es-ES');
638 | );
639 my $substitute = {};
640 my $letter = C4::Letters::GetPreparedLetter(
641 module => 'test',
642 tables => $tables,
643 letter_code => 'code',
644 message_transport_type => 'email',
645 substitute => $substitute,
648 $letter->{title},
649 'a test',
650 'GetPreparedLetter should return the default one if the lang parameter is not provided'
653 $letter = C4::Letters::GetPreparedLetter(
654 module => 'test',
655 tables => $tables,
656 letter_code => 'code',
657 message_transport_type => 'email',
658 substitute => $substitute,
659 lang => 'es-ES',
661 is( $letter->{title}, 'una prueba',
662 'GetPreparedLetter should return the required notice if it exists' );
664 $letter = C4::Letters::GetPreparedLetter(
665 module => 'test',
666 tables => $tables,
667 letter_code => 'code',
668 message_transport_type => 'email',
669 substitute => $substitute,
670 lang => 'fr-FR',
673 $letter->{title},
674 'a test',
675 'GetPreparedLetter should return the default notice if the one required does not exist'
678 t::lib::Mocks::mock_preference( 'TranslateNotices', '' );
680 $letter = C4::Letters::GetPreparedLetter(
681 module => 'test',
682 tables => $tables,
683 letter_code => 'code',
684 message_transport_type => 'email',
685 substitute => $substitute,
686 lang => 'es-ES',
688 is( $letter->{title}, 'a test',
689 'GetPreparedLetter should return the default notice if pref disabled but additional language exists' );
693 subtest 'SendQueuedMessages' => sub {
695 plan tests => 4;
696 t::lib::Mocks::mock_preference( 'SMSSendDriver', 'Email' );
697 my $patron = Koha::Patrons->find($borrowernumber);
698 $dbh->do(q|
699 INSERT INTO message_queue(borrowernumber, subject, content, message_transport_type, status, letter_code)
700 VALUES (?, 'subject', 'content', 'sms', 'pending', 'just_a_code')
701 |, undef, $borrowernumber
703 eval { C4::Letters::SendQueuedMessages(); };
704 is( $@, '', 'SendQueuedMessages should not explode if the patron does not have a sms provider set' );
706 my $sms_pro = $builder->build_object({ class => 'Koha::SMS::Providers', value => { domain => 'kidclamp.rocks' } });
707 $patron->set( { smsalertnumber => '5555555555', sms_provider_id => $sms_pro->id() } )->store;
708 $message_id = C4::Letters::EnqueueLetter($my_message); #using datas set around line 95 and forward
709 C4::Letters::SendQueuedMessages();
710 my $sms_message_address = $schema->resultset('MessageQueue')->search({
711 borrowernumber => $borrowernumber,
712 status => 'sent'
713 })->next()->to_address();
714 is( $sms_message_address, '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address not set' );
715 $schema->resultset('MessageQueue')->search({borrowernumber => $borrowernumber,status => 'sent'})->delete(); #clear borrower queue
716 $my_message->{to_address} = 'fixme@kidclamp.iswrong';
717 $message_id = C4::Letters::EnqueueLetter($my_message);
719 my $number_attempted = C4::Letters::SendQueuedMessages({
720 borrowernumber => -1, # -1 still triggers the borrowernumber condition
721 letter_code => 'PASSWORD_RESET',
723 is ( $number_attempted, 0, 'There were no password reset messages for SendQueuedMessages to attempt.' );
725 C4::Letters::SendQueuedMessages();
726 $sms_message_address = $schema->resultset('MessageQueue')->search({
727 borrowernumber => $borrowernumber,
728 status => 'sent'
729 })->next()->to_address();
730 is( $sms_message_address, '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address is set incorrectly' );
734 subtest 'get_item_content' => sub {
735 plan tests => 2;
737 t::lib::Mocks::mock_preference('dateformat', 'metric');
738 t::lib::Mocks::mock_preference('timeformat', '24hr');
739 my @items = (
740 {date_due => '2041-01-01 12:34', title => 'a first title', barcode => 'a_first_barcode', author => 'a_first_author', itemnumber => 1 },
741 {date_due => '2042-01-02 23:45', title => 'a second title', barcode => 'a_second_barcode', author => 'a_second_author', itemnumber => 2 },
743 my @item_content_fields = qw( date_due title barcode author itemnumber );
745 my $items_content;
746 for my $item ( @items ) {
747 $items_content .= C4::Letters::get_item_content( { item => $item, item_content_fields => \@item_content_fields } );
750 my $expected_items_content = <<EOF;
751 01/01/2041 12:34\ta first title\ta_first_barcode\ta_first_author\t1
752 02/01/2042 23:45\ta second title\ta_second_barcode\ta_second_author\t2
754 is( $items_content, $expected_items_content, 'get_item_content should return correct items info with time (default)' );
757 $items_content = q||;
758 for my $item ( @items ) {
759 $items_content .= C4::Letters::get_item_content( { item => $item, item_content_fields => \@item_content_fields, dateonly => 1, } );
762 $expected_items_content = <<EOF;
763 01/01/2041\ta first title\ta_first_barcode\ta_first_author\t1
764 02/01/2042\ta second title\ta_second_barcode\ta_second_author\t2
766 is( $items_content, $expected_items_content, 'get_item_content should return correct items info without time (if dateonly => 1)' );
769 subtest 'Test limit parameter for SendQueuedMessages' => sub {
770 plan tests => 3;
772 my $dbh = C4::Context->dbh;
774 my $borrowernumber = Koha::Patron->new({
775 firstname => 'Jane',
776 surname => 'Smith',
777 categorycode => $patron_category,
778 branchcode => $library->{branchcode},
779 dateofbirth => $date,
780 smsalertnumber => undef,
781 })->store->borrowernumber;
783 $dbh->do(q|DELETE FROM message_queue|);
784 $my_message = {
785 'letter' => {
786 'content' => 'a message',
787 'metadata' => 'metadata',
788 'code' => 'TEST_MESSAGE',
789 'content_type' => 'text/plain',
790 'title' => 'message title'
792 'borrowernumber' => $borrowernumber,
793 'to_address' => undef,
794 'message_transport_type' => 'sms',
795 'from_address' => 'from@example.com'
797 C4::Letters::EnqueueLetter($my_message);
798 C4::Letters::EnqueueLetter($my_message);
799 C4::Letters::EnqueueLetter($my_message);
800 C4::Letters::EnqueueLetter($my_message);
801 C4::Letters::EnqueueLetter($my_message);
802 my $messages_processed = C4::Letters::SendQueuedMessages( { limit => 1 } );
803 is( $messages_processed, 1,
804 'Processed 1 message with limit of 1 and 5 unprocessed messages' );
805 $messages_processed = C4::Letters::SendQueuedMessages( { limit => 2 } );
806 is( $messages_processed, 2,
807 'Processed 2 message with limit of 2 and 4 unprocessed messages' );
808 $messages_processed = C4::Letters::SendQueuedMessages( { limit => 3 } );
809 is( $messages_processed, 2,
810 'Processed 2 message with limit of 3 and 2 unprocessed messages' );