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>.
21 use Test
::More tests
=> 73;
28 my $module = new Test
::MockModule
('Mail::Sendmail');
37 use_ok
('C4::Context');
38 use_ok
('C4::Members');
39 use_ok
('C4::Acquisition');
41 use_ok
('C4::Letters');
43 use t
::lib
::TestBuilder
;
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
;
50 use Koha
::Notice
::Templates
;
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;
59 $dbh->do(q
|DELETE FROM letter
|);
60 $dbh->do(q
|DELETE FROM message_queue
|);
61 $dbh->do(q
|DELETE FROM message_transport_types
|);
63 my $library = $builder->build({
66 my $patron_category = $builder->build({ source
=> 'Category' })->{categorycode
};
67 my $date = dt_from_string
;
68 my $borrowernumber = Koha
::Patron
->new({
71 categorycode
=> $patron_category,
72 branchcode
=> $library->{branchcode
},
74 smsalertnumber
=> undef,
75 })->store->borrowernumber;
77 my $marc_record = MARC
::Record
->new;
78 my( $biblionumber, $biblioitemnumber ) = AddBiblio
( $marc_record, '' );
82 # GetMessageTransportTypes
83 my $mtts = C4
::Letters
::GetMessageTransportTypes
();
84 is
( @
$mtts, 0, 'GetMessageTransportTypes returns the correct number of message types' );
87 INSERT INTO message_transport_types
( message_transport_type
) VALUES
('email'), ('phone'), ('print'), ('sms')
89 $mtts = C4
::Letters
::GetMessageTransportTypes
();
90 is_deeply
( $mtts, ['email', 'phone', 'print', 'sms'], 'GetMessageTransportTypes returns all values' );
94 is
( C4
::Letters
::EnqueueLetter
(), undef, 'EnqueueLetter without argument returns undef' );
97 borrowernumber
=> $borrowernumber,
98 message_transport_type
=> 'sms',
100 from_address
=> 'from@example.com',
102 my $message_id = C4
::Letters
::EnqueueLetter
($my_message);
103 is
( $message_id, undef, 'EnqueueLetter without the letter argument returns undef' );
105 delete $my_message->{message_transport_type
};
106 $my_message->{letter
} = {
107 content
=> 'a message',
108 title
=> 'message title',
109 metadata
=> 'metadata',
110 code
=> 'TEST_MESSAGE',
111 content_type
=> 'text/plain',
114 $message_id = C4
::Letters
::EnqueueLetter
($my_message);
115 is
( $message_id, undef, 'EnqueueLetter without the message type argument argument returns undef' );
117 $my_message->{message_transport_type
} = 'sms';
118 $message_id = C4
::Letters
::EnqueueLetter
($my_message);
119 ok
(defined $message_id && $message_id > 0, 'new message successfully queued');
123 my $messages = C4
::Letters
::GetQueuedMessages
();
124 is
( @
$messages, 1, 'GetQueuedMessages without argument returns all the entries' );
126 $messages = C4
::Letters
::GetQueuedMessages
({ borrowernumber
=> $borrowernumber });
127 is
( @
$messages, 1, 'one message stored for the borrower' );
128 is
( $messages->[0]->{message_id
}, $message_id, 'EnqueueLetter returns the message id correctly' );
129 is
( $messages->[0]->{borrowernumber
}, $borrowernumber, 'EnqueueLetter stores the borrower number correctly' );
130 is
( $messages->[0]->{subject
}, $my_message->{letter
}->{title
}, 'EnqueueLetter stores the subject correctly' );
131 is
( $messages->[0]->{content
}, $my_message->{letter
}->{content
}, 'EnqueueLetter stores the content correctly' );
132 is
( $messages->[0]->{message_transport_type
}, $my_message->{message_transport_type
}, 'EnqueueLetter stores the message type correctly' );
133 is
( $messages->[0]->{status
}, 'pending', 'EnqueueLetter stores the status pending correctly' );
134 isnt
( $messages->[0]->{time_queued
}, undef, 'Time queued inserted by default in message_queue table' );
135 is
( $messages->[0]->{updated_on
}, $messages->[0]->{time_queued
}, 'Time status changed equals time queued when created in message_queue table' );
137 # Setting time_queued to something else than now
138 my $yesterday = dt_from_string
->subtract( days
=> 1 );
139 Koha
::Notice
::Messages
->find($messages->[0]->{message_id
})->time_queued($yesterday)->store;
142 my $messages_processed = C4
::Letters
::SendQueuedMessages
( { type
=> 'email' });
143 is
($messages_processed, 0, 'No queued messages processed if type limit passed with unused type');
144 $messages_processed = C4
::Letters
::SendQueuedMessages
( { type
=> 'sms' });
145 is
($messages_processed, 1, 'All queued messages processed, found correct number of messages with type limit');
146 $messages = C4
::Letters
::GetQueuedMessages
({ borrowernumber
=> $borrowernumber });
148 $messages->[0]->{status
},
150 'message marked failed if tried to send SMS message for borrower with no smsalertnumber set (bug 11208)'
152 isnt
($messages->[0]->{updated_on
}, $messages->[0]->{time_queued
}, 'Time status changed differs from time queued when status changes' );
153 is
(dt_from_string
($messages->[0]->{time_queued
}), $yesterday, 'Time queued remaines inmutable' );
156 my $resent = C4
::Letters
::ResendMessage
($messages->[0]->{message_id
});
157 my $message = C4
::Letters
::GetMessage
( $messages->[0]->{message_id
});
158 is
( $resent, 1, 'The message should have been resent' );
159 is
($message->{status
},'pending', 'ResendMessage sets status to pending correctly (bug 12426)');
160 $resent = C4
::Letters
::ResendMessage
($messages->[0]->{message_id
});
161 is
( $resent, 0, 'The message should not have been resent again' );
162 $resent = C4
::Letters
::ResendMessage
();
163 is
( $resent, undef, 'ResendMessage should return undef if not message_id given' );
166 my $letters = C4
::Letters
::GetLetters
();
167 is
( @
$letters, 0, 'GetLetters returns the correct number of letters' );
169 my $title = q
|<<branches.branchname>> - <<status>>|;
170 my $content = q{Dear <<borrowers.firstname>> <<borrowers.surname>>,
171 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.
173 <<branches.branchname
>>
174 <<branches.branchaddress1>>
177 The following item(s) is/are currently <<status>>:
179 <item> <<count>>. <<items.itemcallnumber>>, Barcode: <<items.barcode>> </item>
181 Thank-you for your prompt attention to this matter.
182 Don't forget your date of birth: <<borrowers.dateofbirth>>.
183 Look at this wonderful biblio timestamp: <<biblio.timestamp>>.
186 $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 );
187 $letters = C4::Letters::GetLetters();
188 is( @$letters, 1, 'GetLetters returns the correct number of letters' );
189 is( $letters->[0]->{module}, 'my module', 'GetLetters gets the module correctly' );
190 is( $letters->[0]->{code}, 'my code', 'GetLetters gets the code correctly' );
191 is( $letters->[0]->{name}, 'my name', 'GetLetters gets the name correctly' );
195 subtest 'getletter' => sub {
197 t::lib::Mocks::mock_preference('IndependentBranches', 0);
198 my $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
199 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
200 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
201 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
202 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
203 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
204 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
205 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
206 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
208 t::lib::Mocks::mock_userenv({ branchcode => "anotherlib", flags => 1 });
210 t::lib::Mocks::mock_preference('IndependentBranches', 1);
211 $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
212 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
213 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
214 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
215 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
216 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
217 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
218 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
219 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
224 # Regression test for Bug 14206
225 $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 );
226 my $letter14206_a = C4::Letters::getletter('my module', 'my code', 'FFL' );
227 is( $letter14206_a->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type not passed, correct mtt detected' );
228 my $letter14206_b = C4::Letters::getletter('my module', 'my code', 'FFL', 'print');
229 is( $letter14206_b->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type passed, correct mtt detected' );
231 # test for overdue_notices.pl
232 my $overdue_rules = {
233 letter1 => 'my code',
236 my $branchcode = 'FFL';
237 my $letter14206_c = C4::Letters::getletter('my module', $overdue_rules->{"letter$i"}, $branchcode);
238 is( $letter14206_c->{message_transport_type}, 'print', 'Bug 14206 - correct mtt detected for call from overdue_notices.pl' );
241 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
242 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', '' );
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 );
248 borrowers => $borrowernumber,
249 branches => $library->{branchcode},
250 biblio => $biblionumber,
257 itemcallnumber
=> 'my callnumber1',
261 itemcallnumber
=> 'my callnumber2',
265 my $prepared_letter = GetPreparedLetter
((
266 module
=> 'my module',
267 branchcode
=> $library->{branchcode
},
268 letter_code
=> 'my code',
270 substitute
=> $substitute,
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
',
300 substitute => $substitute,
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
',
311 letter_code => 'test_date
',
313 substitute => $substitute,
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',
322 letter_code => 'test_date',
324 substitute => $substitute,
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
',
333 letter_code => 'test_date
',
335 substitute => $substitute,
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',
347 letter_code
=> 'test_date',
349 substitute
=> $substitute,
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 # Correctly format dateexpiry
366 my $values = { dateexpiry
=> '2015-12-13', };
368 t
::lib
::Mocks
::mock_preference
('dateformat', 'metric');
369 t
::lib
::Mocks
::mock_preference
('timeformat', '24hr');
370 my $letter = C4
::Letters
::_parseletter
({ content
=> "expiry on <<borrowers.dateexpiry>>"}, 'borrowers', $values);
371 is( $letter->{content}, 'expiry on
13/12/2015' );
373 t::lib::Mocks::mock_preference('dateformat
', 'metric
');
374 t::lib::Mocks::mock_preference('timeformat
', '12hr
');
375 $letter = C4::Letters::_parseletter({ content => "expiry on <<borrowers.dateexpiry>>"}, 'borrowers
', $values);
376 is( $letter->{content}, 'expiry on
13/12/2015' );
379 my $bookseller = Koha::Acquisition::Bookseller->new(
382 address1 => "bookseller's address
",
388 my $booksellerid = $bookseller->id;
390 Koha::Acquisition::Bookseller::Contact->new( { name => 'John Smith', phone => '0123456x1', claimacquisition => 1, orderacquisition => 1, booksellerid => $booksellerid } )->store;
391 Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1, booksellerid => $booksellerid } )->store;
392 my $basketno = NewBasket($booksellerid, 1);
394 my $budgetid = C4::Budgets::AddBudget({
395 budget_code => "budget_code_test_letters
",
396 budget_name => "budget_name_test_letters
",
399 my $bib = MARC::Record->new();
400 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
402 MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
406 MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
410 my $logged_in_user = $builder->build_object({ class => 'Koha::Patrons', value => { branchcode => $library->{branchcode} }});
411 t::lib::Mocks::mock_userenv({ patron => $logged_in_user });
413 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
414 my $order = Koha::Acquisition::Order->new(
416 basketno => $basketno,
418 biblionumber => $biblionumber,
419 budget_id => $budgetid,
422 my $ordernumber = $order->ordernumber;
424 C4::Acquisition::CloseBasket( $basketno );
427 $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
428 qr/^Bookseller .* without emails at/,
429 "SendAlerts prints a warning
";
430 is($err->{'error'}, 'no_email', "Trying to
send an alert
when there
's no e-mail results in an error");
432 $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
433 $bookseller->contacts->next->email('testemail
@mydomain.com
')->store;
435 # Ensure that the preference 'LetterLog
' is set to logging
436 t::lib::Mocks::mock_preference( 'LetterLog
', 'on
' );
438 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
439 t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress
', 'library
@domain.com
' );
443 $err = SendAlerts( 'orderacquisition
', $basketno , 'TESTACQORDER
' ) }
445 "SendAlerts is using the mocked sendmail routine (orderacquisition)";
446 is($err, 1, "Successfully sent order.");
447 is($mail{'To
'}, 'testemail
@mydomain.com
', "mailto correct in sent order");
448 is($mail{'Message
'}, 'my vendor
|John Smith
|Ordernumber
' . $ordernumber . ' (Silence
in the library
) (1 ordered
)', 'Order notice text constructed successfully
');
450 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTACQORDER
';});
452 $err = SendAlerts( 'orderacquisition
', $basketno , 'TESTACQORDER
' ) }
453 qr/No orderacquisition TESTACQORDER letter transported by email/,
454 "GetPreparedLetter warns about missing notice template";
455 is($err->{'error
'}, 'no_letter
', "No TESTACQORDER letter was defined.");
460 $err = SendAlerts( 'claimacquisition
', [ $ordernumber ], 'TESTACQCLAIM
' ) }
462 "SendAlerts is using the mocked sendmail routine";
464 is($err, 1, "Successfully sent claim");
465 is($mail{'To
'}, 'testemail
@mydomain.com
', "mailto correct in sent claim");
466 is($mail{'Message
'}, 'my vendor
|John Smith
|Ordernumber
' . $ordernumber . ' (Silence
in the library
) (1 ordered
)', 'Claim notice text constructed successfully
');
473 my $internalnotes = 'intnotes
';
474 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No
. {X
}' WHERE id=1|);
475 my $subscriptionid = NewSubscription(
476 undef, "", undef, undef, undef, $biblionumber,
477 '2013-01-01', 1, undef, undef, undef,
478 undef, undef, undef, undef, undef, undef,
479 1, $notes,undef, '2013-01-01', undef, 1,
480 undef, undef, 0, $internalnotes, 0,
481 undef, undef, 0, undef, '2013-12-31', 0
483 $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>>');});
484 my ($serials_count, @serials) = GetSerials($subscriptionid);
485 my $serial = $serials[0];
487 my $patron = Koha::Patron->new({
490 categorycode => $patron_category,
491 branchcode => $library->{branchcode},
492 dateofbirth => $date,
493 email => 'john.smith@test.de',
495 my $borrowernumber = $patron->borrowernumber;
496 my $subscription = Koha::Subscriptions->find( $subscriptionid );
497 $subscription->add_subscriber( $patron );
501 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
503 "SendAlerts is using the mocked sendmail routine";
504 is($err2, 1, "Successfully sent serial notification
");
505 is($mail{'To'}, 'john.smith@test.de', "mailto correct
in sent serial notification
");
506 is($mail{'Message'}, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
508 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'robert.tables@mail.com' );
512 $err3 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
514 "SendAlerts is using the mocked sendmail routine
";
515 is($mail{'To'}, 'robert.tables@mail.com', "mailto address overwritten by SendAllMailsTo preference
");
517 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', '' );
519 subtest 'SendAlerts - claimissue' => sub {
524 $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>>');});
526 my $bookseller = Koha
::Acquisition
::Bookseller
->new(
529 address1
=> "bookseller's address",
535 my $booksellerid = $bookseller->id;
537 Koha
::Acquisition
::Bookseller
::Contact
->new( { name
=> 'Leo Tolstoy', phone
=> '0123456x2', claimissues
=> 1, booksellerid
=> $booksellerid } )->store;
539 my $bib = MARC
::Record
->new();
540 if (C4
::Context
->preference('marcflavour') eq 'UNIMARC') {
542 MARC
::Field
->new('011', ' ', ' ', a
=> 'xxxx-yyyy'),
543 MARC
::Field
->new('200', ' ', ' ', a
=> 'Silence in the library'),
547 MARC
::Field
->new('022', ' ', ' ', a
=> 'xxxx-yyyy'),
548 MARC
::Field
->new('245', ' ', ' ', a
=> 'Silence in the library'),
551 my ($biblionumber) = AddBiblio
($bib, '');
553 $dbh->do(q
|UPDATE subscription_numberpatterns SET numberingmethod
='No. {X}' WHERE id
=1|);
554 my $subscriptionid = NewSubscription
(
555 undef, "", $booksellerid, undef, undef, $biblionumber,
556 '2013-01-01', 1, undef, undef, undef,
557 undef, undef, undef, undef, undef, undef,
558 1, 'public',undef, '2013-01-01', undef, 1,
559 undef, undef, 0, 'internal', 0,
560 undef, undef, 0, undef, '2013-12-31', 0
563 my ($serials_count, @serials) = GetSerials
($subscriptionid);
564 my @serialids = ($serials[0]->{serialid
});
568 $err = SendAlerts
( 'claimissues', \
@serialids, 'TESTSERIALCLAIM' ) }
569 qr/^Bookseller .* without emails at/,
570 "Warn on vendor without email address";
572 $bookseller = Koha
::Acquisition
::Booksellers
->find( $booksellerid );
573 $bookseller->contacts->next->email('testemail@mydomain.com')->store;
575 # Ensure that the preference 'LetterLog' is set to logging
576 t
::lib
::Mocks
::mock_preference
( 'LetterLog', 'on' );
578 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
579 t
::lib
::Mocks
::mock_userenv
({ branchcode
=> $library->{branchcode
} });
581 t
::lib
::Mocks
::mock_preference
( 'KohaAdminEmailAddress', 'library@domain.com' );
585 $err = SendAlerts
( 'claimissues', \
@serialids , 'TESTSERIALCLAIM' ) }
587 "SendAlerts is using the mocked sendmail routine (claimissues)";
588 is
($err, 1, "Successfully sent claim");
589 is
($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
590 is
($mail{'Message'}, "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy", 'Serial claim letter for 1 issue constructed successfully');
594 my $publisheddate = output_pref
({ dt
=> dt_from_string
, dateformat
=> 'iso', dateonly
=> 1 });
595 my $serialexpected = ( C4
::Serials
::findSerialsByStatus
( 1, $subscriptionid ) )[0];
596 ModSerialStatus
( $serials[0]->{serialid
}, "No. 1", $publisheddate, $publisheddate, $publisheddate, '3', 'a note' );
597 ($serials_count, @serials) = GetSerials
($subscriptionid);
598 push @serialids, ($serials[1]->{serialid
});
600 $err = SendAlerts
( 'claimissues', \
@serialids , 'TESTSERIALCLAIM' );
601 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");
603 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTSERIALCLAIM';});
605 $err = SendAlerts
( 'orderacquisition', $basketno , 'TESTSERIALCLAIM' ) }
606 qr/No orderacquisition TESTSERIALCLAIM letter transported by email/,
607 "GetPreparedLetter warns about missing notice template";
608 is
($err->{'error'}, 'no_letter', "No TESTSERIALCLAIM letter was defined");
613 subtest
'GetPreparedLetter' => sub {
616 Koha
::Notice
::Template
->new(
621 message_transport_type
=> 'email'
626 $letter = C4
::Letters
::GetPreparedLetter
(
628 letter_code
=> 'test',
631 qr{^ERROR: nothing to substitute},
632 'GetPreparedLetter should warn if tables, substiture and repeat are not set';
634 'No letter should be returned by GetPreparedLetter if something went wrong'
638 $letter = C4
::Letters
::GetPreparedLetter
(
640 letter_code
=> 'test',
644 qr{^ERROR: nothing to substitute},
645 'GetPreparedLetter should warn if tables, substiture and repeat are not set, even if the key is passed';
647 'No letter should be returned by GetPreparedLetter if something went wrong'
654 subtest
'TranslateNotices' => sub {
657 t
::lib
::Mocks
::mock_preference
( 'TranslateNotices', '1' );
661 INSERT INTO letter
(module
, code
, branchcode
, name
, title
, content
, message_transport_type
, lang
) VALUES
662 ('test', 'code', '', 'test', 'a test', 'just a test', 'email', 'default'),
663 ('test', 'code', '', 'test', 'una prueba', 'solo una prueba', 'email', 'es-ES');
666 my $letter = C4
::Letters
::GetPreparedLetter
(
669 letter_code
=> 'code',
670 message_transport_type
=> 'email',
671 substitute
=> $substitute,
676 'GetPreparedLetter should return the default one if the lang parameter is not provided'
679 $letter = C4
::Letters
::GetPreparedLetter
(
682 letter_code
=> 'code',
683 message_transport_type
=> 'email',
684 substitute
=> $substitute,
687 is
( $letter->{title
}, 'una prueba',
688 'GetPreparedLetter should return the required notice if it exists' );
690 $letter = C4
::Letters
::GetPreparedLetter
(
693 letter_code
=> 'code',
694 message_transport_type
=> 'email',
695 substitute
=> $substitute,
701 'GetPreparedLetter should return the default notice if the one required does not exist'
704 t
::lib
::Mocks
::mock_preference
( 'TranslateNotices', '' );
706 $letter = C4
::Letters
::GetPreparedLetter
(
709 letter_code
=> 'code',
710 message_transport_type
=> 'email',
711 substitute
=> $substitute,
714 is
( $letter->{title
}, 'a test',
715 'GetPreparedLetter should return the default notice if pref disabled but additional language exists' );
719 subtest
'SendQueuedMessages' => sub {
723 t
::lib
::Mocks
::mock_preference
( 'SMSSendDriver', 'Email' );
724 t
::lib
::Mocks
::mock_preference
('EmailSMSSendDriverFromAddress', '');
726 my $patron = Koha
::Patrons
->find($borrowernumber);
728 INSERT INTO message_queue
(borrowernumber
, subject
, content
, message_transport_type
, status
, letter_code
)
729 VALUES
(?
, 'subject', 'content', 'sms', 'pending', 'just_a_code')
730 |, undef, $borrowernumber
732 eval { C4
::Letters
::SendQueuedMessages
(); };
733 is
( $@
, '', 'SendQueuedMessages should not explode if the patron does not have a sms provider set' );
735 my $sms_pro = $builder->build_object({ class => 'Koha::SMS::Providers', value
=> { domain
=> 'kidclamp.rocks' } });
736 $patron->set( { smsalertnumber
=> '5555555555', sms_provider_id
=> $sms_pro->id() } )->store;
737 $message_id = C4
::Letters
::EnqueueLetter
($my_message); #using datas set around line 95 and forward
738 C4
::Letters
::SendQueuedMessages
();
740 my $message = $schema->resultset('MessageQueue')->search({
741 borrowernumber
=> $borrowernumber,
745 is
( $message->to_address(), '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address not set' );
747 $message->from_address(),
749 'SendQueuedMessages uses message queue item \"from address\" for SMS by email when EmailSMSSendDriverFromAddress system preference is not set'
752 $schema->resultset('MessageQueue')->search({borrowernumber
=> $borrowernumber, status
=> 'sent'})->delete(); #clear borrower queue
754 t
::lib
::Mocks
::mock_preference
('EmailSMSSendDriverFromAddress', 'override@example.com');
756 $message_id = C4
::Letters
::EnqueueLetter
($my_message);
757 C4
::Letters
::SendQueuedMessages
();
759 $message = $schema->resultset('MessageQueue')->search({
760 borrowernumber
=> $borrowernumber,
765 $message->from_address(),
766 'override@example.com',
767 'SendQueuedMessages uses EmailSMSSendDriverFromAddress value for SMS by email when EmailSMSSendDriverFromAddress is set'
770 $schema->resultset('MessageQueue')->search({borrowernumber
=> $borrowernumber,status
=> 'sent'})->delete(); #clear borrower queue
771 $my_message->{to_address
} = 'fixme@kidclamp.iswrong';
772 $message_id = C4
::Letters
::EnqueueLetter
($my_message);
774 my $number_attempted = C4
::Letters
::SendQueuedMessages
({
775 borrowernumber
=> -1, # -1 still triggers the borrowernumber condition
776 letter_code
=> 'PASSWORD_RESET',
778 is
( $number_attempted, 0, 'There were no password reset messages for SendQueuedMessages to attempt.' );
780 C4
::Letters
::SendQueuedMessages
();
781 my $sms_message_address = $schema->resultset('MessageQueue')->search({
782 borrowernumber
=> $borrowernumber,
784 })->next()->to_address();
785 is
( $sms_message_address, '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address is set incorrectly' );
789 subtest
'get_item_content' => sub {
792 t
::lib
::Mocks
::mock_preference
('dateformat', 'metric');
793 t
::lib
::Mocks
::mock_preference
('timeformat', '24hr');
795 {date_due
=> '2041-01-01 12:34', title
=> 'a first title', barcode
=> 'a_first_barcode', author
=> 'a_first_author', itemnumber
=> 1 },
796 {date_due
=> '2042-01-02 23:45', title
=> 'a second title', barcode
=> 'a_second_barcode', author
=> 'a_second_author', itemnumber
=> 2 },
798 my @item_content_fields = qw( date_due title barcode author itemnumber );
801 for my $item ( @items ) {
802 $items_content .= C4
::Letters
::get_item_content
( { item
=> $item, item_content_fields
=> \
@item_content_fields } );
805 my $expected_items_content = <<EOF;
806 01/01/2041 12:34\ta first title\ta_first_barcode\ta_first_author\t1
807 02/01/2042 23:45\ta second title\ta_second_barcode\ta_second_author\t2
809 is
( $items_content, $expected_items_content, 'get_item_content should return correct items info with time (default)' );
812 $items_content = q
||;
813 for my $item ( @items ) {
814 $items_content .= C4
::Letters
::get_item_content
( { item
=> $item, item_content_fields
=> \
@item_content_fields, dateonly
=> 1, } );
817 $expected_items_content = <<EOF;
818 01/01/2041\ta first title\ta_first_barcode\ta_first_author\t1
819 02/01/2042\ta second title\ta_second_barcode\ta_second_author\t2
821 is
( $items_content, $expected_items_content, 'get_item_content should return correct items info without time (if dateonly => 1)' );
824 subtest
'Test limit parameter for SendQueuedMessages' => sub {
827 my $dbh = C4
::Context
->dbh;
829 my $borrowernumber = Koha
::Patron
->new({
832 categorycode
=> $patron_category,
833 branchcode
=> $library->{branchcode
},
834 dateofbirth
=> $date,
835 smsalertnumber
=> undef,
836 })->store->borrowernumber;
838 $dbh->do(q
|DELETE FROM message_queue
|);
841 'content' => 'a message',
842 'metadata' => 'metadata',
843 'code' => 'TEST_MESSAGE',
844 'content_type' => 'text/plain',
845 'title' => 'message title'
847 'borrowernumber' => $borrowernumber,
848 'to_address' => undef,
849 'message_transport_type' => 'sms',
850 'from_address' => 'from@example.com'
852 C4
::Letters
::EnqueueLetter
($my_message);
853 C4
::Letters
::EnqueueLetter
($my_message);
854 C4
::Letters
::EnqueueLetter
($my_message);
855 C4
::Letters
::EnqueueLetter
($my_message);
856 C4
::Letters
::EnqueueLetter
($my_message);
857 my $messages_processed = C4
::Letters
::SendQueuedMessages
( { limit
=> 1 } );
858 is
( $messages_processed, 1,
859 'Processed 1 message with limit of 1 and 5 unprocessed messages' );
860 $messages_processed = C4
::Letters
::SendQueuedMessages
( { limit
=> 2 } );
861 is
( $messages_processed, 2,
862 'Processed 2 message with limit of 2 and 4 unprocessed messages' );
863 $messages_processed = C4
::Letters
::SendQueuedMessages
( { limit
=> 3 } );
864 is
( $messages_processed, 2,
865 'Processed 2 message with limit of 3 and 2 unprocessed messages' );