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