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 => 74;
  22 use Test::MockModule;
  23 use Test::Warn;
  24
  25 use MARC::Record;
  26
  27 my %mail;
  28 my $module = new Test::MockModule('Mail::Sendmail');
  29 $module->mock(
  30     'sendmail',
  31     sub {
  32         warn "Fake sendmail";
  33         %mail = @_;
  34     }
  35 );
  36
  37 use_ok('C4::Context');
  38 use_ok('C4::Members');
  39 use_ok('C4::Acquisition');
  40 use_ok('C4::Biblio');
  41 use_ok('C4::Bookseller');
  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::Order;
  48 use Koha::Acquisition::Bookseller;
  49 use Koha::Libraries;
  50 my $schema = Koha::Database->schema;
  51 $schema->storage->txn_begin();
  52
  53 my $builder = t::lib::TestBuilder->new;
  54 my $dbh = C4::Context->dbh;
  55 $dbh->{RaiseError} = 1;
  56
  57 $dbh->do(q|DELETE FROM letter|);
  58 $dbh->do(q|DELETE FROM message_queue|);
  59 $dbh->do(q|DELETE FROM message_transport_types|);
  60
  61 my $library = $builder->build({
  62     source => 'Branch',
  63 });
  64 my $date = dt_from_string;
  65 my $borrowernumber = AddMember(
  66     firstname    => 'Jane',
  67     surname      => 'Smith',
  68     categorycode => 'PT',
  69     branchcode   => $library->{branchcode},
  70     dateofbirth  => $date,
  71 );
  72
  73 my $marc_record = MARC::Record->new;
  74 my( $biblionumber, $biblioitemnumber ) = AddBiblio( $marc_record, '' );
  75
  76 # GetMessageTransportTypes
  77 my $mtts = C4::Letters::GetMessageTransportTypes();
  78 is( @$mtts, 0, 'GetMessageTransportTypes returns the correct number of message types' );
  79
  80 $dbh->do(q|
  81     INSERT INTO message_transport_types( message_transport_type ) VALUES ('email'), ('phone'), ('print'), ('sms')
  82 |);
  83 $mtts = C4::Letters::GetMessageTransportTypes();
  84 is_deeply( $mtts, ['email', 'phone', 'print', 'sms'], 'GetMessageTransportTypes returns all values' );
  85
  86
  87 # EnqueueLetter
  88 is( C4::Letters::EnqueueLetter(), undef, 'EnqueueLetter without argument returns undef' );
  89
  90 my $my_message = {
  91     borrowernumber         => $borrowernumber,
  92     message_transport_type => 'sms',
  93     to_address             => 'to@example.com',
  94     from_address           => 'from@example.com',
  95 };
  96 my $message_id = C4::Letters::EnqueueLetter($my_message);
  97 is( $message_id, undef, 'EnqueueLetter without the letter argument returns undef' );
  98
  99 delete $my_message->{message_transport_type};
 100 $my_message->{letter} = {
 101     content      => 'a message',
 102     title        => 'message title',
 103     metadata     => 'metadata',
 104     code         => 'TEST_MESSAGE',
 105     content_type => 'text/plain',
 106 };
 107 $message_id = C4::Letters::EnqueueLetter($my_message);
 108 is( $message_id, undef, 'EnqueueLetter without the message type argument argument returns undef' );
 109
 110 $my_message->{message_transport_type} = 'sms';
 111 $message_id = C4::Letters::EnqueueLetter($my_message);
 112 ok(defined $message_id && $message_id > 0, 'new message successfully queued');
 113
 114
 115 # GetQueuedMessages
 116 my $messages = C4::Letters::GetQueuedMessages();
 117 is( @$messages, 1, 'GetQueuedMessages without argument returns all the entries' );
 118
 119 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
 120 is( @$messages, 1, 'one message stored for the borrower' );
 121 is( $messages->[0]->{message_id}, $message_id, 'EnqueueLetter returns the message id correctly' );
 122 is( $messages->[0]->{borrowernumber}, $borrowernumber, 'EnqueueLetter stores the borrower number correctly' );
 123 is( $messages->[0]->{subject}, $my_message->{letter}->{title}, 'EnqueueLetter stores the subject correctly' );
 124 is( $messages->[0]->{content}, $my_message->{letter}->{content}, 'EnqueueLetter stores the content correctly' );
 125 is( $messages->[0]->{message_transport_type}, $my_message->{message_transport_type}, 'EnqueueLetter stores the message type correctly' );
 126 is( $messages->[0]->{status}, 'pending', 'EnqueueLetter stores the status pending correctly' );
 127
 128
 129 # SendQueuedMessages
 130 my $messages_processed = C4::Letters::SendQueuedMessages();
 131 is($messages_processed, 1, 'all queued messages processed');
 132
 133 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
 134 is(
 135     $messages->[0]->{status},
 136     'failed',
 137     'message marked failed if tried to send SMS message for borrower with no smsalertnumber set (bug 11208)'
 138 );
 139
 140 # ResendMessage
 141 my $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
 142 my $message = C4::Letters::GetMessage( $messages->[0]->{message_id});
 143 is( $resent, 1, 'The message should have been resent' );
 144 is($message->{status},'pending', 'ResendMessage sets status to pending correctly (bug 12426)');
 145 $resent = C4::Letters::ResendMessage($messages->[0]->{message_id});
 146 is( $resent, 0, 'The message should not have been resent again' );
 147 $resent = C4::Letters::ResendMessage();
 148 is( $resent, undef, 'ResendMessage should return undef if not message_id given' );
 149
 150 # GetLetters
 151 my $letters = C4::Letters::GetLetters();
 152 is( @$letters, 0, 'GetLetters returns the correct number of letters' );
 153
 154 my $title = q|<<branches.branchname>> - <<status>>|;
 155 my $content = q{Dear <<borrowers.firstname>> <<borrowers.surname>>,
 156 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.
 157
 158 <<branches.branchname>>
 159 <<branches.branchaddress1>>
 160 URL: <<OPACBaseURL>>
 161
 162 The following item(s) is/are currently <<status>>:
 163
 164 <item> <<count>>. <<items.itemcallnumber>>, Barcode: <<items.barcode>> </item>
 165
 166 Thank-you for your prompt attention to this matter.
 167 Don't forget your date of birth: <<borrowers.dateofbirth>>.
 168 Look at this wonderful biblio timestamp: <<biblio.timestamp>>.
 169 };
 170
 171 $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 );
 172 $letters = C4::Letters::GetLetters();
 173 is( @$letters, 1, 'GetLetters returns the correct number of letters' );
 174 is( $letters->[0]->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
 175 is( $letters->[0]->{module}, 'my module', 'GetLetters gets the module correctly' );
 176 is( $letters->[0]->{code}, 'my code', 'GetLetters gets the code correctly' );
 177 is( $letters->[0]->{name}, 'my name', 'GetLetters gets the name correctly' );
 178
 179
 180 # getletter
 181 my $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
 182 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
 183 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
 184 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
 185 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
 186 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
 187 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
 188 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
 189 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
 190
 191 # Regression test for Bug 14206
 192 $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 );
 193 my $letter14206_a = C4::Letters::getletter('my module', 'my code', 'FFL' );
 194 is( $letter14206_a->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type not passed, correct mtt detected' );
 195 my $letter14206_b = C4::Letters::getletter('my module', 'my code', 'FFL', 'print');
 196 is( $letter14206_b->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type passed, correct mtt detected'  );
 197
 198 # test for overdue_notices.pl
 199 my $overdue_rules = {
 200     letter1         => 'my code',
 201 };
 202 my $i = 1;
 203 my $branchcode = 'FFL';
 204 my $letter14206_c = C4::Letters::getletter('my module', $overdue_rules->{"letter$i"}, $branchcode);
 205 is( $letter14206_c->{message_transport_type}, 'print', 'Bug 14206 - correct mtt detected for call from overdue_notices.pl' );
 206
 207 # addalert
 208 my $type = 'my type';
 209 my $externalid = 'my external id';
 210 my $alert_id = C4::Letters::addalert($borrowernumber, $type, $externalid);
 211 isnt( $alert_id, undef, 'addalert does not return undef' );
 212
 213
 214 # getalert
 215 my $alerts = C4::Letters::getalert();
 216 is( @$alerts, 1, 'getalert should not fail without parameter' );
 217 $alerts = C4::Letters::getalert($borrowernumber);
 218 is( @$alerts, 1, 'addalert adds an alert' );
 219 is( $alerts->[0]->{alertid}, $alert_id, 'addalert returns the alert id correctly' );
 220 is( $alerts->[0]->{type}, $type, 'addalert stores the type correctly' );
 221 is( $alerts->[0]->{externalid}, $externalid, 'addalert stores the externalid correctly' );
 222
 223 $alerts = C4::Letters::getalert($borrowernumber, $type);
 224 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 225 $alerts = C4::Letters::getalert($borrowernumber, $type, $externalid);
 226 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 227 $alerts = C4::Letters::getalert($borrowernumber, 'another type');
 228 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 229 $alerts = C4::Letters::getalert($borrowernumber, $type, 'another external id');
 230 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 231
 232
 233 # delalert
 234 eval {
 235     C4::Letters::delalert();
 236 };
 237 isnt( $@, undef, 'delalert without argument returns an error' );
 238 $alerts = C4::Letters::getalert($borrowernumber);
 239 is( @$alerts, 1, 'delalert without argument does not remove an alert' );
 240
 241 C4::Letters::delalert($alert_id);
 242 $alerts = C4::Letters::getalert($borrowernumber);
 243 is( @$alerts, 0, 'delalert removes an alert' );
 244
 245
 246 # GetPreparedLetter
 247 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
 248
 249 my $sms_content = 'This is a SMS for an <<status>>';
 250 $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 );
 251
 252 my $tables = {
 253     borrowers => $borrowernumber,
 254     branches => $library->{branchcode},
 255     biblio => $biblionumber,
 256 };
 257 my $substitute = {
 258     status => 'overdue',
 259 };
 260 my $repeat = [
 261     {
 262         itemcallnumber => 'my callnumber1',
 263         barcode        => '1234',
 264     },
 265     {
 266         itemcallnumber => 'my callnumber2',
 267         barcode        => '5678',
 268     },
 269 ];
 270 my $prepared_letter = GetPreparedLetter((
 271     module      => 'my module',
 272     branchcode  => $library->{branchcode},
 273     letter_code => 'my code',
 274     tables      => $tables,
 275     substitute  => $substitute,
 276     repeat      => $repeat,
 277 ));
 278 my $retrieved_library = Koha::Libraries->find($library->{branchcode});
 279 my $my_title_letter = $retrieved_library->branchname . qq| - $substitute->{status}|;
 280 my $my_content_letter = qq|Dear Jane Smith,
 281 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.
 282
 283 |.$retrieved_library->branchname.qq|
 284 |.$retrieved_library->branchaddress1.qq|
 285 URL: http://thisisatest.com
 286
 287 The following item(s) is/are currently $substitute->{status}:
 288
 289 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
 290 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
 291
 292 Thank-you for your prompt attention to this matter.
 293 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
 294 Look at this wonderful biblio timestamp: | . output_pref({ dt => $date }) . ".\n";
 295
 296 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
 297 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 298
 299 $prepared_letter = GetPreparedLetter((
 300     module                 => 'my module',
 301     branchcode             => $library->{branchcode},
 302     letter_code            => 'my code',
 303     tables                 => $tables,
 304     substitute             => $substitute,
 305     repeat                 => $repeat,
 306     message_transport_type => 'sms',
 307 ));
 308 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
 309 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 310
 311 $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>>.');});
 312 $prepared_letter = GetPreparedLetter((
 313     module                 => 'test_date',
 314     branchcode             => '',
 315     letter_code            => 'test_date',
 316     tables                 => $tables,
 317     substitute             => $substitute,
 318     repeat                 => $repeat,
 319 ));
 320 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 1' );
 321
 322 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp | dateonly>>.' WHERE code = 'test_date';});
 323 $prepared_letter = GetPreparedLetter((
 324     module                 => 'test_date',
 325     branchcode             => '',
 326     letter_code            => 'test_date',
 327     tables                 => $tables,
 328     substitute             => $substitute,
 329     repeat                 => $repeat,
 330 ));
 331 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 2' );
 332
 333 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp|dateonly >>.' WHERE code = 'test_date';});
 334 $prepared_letter = GetPreparedLetter((
 335     module                 => 'test_date',
 336     branchcode             => '',
 337     letter_code            => 'test_date',
 338     tables                 => $tables,
 339     substitute             => $substitute,
 340     repeat                 => $repeat,
 341 ));
 342 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 3' );
 343
 344 t::lib::Mocks::mock_preference( 'TimeFormat', '12hr' );
 345 my $yesterday_night = $date->clone->add( days => -1 )->set_hour(22);
 346 $dbh->do(q|UPDATE biblio SET timestamp = ? WHERE biblionumber = ?|, undef, $yesterday_night, $biblionumber );
 347 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp>>.' WHERE code = 'test_date';});
 348 $prepared_letter = GetPreparedLetter((
 349     module                 => 'test_date',
 350     branchcode             => '',
 351     letter_code            => 'test_date',
 352     tables                 => $tables,
 353     substitute             => $substitute,
 354     repeat                 => $repeat,
 355 ));
 356 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $yesterday_night }) . q|.|, 'dateonly test 3' );
 357
 358 $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>');});
 359
 360 # Test that _parseletter doesn't modify its parameters bug 15429
 361 {
 362     my $values = { dateexpiry => '2015-12-13', };
 363     C4::Letters::_parseletter($prepared_letter, 'borrowers', $values);
 364     is( $values->{dateexpiry}, '2015-12-13', "_parseletter doesn't modify its parameters" );
 365 }
 366
 367 my $booksellerid = C4::Bookseller::AddBookseller(
 368     {
 369         name => "my vendor",
 370         address1 => "bookseller's address",
 371         phone => "0123456",
 372         active => 1,
 373         deliverytime => 5,
 374     },
 375     [
 376         { name => 'John Smith',  phone => '0123456x1', claimacquisition => 1 },
 377         { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1 },
 378     ]
 379 );
 380 my $basketno = NewBasket($booksellerid, 1);
 381
 382 my $budgetid = C4::Budgets::AddBudget({
 383     budget_code => "budget_code_test_letters",
 384     budget_name => "budget_name_test_letters",
 385 });
 386
 387 my $bib = MARC::Record->new();
 388 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 389     $bib->append_fields(
 390         MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
 391     );
 392 } else {
 393     $bib->append_fields(
 394         MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
 395     );
 396 }
 397
 398 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
 399 my $order = Koha::Acquisition::Order->new(
 400     {
 401         basketno => $basketno,
 402         quantity => 1,
 403         biblionumber => $biblionumber,
 404         budget_id => $budgetid,
 405     }
 406 )->insert;
 407 my $ordernumber = $order->{ordernumber};
 408
 409 C4::Acquisition::CloseBasket( $basketno );
 410 my $err;
 411 warning_like {
 412     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 413     qr/^Bookseller .* without emails at/,
 414     "SendAlerts prints a warning";
 415 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
 416
 417 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 418 $bookseller->contacts->[0]->email('testemail@mydomain.com');
 419 C4::Bookseller::ModBookseller($bookseller);
 420 $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 421
 422 # Ensure that the preference 'LetterLog' is set to logging
 423 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
 424
 425 {
 426 warning_is {
 427     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 428     "Fake sendmail",
 429     "SendAlerts is using the mocked sendmail routine";
 430
 431 is($err, 1, "Successfully sent claim");
 432 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
 433 is($mail{'Message'}, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
 434 }
 435
 436 {
 437 use C4::Serials;
 438
 439 my $notes = 'notes';
 440 my $internalnotes = 'intnotes';
 441 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
 442 my $subscriptionid = NewSubscription(
 443      undef,      "",     undef, undef, undef, $biblionumber,
 444     '2013-01-01', 1, undef, undef,  undef,
 445     undef,      undef,  undef, undef, undef, undef,
 446     1,          $notes,undef, '2013-01-01', undef, 1,
 447     undef,       undef,  0,    $internalnotes,  0,
 448     undef, undef, 0,          undef,         '2013-12-31', 0
 449 );
 450 $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>>');});
 451 my ($serials_count, @serials) = GetSerials($subscriptionid);
 452 my $serial = $serials[0];
 453
 454 my $borrowernumber = AddMember(
 455     firstname    => 'John',
 456     surname      => 'Smith',
 457     categorycode => 'PT',
 458     branchcode   => $library->{branchcode},
 459     dateofbirth  => $date,
 460     email        => 'john.smith@test.de',
 461 );
 462 my $alert_id = C4::Letters::addalert($borrowernumber, 'issue', $subscriptionid);
 463
 464
 465 my $err2;
 466 warning_is {
 467 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
 468     "Fake sendmail",
 469     "SendAlerts is using the mocked sendmail routine";
 470 is($err2, "", "Successfully sent serial notification");
 471 is($mail{'To'}, 'john.smith@test.de', "mailto correct in sent serial notification");
 472 is($mail{'Message'}, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
 473 }