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