t/db_dependent/Letters.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright (C) 2013 Equinox Software, Inc.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21 use Test::More tests => 73;
  22 use Test::MockModule;
  23 use Test::Warn;
  24
  25 use MARC::Record;
  26
  27 my ( $email_object, $sendmail_params );
  28
  29 my $email_sender_module = Test::MockModule->new('Email::Stuffer');
  30 $email_sender_module->mock(
  31     'send_or_die',
  32     sub {
  33         ( $email_object, $sendmail_params ) = @_;
  34         warn "Fake send_or_die";
  35     }
  36 );
  37
  38 use_ok('C4::Context');
  39 use_ok('C4::Members');
  40 use_ok('C4::Acquisition');
  41 use_ok('C4::Biblio');
  42 use_ok('C4::Letters');
  43 use t::lib::Mocks;
  44 use t::lib::TestBuilder;
  45 use Koha::Database;
  46 use Koha::DateUtils qw( dt_from_string output_pref );
  47 use Koha::Acquisition::Booksellers;
  48 use Koha::Acquisition::Bookseller::Contacts;
  49 use Koha::Acquisition::Orders;
  50 use Koha::Libraries;
  51 use Koha::Notice::Templates;
  52 use Koha::Patrons;
  53 use Koha::Subscriptions;
  54 my $schema = Koha::Database->schema;
  55 $schema->storage->txn_begin();
  56
  57 my $builder = t::lib::TestBuilder->new;
  58 my $dbh = C4::Context->dbh;
  59
  60 $dbh->do(q|DELETE FROM letter|);
  61 $dbh->do(q|DELETE FROM message_queue|);
  62 $dbh->do(q|DELETE FROM message_transport_types|);
  63
  64 my $library = $builder->build({
  65     source => 'Branch',
  66     value  => {
  67         branchemail      => 'branchemail@address.com',
  68         branchreplyto    => 'branchreplyto@address.com',
  69         branchreturnpath => 'branchreturnpath@address.com',
  70     }
  71 });
  72 my $patron_category = $builder->build({ source => 'Category' })->{categorycode};
  73 my $date = dt_from_string;
  74 my $borrowernumber = Koha::Patron->new({
  75     firstname    => 'Jane',
  76     surname      => 'Smith',
  77     categorycode => $patron_category,
  78     branchcode   => $library->{branchcode},
  79     dateofbirth  => $date,
  80     smsalertnumber => undef,
  81 })->store->borrowernumber;
  82
  83 my $marc_record = MARC::Record->new;
  84 my( $biblionumber, $biblioitemnumber ) = AddBiblio( $marc_record, '' );
  85
  86
  87
  88 # GetMessageTransportTypes
  89 my $mtts = C4::Letters::GetMessageTransportTypes();
  90 is( @$mtts, 0, 'GetMessageTransportTypes returns the correct number of message types' );
  91
  92 $dbh->do(q|
  93     INSERT INTO message_transport_types( message_transport_type ) VALUES ('email'), ('phone'), ('print'), ('sms')
  94 |);
  95 $mtts = C4::Letters::GetMessageTransportTypes();
  96 is_deeply( $mtts, ['email', 'phone', 'print', 'sms'], 'GetMessageTransportTypes returns all values' );
  97
  98
  99 # EnqueueLetter
 100 is( C4::Letters::EnqueueLetter(), undef, 'EnqueueLetter without argument returns undef' );
 101
 102 my $my_message = {
 103     borrowernumber         => $borrowernumber,
 104     message_transport_type => 'sms',
 105     to_address             => undef,
 106     from_address           => 'from@example.com',
 107 };
 108 my $message_id = C4::Letters::EnqueueLetter($my_message);
 109 is( $message_id, undef, 'EnqueueLetter without the letter argument returns undef' );
 110
 111 delete $my_message->{message_transport_type};
 112 $my_message->{letter} = {
 113     content      => 'a message',
 114     title        => 'message title',
 115     metadata     => 'metadata',
 116     code         => 'TEST_MESSAGE',
 117     content_type => 'text/plain',
 118 };
 119
 120 $message_id = C4::Letters::EnqueueLetter($my_message);
 121 is( $message_id, undef, 'EnqueueLetter without the message type argument argument returns undef' );
 122
 123 $my_message->{message_transport_type} = 'sms';
 124 $message_id = C4::Letters::EnqueueLetter($my_message);
 125 ok(defined $message_id && $message_id > 0, 'new message successfully queued');
 126
 127
 128 # GetQueuedMessages
 129 my $messages = C4::Letters::GetQueuedMessages();
 130 is( @$messages, 1, 'GetQueuedMessages without argument returns all the entries' );
 131
 132 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
 133 is( @$messages, 1, 'one message stored for the borrower' );
 134 is( $messages->[0]->{message_id}, $message_id, 'EnqueueLetter returns the message id correctly' );
 135 is( $messages->[0]->{borrowernumber}, $borrowernumber, 'EnqueueLetter stores the borrower number correctly' );
 136 is( $messages->[0]->{subject}, $my_message->{letter}->{title}, 'EnqueueLetter stores the subject correctly' );
 137 is( $messages->[0]->{content}, $my_message->{letter}->{content}, 'EnqueueLetter stores the content correctly' );
 138 is( $messages->[0]->{message_transport_type}, $my_message->{message_transport_type}, 'EnqueueLetter stores the message type correctly' );
 139 is( $messages->[0]->{status}, 'pending', 'EnqueueLetter stores the status pending correctly' );
 140 isnt( $messages->[0]->{time_queued}, undef, 'Time queued inserted by default in message_queue table' );
 141 is( $messages->[0]->{updated_on}, $messages->[0]->{time_queued}, 'Time status changed equals time queued when created in message_queue table' );
 142
 143 # Setting time_queued to something else than now
 144 my $yesterday = dt_from_string->subtract( days => 1 );
 145 Koha::Notice::Messages->find($messages->[0]->{message_id})->time_queued($yesterday)->store;
 146
 147 # SendQueuedMessages
 148 my $messages_processed = C4::Letters::SendQueuedMessages( { type => 'email' });
 149 is($messages_processed, 0, 'No queued messages processed if type limit passed with unused type');
 150 $messages_processed = C4::Letters::SendQueuedMessages( { type => 'sms' });
 151 is($messages_processed, 1, 'All queued messages processed, found correct number of messages with type limit');
 152 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
 153 is(
 154     $messages->[0]->{status},
 155     'failed',
 156     'message marked failed if tried to send SMS message for borrower with no smsalertnumber set (bug 11208)'
 157 );
 158 isnt($messages->[0]->{updated_on}, $messages->[0]->{time_queued}, 'Time status changed differs from time queued when status changes' );
 159 is(dt_from_string($messages->[0]->{time_queued}), $yesterday, 'Time queued remaines inmutable' );
 160
 161 # ResendMessage
 162 my $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
 163 my $message = C4::Letters::GetMessage( $messages->[0]->{message_id});
 164 is( $resent, 1, 'The message should have been resent' );
 165 is($message->{status},'pending', 'ResendMessage sets status to pending correctly (bug 12426)');
 166 $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
 167 is( $resent, 0, 'The message should not have been resent again' );
 168 $resent = C4::Letters::ResendMessage();
 169 is( $resent, undef, 'ResendMessage should return undef if not message_id given' );
 170
 171 # GetLetters
 172 my $letters = C4::Letters::GetLetters();
 173 is( @$letters, 0, 'GetLetters returns the correct number of letters' );
 174
 175 my $title = q|<<branches.branchname>> - <<status>>|;
 176 my $content = q{Dear <<borrowers.firstname>> <<borrowers.surname>>,
 177 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.
 178
 179 <<branches.branchname>>
 180 <<branches.branchaddress1>>
 181 URL: <<OPACBaseURL>>
 182
 183 The following item(s) is/are currently <<status>>:
 184
 185 <item> <<count>>. <<items.itemcallnumber>>, Barcode: <<items.barcode>> </item>
 186
 187 Thank-you for your prompt attention to this matter.
 188 Don't forget your date of birth: <<borrowers.dateofbirth>>.
 189 Look at this wonderful biblio timestamp: <<biblio.timestamp>>.
 190 };
 191
 192 $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 );
 193 $letters = C4::Letters::GetLetters();
 194 is( @$letters, 1, 'GetLetters returns the correct number of letters' );
 195 is( $letters->[0]->{module}, 'my module', 'GetLetters gets the module correctly' );
 196 is( $letters->[0]->{code}, 'my code', 'GetLetters gets the code correctly' );
 197 is( $letters->[0]->{name}, 'my name', 'GetLetters gets the name correctly' );
 198
 199
 200 # getletter
 201 subtest 'getletter' => sub {
 202     plan tests => 16;
 203     t::lib::Mocks::mock_preference('IndependentBranches', 0);
 204     my $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
 205     is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
 206     is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
 207     is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
 208     is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
 209     is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
 210     is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
 211     is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
 212     is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
 213
 214     t::lib::Mocks::mock_userenv({ branchcode => "anotherlib", flags => 1 });
 215
 216     t::lib::Mocks::mock_preference('IndependentBranches', 1);
 217     $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
 218     is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
 219     is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
 220     is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
 221     is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
 222     is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
 223     is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
 224     is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
 225     is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
 226 };
 227
 228
 229
 230 # Regression test for Bug 14206
 231 $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 );
 232 my $letter14206_a = C4::Letters::getletter('my module', 'my code', 'FFL' );
 233 is( $letter14206_a->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type not passed, correct mtt detected' );
 234 my $letter14206_b = C4::Letters::getletter('my module', 'my code', 'FFL', 'print');
 235 is( $letter14206_b->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type passed, correct mtt detected'  );
 236
 237 # test for overdue_notices.pl
 238 my $overdue_rules = {
 239     letter1         => 'my code',
 240 };
 241 my $i = 1;
 242 my $branchcode = 'FFL';
 243 my $letter14206_c = C4::Letters::getletter('my module', $overdue_rules->{"letter$i"}, $branchcode);
 244 is( $letter14206_c->{message_transport_type}, 'print', 'Bug 14206 - correct mtt detected for call from overdue_notices.pl' );
 245
 246 # GetPreparedLetter
 247 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
 248 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', '' );
 249
 250 my $sms_content = 'This is a SMS for an <<status>>';
 251 $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 );
 252
 253 my $tables = {
 254     borrowers => $borrowernumber,
 255     branches => $library->{branchcode},
 256     biblio => $biblionumber,
 257 };
 258 my $substitute = {
 259     status => 'overdue',
 260 };
 261 my $repeat = [
 262     {
 263         itemcallnumber => 'my callnumber1',
 264         barcode        => '1234',
 265     },
 266     {
 267         itemcallnumber => 'my callnumber2',
 268         barcode        => '5678',
 269     },
 270 ];
 271 my $prepared_letter = GetPreparedLetter((
 272     module      => 'my module',
 273     branchcode  => $library->{branchcode},
 274     letter_code => 'my code',
 275     tables      => $tables,
 276     substitute  => $substitute,
 277     repeat      => $repeat,
 278 ));
 279 my $retrieved_library = Koha::Libraries->find($library->{branchcode});
 280 my $my_title_letter = $retrieved_library->branchname . qq| - $substitute->{status}|;
 281 my $biblio_timestamp = dt_from_string( GetBiblioData($biblionumber)->{timestamp} );
 282 my $my_content_letter = qq|Dear Jane Smith,
 283 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.
 284
 285 |.$retrieved_library->branchname.qq|
 286 |.$retrieved_library->branchaddress1.qq|
 287 URL: http://thisisatest.com
 288
 289 The following item(s) is/are currently $substitute->{status}:
 290
 291 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
 292 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
 293
 294 Thank-you for your prompt attention to this matter.
 295 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
 296 Look at this wonderful biblio timestamp: | . output_pref({ dt => $biblio_timestamp })  . ".\n";
 297
 298 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
 299 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 300
 301 $prepared_letter = GetPreparedLetter((
 302     module                 => 'my module',
 303     branchcode             => $library->{branchcode},
 304     letter_code            => 'my code',
 305     tables                 => $tables,
 306     substitute             => $substitute,
 307     repeat                 => $repeat,
 308     message_transport_type => 'sms',
 309 ));
 310 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
 311 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 312
 313 $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>>.');});
 314 $prepared_letter = GetPreparedLetter((
 315     module                 => 'test_date',
 316     branchcode             => '',
 317     letter_code            => 'test_date',
 318     tables                 => $tables,
 319     substitute             => $substitute,
 320     repeat                 => $repeat,
 321 ));
 322 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 1' );
 323
 324 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp | dateonly>>.' WHERE code = 'test_date';});
 325 $prepared_letter = GetPreparedLetter((
 326     module                 => 'test_date',
 327     branchcode             => '',
 328     letter_code            => 'test_date',
 329     tables                 => $tables,
 330     substitute             => $substitute,
 331     repeat                 => $repeat,
 332 ));
 333 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 2' );
 334
 335 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp|dateonly >>.' WHERE code = 'test_date';});
 336 $prepared_letter = GetPreparedLetter((
 337     module                 => 'test_date',
 338     branchcode             => '',
 339     letter_code            => 'test_date',
 340     tables                 => $tables,
 341     substitute             => $substitute,
 342     repeat                 => $repeat,
 343 ));
 344 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 3' );
 345
 346 t::lib::Mocks::mock_preference( 'TimeFormat', '12hr' );
 347 my $yesterday_night = $date->clone->add( days => -1 )->set_hour(22);
 348 $dbh->do(q|UPDATE biblio SET timestamp = ? WHERE biblionumber = ?|, undef, $yesterday_night, $biblionumber );
 349 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp>>.' WHERE code = 'test_date';});
 350 $prepared_letter = GetPreparedLetter((
 351     module                 => 'test_date',
 352     branchcode             => '',
 353     letter_code            => 'test_date',
 354     tables                 => $tables,
 355     substitute             => $substitute,
 356     repeat                 => $repeat,
 357 ));
 358 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $yesterday_night }) . q|.|, 'dateonly test 3' );
 359
 360 $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>');});
 361 $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>');});
 362
 363 # Test that _parseletter doesn't modify its parameters bug 15429
 364 {
 365     my $values = { dateexpiry => '2015-12-13', };
 366     C4::Letters::_parseletter($prepared_letter, 'borrowers', $values);
 367     is( $values->{dateexpiry}, '2015-12-13', "_parseletter doesn't modify its parameters" );
 368 }
 369
 370 # Correctly format dateexpiry
 371 {
 372     my $values = { dateexpiry => '2015-12-13', };
 373
 374     t::lib::Mocks::mock_preference('dateformat', 'metric');
 375     t::lib::Mocks::mock_preference('timeformat', '24hr');
 376     my $letter = C4::Letters::_parseletter({ content => "expiry on <<borrowers.dateexpiry>>"}, 'borrowers', $values);
 377     is( $letter->{content}, 'expiry on 13/12/2015' );
 378
 379     t::lib::Mocks::mock_preference('dateformat', 'metric');
 380     t::lib::Mocks::mock_preference('timeformat', '12hr');
 381     $letter = C4::Letters::_parseletter({ content => "expiry on <<borrowers.dateexpiry>>"}, 'borrowers', $values);
 382     is( $letter->{content}, 'expiry on 13/12/2015' );
 383 }
 384
 385 my $bookseller = Koha::Acquisition::Bookseller->new(
 386     {
 387         name => "my vendor",
 388         address1 => "bookseller's address",
 389         phone => "0123456",
 390         active => 1,
 391         deliverytime => 5,
 392     }
 393 )->store;
 394 my $booksellerid = $bookseller->id;
 395
 396 Koha::Acquisition::Bookseller::Contact->new( { name => 'John Smith',  phone => '0123456x1', claimacquisition => 1, orderacquisition => 1, booksellerid => $booksellerid } )->store;
 397 Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues      => 1, booksellerid => $booksellerid } )->store;
 398 my $basketno = NewBasket($booksellerid, 1);
 399
 400 my $budgetid = C4::Budgets::AddBudget({
 401     budget_code => "budget_code_test_letters",
 402     budget_name => "budget_name_test_letters",
 403 });
 404
 405 my $bib = MARC::Record->new();
 406 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 407     $bib->append_fields(
 408         MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
 409     );
 410 } else {
 411     $bib->append_fields(
 412         MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
 413     );
 414 }
 415
 416 my $logged_in_user = $builder->build_object(
 417     {
 418         class => 'Koha::Patrons',
 419         value => {
 420             branchcode => $library->{branchcode},
 421             email      => 'some@email.com'
 422         }
 423     }
 424 );
 425
 426 t::lib::Mocks::mock_userenv({ patron => $logged_in_user });
 427
 428 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
 429 my $order = Koha::Acquisition::Order->new(
 430     {
 431         basketno => $basketno,
 432         quantity => 1,
 433         biblionumber => $biblionumber,
 434         budget_id => $budgetid,
 435     }
 436 )->store;
 437 my $ordernumber = $order->ordernumber;
 438
 439 C4::Acquisition::CloseBasket( $basketno );
 440 my $err;
 441 warning_like {
 442     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 443     qr/^Bookseller .* without emails at/,
 444     "SendAlerts prints a warning";
 445 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
 446
 447 $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
 448 $bookseller->contacts->next->email('testemail@mydomain.com')->store;
 449
 450 # Ensure that the preference 'LetterLog' is set to logging
 451 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
 452
 453 # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
 454 t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'library@domain.com' );
 455
 456 {
 457 warning_like {
 458     $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ) }
 459     qr|Fake send_or_die|,
 460     "SendAlerts is using the mocked sendmail routine (orderacquisition)";
 461 is($err, 1, "Successfully sent order.");
 462 is($email_object->email->header('To'), 'testemail@mydomain.com', "mailto correct in sent order");
 463 is($email_object->email->body, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Order notice text constructed successfully');
 464
 465 $dbh->do(q{DELETE FROM letter WHERE code = 'TESTACQORDER';});
 466 warning_like {
 467     $err = SendAlerts( 'orderacquisition', $basketno , 'TESTACQORDER' ) }
 468     qr/No orderacquisition TESTACQORDER letter transported by email/,
 469     "GetPreparedLetter warns about missing notice template";
 470 is($err->{'error'}, 'no_letter', "No TESTACQORDER letter was defined.");
 471 }
 472
 473 {
 474 warning_like {
 475     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 476     qr|Fake send_or_die|,
 477     "SendAlerts is using the mocked sendmail routine";
 478
 479 is($err, 1, "Successfully sent claim");
 480 is($email_object->email->header('To'), 'testemail@mydomain.com', "mailto correct in sent claim");
 481 is($email_object->email->body, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
 482 }
 483
 484 {
 485 use C4::Serials;
 486
 487 my $notes = 'notes';
 488 my $internalnotes = 'intnotes';
 489 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
 490 my $subscriptionid = NewSubscription(
 491      undef,      "",     undef, undef, undef, $biblionumber,
 492     '2013-01-01', 1, undef, undef,  undef,
 493     undef,      undef,  undef, undef, undef, undef,
 494     1,          $notes,undef, '2013-01-01', undef, 1,
 495     undef,       undef,  0,    $internalnotes,  0,
 496     undef, undef, 0,          undef,         '2013-12-31', 0
 497 );
 498 $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>>');});
 499 my ($serials_count, @serials) = GetSerials($subscriptionid);
 500 my $serial = $serials[0];
 501
 502 my $patron = Koha::Patron->new({
 503     firstname    => 'John',
 504     surname      => 'Smith',
 505     categorycode => $patron_category,
 506     branchcode   => $library->{branchcode},
 507     dateofbirth  => $date,
 508     email        => 'john.smith@test.de',
 509 })->store;
 510 my $borrowernumber = $patron->borrowernumber;
 511 my $subscription = Koha::Subscriptions->find( $subscriptionid );
 512 $subscription->add_subscriber( $patron );
 513
 514 t::lib::Mocks::mock_userenv({ branch => $library->{branchcode} });
 515 my $err2;
 516 warning_like {
 517 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
 518     qr|Fake send_or_die|,
 519     "SendAlerts is using the mocked sendmail routine";
 520
 521 is($err2, 1, "Successfully sent serial notification");
 522 is($email_object->email->header('To'), 'john.smith@test.de', "mailto correct in sent serial notification");
 523 is($email_object->email->body, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
 524
 525 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', 'robert.tables@mail.com' );
 526
 527 my $err3;
 528 warning_like {
 529 $err3 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
 530     qr|Fake send_or_die|,
 531     "SendAlerts is using the mocked sendmail routine";
 532 is($email_object->email->header('To'), 'robert.tables@mail.com', "mailto address overwritten by SendAllMailsTo preference");
 533 }
 534 t::lib::Mocks::mock_preference( 'SendAllEmailsTo', '' );
 535
 536 subtest 'SendAlerts - claimissue' => sub {
 537     plan tests => 9;
 538
 539     use C4::Serials;
 540
 541     $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>>');});
 542
 543     my $bookseller = Koha::Acquisition::Bookseller->new(
 544         {
 545             name => "my vendor",
 546             address1 => "bookseller's address",
 547             phone => "0123456",
 548             active => 1,
 549             deliverytime => 5,
 550         }
 551     )->store;
 552     my $booksellerid = $bookseller->id;
 553
 554     Koha::Acquisition::Bookseller::Contact->new( { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1, booksellerid => $booksellerid } )->store;
 555
 556     my $bib = MARC::Record->new();
 557     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 558         $bib->append_fields(
 559             MARC::Field->new('011', ' ', ' ', a => 'xxxx-yyyy'),
 560             MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
 561         );
 562     } else {
 563         $bib->append_fields(
 564             MARC::Field->new('022', ' ', ' ', a => 'xxxx-yyyy'),
 565             MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
 566         );
 567     }
 568     my ($biblionumber) = AddBiblio($bib, '');
 569
 570     $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
 571     my $subscriptionid = NewSubscription(
 572          undef, "", $booksellerid, undef, undef, $biblionumber,
 573         '2013-01-01', 1, undef, undef,  undef,
 574         undef,  undef,  undef, undef, undef, undef,
 575         1, 'public',undef, '2013-01-01', undef, 1,
 576         undef, undef,  0, 'internal',  0,
 577         undef, undef, 0,  undef, '2013-12-31', 0
 578     );
 579
 580     my ($serials_count, @serials) = GetSerials($subscriptionid);
 581     my  @serialids = ($serials[0]->{serialid});
 582
 583     my $err;
 584     warning_like {
 585         $err = SendAlerts( 'claimissues', \@serialids, 'TESTSERIALCLAIM' ) }
 586         qr/^Bookseller .* without emails at/,
 587         "Warn on vendor without email address";
 588
 589     $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
 590     $bookseller->contacts->next->email('testemail@mydomain.com')->store;
 591
 592     # Ensure that the preference 'LetterLog' is set to logging
 593     t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
 594
 595     # SendAlerts needs branchemail or KohaAdminEmailAddress as sender
 596     t::lib::Mocks::mock_userenv({ branchcode => $library->{branchcode} });
 597
 598     t::lib::Mocks::mock_preference( 'KohaAdminEmailAddress', 'library@domain.com' );
 599
 600     {
 601     warning_like {
 602         $err = SendAlerts( 'claimissues', \@serialids , 'TESTSERIALCLAIM' ) }
 603         qr|Fake send_or_die|,
 604         "SendAlerts is using the mocked sendmail routine (claimissues)";
 605     is( $err, 1, "Successfully sent claim" );
 606     is( $email_object->email->header('To'),
 607         'testemail@mydomain.com', "mailto correct in sent claim" );
 608     is(
 609         $email_object->email->body,
 610         "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy",
 611         'Serial claim letter for 1 issue constructed successfully'
 612     );
 613     }
 614
 615     {
 616     my $publisheddate = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
 617     my $serialexpected = ( C4::Serials::findSerialsByStatus( 1, $subscriptionid ) )[0];
 618     ModSerialStatus( $serials[0]->{serialid}, "No. 1", $publisheddate, $publisheddate, $publisheddate, '3', 'a note' );
 619     ($serials_count, @serials) = GetSerials($subscriptionid);
 620     push @serialids, ($serials[1]->{serialid});
 621
 622     warning_like { $err = SendAlerts( 'claimissues', \@serialids, 'TESTSERIALCLAIM' ); }
 623         qr|Fake send_or_die|,
 624         "SendAlerts is using the mocked sendmail routine (claimissues)";
 625
 626     is(
 627         $email_object->email->body,
 628         "$serialids[0]|2013-01-01|Silence in the library|xxxx-yyyy"
 629           . $email_object->email->crlf
 630           . "$serialids[1]|2013-01-01|Silence in the library|xxxx-yyyy",
 631         "Serial claim letter for 2 issues constructed successfully"
 632     );
 633
 634     $dbh->do(q{DELETE FROM letter WHERE code = 'TESTSERIALCLAIM';});
 635     warning_like {
 636         $err = SendAlerts( 'orderacquisition', $basketno , 'TESTSERIALCLAIM' ) }
 637         qr/No orderacquisition TESTSERIALCLAIM letter transported by email/,
 638         "GetPreparedLetter warns about missing notice template";
 639     is($err->{'error'}, 'no_letter', "No TESTSERIALCLAIM letter was defined");
 640     }
 641
 642 };
 643
 644 subtest 'GetPreparedLetter' => sub {
 645     plan tests => 4;
 646
 647     Koha::Notice::Template->new(
 648         {
 649             module                 => 'test',
 650             code                   => 'test',
 651             branchcode             => '',
 652             message_transport_type => 'email'
 653         }
 654     )->store;
 655     my $letter;
 656     warning_like {
 657         $letter = C4::Letters::GetPreparedLetter(
 658             module      => 'test',
 659             letter_code => 'test',
 660         );
 661     }
 662     qr{^ERROR: nothing to substitute},
 663 'GetPreparedLetter should warn if tables, substiture and repeat are not set';
 664     is( $letter, undef,
 665 'No letter should be returned by GetPreparedLetter if something went wrong'
 666     );
 667
 668     warning_like {
 669         $letter = C4::Letters::GetPreparedLetter(
 670             module      => 'test',
 671             letter_code => 'test',
 672             substitute  => {}
 673         );
 674     }
 675     qr{^ERROR: nothing to substitute},
 676 'GetPreparedLetter should warn if tables, substiture and repeat are not set, even if the key is passed';
 677     is( $letter, undef,
 678 'No letter should be returned by GetPreparedLetter if something went wrong'
 679     );
 680
 681 };
 682
 683
 684
 685 subtest 'TranslateNotices' => sub {
 686     plan tests => 4;
 687
 688     t::lib::Mocks::mock_preference( 'TranslateNotices', '1' );
 689
 690     $dbh->do(
 691         q|
 692         INSERT INTO letter (module, code, branchcode, name, title, content, message_transport_type, lang) VALUES
 693         ('test', 'code', '', 'test', 'a test', 'just a test', 'email', 'default'),
 694         ('test', 'code', '', 'test', 'una prueba', 'solo una prueba', 'email', 'es-ES');
 695     | );
 696     my $substitute = {};
 697     my $letter = C4::Letters::GetPreparedLetter(
 698             module                 => 'test',
 699             tables                 => $tables,
 700             letter_code            => 'code',
 701             message_transport_type => 'email',
 702             substitute             => $substitute,
 703     );
 704     is(
 705         $letter->{title},
 706         'a test',
 707         'GetPreparedLetter should return the default one if the lang parameter is not provided'
 708     );
 709
 710     $letter = C4::Letters::GetPreparedLetter(
 711             module                 => 'test',
 712             tables                 => $tables,
 713             letter_code            => 'code',
 714             message_transport_type => 'email',
 715             substitute             => $substitute,
 716             lang                   => 'es-ES',
 717     );
 718     is( $letter->{title}, 'una prueba',
 719         'GetPreparedLetter should return the required notice if it exists' );
 720
 721     $letter = C4::Letters::GetPreparedLetter(
 722             module                 => 'test',
 723             tables                 => $tables,
 724             letter_code            => 'code',
 725             message_transport_type => 'email',
 726             substitute             => $substitute,
 727             lang                   => 'fr-FR',
 728     );
 729     is(
 730         $letter->{title},
 731         'a test',
 732         'GetPreparedLetter should return the default notice if the one required does not exist'
 733     );
 734
 735     t::lib::Mocks::mock_preference( 'TranslateNotices', '' );
 736
 737     $letter = C4::Letters::GetPreparedLetter(
 738             module                 => 'test',
 739             tables                 => $tables,
 740             letter_code            => 'code',
 741             message_transport_type => 'email',
 742             substitute             => $substitute,
 743             lang                   => 'es-ES',
 744     );
 745     is( $letter->{title}, 'a test',
 746         'GetPreparedLetter should return the default notice if pref disabled but additional language exists' );
 747
 748 };
 749
 750 subtest 'SendQueuedMessages' => sub {
 751
 752     plan tests => 9;
 753
 754     t::lib::Mocks::mock_preference( 'SMSSendDriver', 'Email' );
 755     t::lib::Mocks::mock_preference('EmailSMSSendDriverFromAddress', '');
 756
 757     my $patron = Koha::Patrons->find($borrowernumber);
 758     $dbh->do(q|
 759         INSERT INTO message_queue(borrowernumber, subject, content, message_transport_type, status, letter_code)
 760         VALUES (?, 'subject', 'content', 'sms', 'pending', 'just_a_code')
 761         |, undef, $borrowernumber
 762     );
 763     eval { C4::Letters::SendQueuedMessages(); };
 764     is( $@, '', 'SendQueuedMessages should not explode if the patron does not have a sms provider set' );
 765
 766     my $sms_pro = $builder->build_object({ class => 'Koha::SMS::Providers', value => { domain => 'kidclamp.rocks' } });
 767     $patron->set( { smsalertnumber => '5555555555', sms_provider_id => $sms_pro->id() } )->store;
 768     $message_id = C4::Letters::EnqueueLetter($my_message); #using datas set around line 95 and forward
 769
 770     warning_like { C4::Letters::SendQueuedMessages(); }
 771         qr|Fake send_or_die|,
 772         "SendAlerts is using the mocked sendmail routine (claimissues)";
 773
 774     my $message = $schema->resultset('MessageQueue')->search({
 775         borrowernumber => $borrowernumber,
 776         status => 'sent'
 777     })->next();
 778
 779     is( $message->to_address(), '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address not set' );
 780     is(
 781         $message->from_address(),
 782         'from@example.com',
 783         'SendQueuedMessages uses message queue item \"from address\" for SMS by email when EmailSMSSendDriverFromAddress system preference is not set'
 784     );
 785
 786     $schema->resultset('MessageQueue')->search({borrowernumber => $borrowernumber, status => 'sent'})->delete(); #clear borrower queue
 787
 788     t::lib::Mocks::mock_preference('EmailSMSSendDriverFromAddress', 'override@example.com');
 789
 790     $message_id = C4::Letters::EnqueueLetter($my_message);
 791     warning_like { C4::Letters::SendQueuedMessages(); }
 792         qr|Fake send_or_die|,
 793         "SendAlerts is using the mocked sendmail routine (claimissues)";
 794
 795     $message = $schema->resultset('MessageQueue')->search({
 796         borrowernumber => $borrowernumber,
 797         status => 'sent'
 798     })->next();
 799
 800     is(
 801         $message->from_address(),
 802         'override@example.com',
 803         'SendQueuedMessages uses EmailSMSSendDriverFromAddress value for SMS by email when EmailSMSSendDriverFromAddress is set'
 804     );
 805
 806     $schema->resultset('MessageQueue')->search({borrowernumber => $borrowernumber,status => 'sent'})->delete(); #clear borrower queue
 807     $my_message->{to_address} = 'fixme@kidclamp.iswrong';
 808     $message_id = C4::Letters::EnqueueLetter($my_message);
 809
 810     my $number_attempted = C4::Letters::SendQueuedMessages({
 811         borrowernumber => -1, # -1 still triggers the borrowernumber condition
 812         letter_code    => 'PASSWORD_RESET',
 813     });
 814     is ( $number_attempted, 0, 'There were no password reset messages for SendQueuedMessages to attempt.' );
 815
 816     warning_like { C4::Letters::SendQueuedMessages(); }
 817         qr|Fake send_or_die|,
 818         "SendAlerts is using the mocked sendmail routine (claimissues)";
 819
 820     my $sms_message_address = $schema->resultset('MessageQueue')->search({
 821         borrowernumber => $borrowernumber,
 822         status => 'sent'
 823     })->next()->to_address();
 824     is( $sms_message_address, '5555555555@kidclamp.rocks', 'SendQueuedMessages populates the to address correctly for SMS by email when to_address is set incorrectly' );
 825
 826 };
 827
 828 subtest 'get_item_content' => sub {
 829     plan tests => 2;
 830
 831     t::lib::Mocks::mock_preference('dateformat', 'metric');
 832     t::lib::Mocks::mock_preference('timeformat', '24hr');
 833     my @items = (
 834         {date_due => '2041-01-01 12:34', title => 'a first title', barcode => 'a_first_barcode', author => 'a_first_author', itemnumber => 1 },
 835         {date_due => '2042-01-02 23:45', title => 'a second title', barcode => 'a_second_barcode', author => 'a_second_author', itemnumber => 2 },
 836     );
 837     my @item_content_fields = qw( date_due title barcode author itemnumber );
 838
 839     my $items_content;
 840     for my $item ( @items ) {
 841         $items_content .= C4::Letters::get_item_content( { item => $item, item_content_fields => \@item_content_fields } );
 842     }
 843
 844     my $expected_items_content = <<EOF;
 845 01/01/2041 12:34\ta first title\ta_first_barcode\ta_first_author\t1
 846 02/01/2042 23:45\ta second title\ta_second_barcode\ta_second_author\t2
 847 EOF
 848     is( $items_content, $expected_items_content, 'get_item_content should return correct items info with time (default)' );
 849
 850
 851     $items_content = q||;
 852     for my $item ( @items ) {
 853         $items_content .= C4::Letters::get_item_content( { item => $item, item_content_fields => \@item_content_fields, dateonly => 1, } );
 854     }
 855
 856     $expected_items_content = <<EOF;
 857 01/01/2041\ta first title\ta_first_barcode\ta_first_author\t1
 858 02/01/2042\ta second title\ta_second_barcode\ta_second_author\t2
 859 EOF
 860     is( $items_content, $expected_items_content, 'get_item_content should return correct items info without time (if dateonly => 1)' );
 861 };
 862
 863 subtest 'Test limit parameter for SendQueuedMessages' => sub {
 864     plan tests => 3;
 865
 866     my $dbh = C4::Context->dbh;
 867
 868     my $borrowernumber = Koha::Patron->new({
 869         firstname    => 'Jane',
 870         surname      => 'Smith',
 871         categorycode => $patron_category,
 872         branchcode   => $library->{branchcode},
 873         dateofbirth  => $date,
 874         smsalertnumber => undef,
 875     })->store->borrowernumber;
 876
 877     $dbh->do(q|DELETE FROM message_queue|);
 878     $my_message = {
 879         'letter' => {
 880             'content'      => 'a message',
 881             'metadata'     => 'metadata',
 882             'code'         => 'TEST_MESSAGE',
 883             'content_type' => 'text/plain',
 884             'title'        => 'message title'
 885         },
 886         'borrowernumber'         => $borrowernumber,
 887         'to_address'             => undef,
 888         'message_transport_type' => 'sms',
 889         'from_address'           => 'from@example.com'
 890     };
 891     C4::Letters::EnqueueLetter($my_message);
 892     C4::Letters::EnqueueLetter($my_message);
 893     C4::Letters::EnqueueLetter($my_message);
 894     C4::Letters::EnqueueLetter($my_message);
 895     C4::Letters::EnqueueLetter($my_message);
 896     my $messages_processed = C4::Letters::SendQueuedMessages( { limit => 1 } );
 897     is( $messages_processed, 1,
 898         'Processed 1 message with limit of 1 and 5 unprocessed messages' );
 899     $messages_processed = C4::Letters::SendQueuedMessages( { limit => 2 } );
 900     is( $messages_processed, 2,
 901         'Processed 2 message with limit of 2 and 4 unprocessed messages' );
 902     $messages_processed = C4::Letters::SendQueuedMessages( { limit => 3 } );
 903     is( $messages_processed, 2,
 904         'Processed 2 message with limit of 3 and 2 unprocessed messages' );
 905 };