t/db_dependent/Letters.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright (C) 2013 Equinox Software, Inc.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use Test::More tests => 73;
  22 use Test::MockModule;
  23 use Test::Warn;
  24
  25 use MARC::Record;
  26
  27 my %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 my $alerts = C4::Letters::getalert($borrowernumber);
 214 is( @$alerts, 1, 'addalert adds an alert' );
 215 is( $alerts->[0]->{alertid}, $alert_id, 'addalert returns the alert id correctly' );
 216 is( $alerts->[0]->{type}, $type, 'addalert stores the type correctly' );
 217 is( $alerts->[0]->{externalid}, $externalid, 'addalert stores the externalid correctly' );
 218
 219
 220 # getalert
 221 $alerts = C4::Letters::getalert($borrowernumber, $type);
 222 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 223 $alerts = C4::Letters::getalert($borrowernumber, $type, $externalid);
 224 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 225 $alerts = C4::Letters::getalert($borrowernumber, 'another type');
 226 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 227 $alerts = C4::Letters::getalert($borrowernumber, $type, 'another external id');
 228 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 229
 230
 231 # delalert
 232 eval {
 233     C4::Letters::delalert();
 234 };
 235 isnt( $@, undef, 'delalert without argument returns an error' );
 236 $alerts = C4::Letters::getalert($borrowernumber);
 237 is( @$alerts, 1, 'delalert without argument does not remove an alert' );
 238
 239 C4::Letters::delalert($alert_id);
 240 $alerts = C4::Letters::getalert($borrowernumber);
 241 is( @$alerts, 0, 'delalert removes an alert' );
 242
 243
 244 # GetPreparedLetter
 245 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
 246
 247 my $sms_content = 'This is a SMS for an <<status>>';
 248 $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 );
 249
 250 my $tables = {
 251     borrowers => $borrowernumber,
 252     branches => $library->{branchcode},
 253     biblio => $biblionumber,
 254 };
 255 my $substitute = {
 256     status => 'overdue',
 257 };
 258 my $repeat = [
 259     {
 260         itemcallnumber => 'my callnumber1',
 261         barcode        => '1234',
 262     },
 263     {
 264         itemcallnumber => 'my callnumber2',
 265         barcode        => '5678',
 266     },
 267 ];
 268 my $prepared_letter = GetPreparedLetter((
 269     module      => 'my module',
 270     branchcode  => $library->{branchcode},
 271     letter_code => 'my code',
 272     tables      => $tables,
 273     substitute  => $substitute,
 274     repeat      => $repeat,
 275 ));
 276 my $retrieved_library = Koha::Libraries->find($library->{branchcode});
 277 my $my_title_letter = $retrieved_library->branchname . qq| - $substitute->{status}|;
 278 my $my_content_letter = qq|Dear Jane Smith,
 279 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.
 280
 281 |.$retrieved_library->branchname.qq|
 282 |.$retrieved_library->branchaddress1.qq|
 283 URL: http://thisisatest.com
 284
 285 The following item(s) is/are currently $substitute->{status}:
 286
 287 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
 288 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
 289
 290 Thank-you for your prompt attention to this matter.
 291 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
 292 Look at this wonderful biblio timestamp: | . output_pref({ dt => $date }) . ".\n";
 293
 294 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
 295 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 296
 297 $prepared_letter = GetPreparedLetter((
 298     module                 => 'my module',
 299     branchcode             => $library->{branchcode},
 300     letter_code            => 'my code',
 301     tables                 => $tables,
 302     substitute             => $substitute,
 303     repeat                 => $repeat,
 304     message_transport_type => 'sms',
 305 ));
 306 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
 307 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 308
 309 $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>>.');});
 310 $prepared_letter = GetPreparedLetter((
 311     module                 => 'test_date',
 312     branchcode             => '',
 313     letter_code            => 'test_date',
 314     tables                 => $tables,
 315     substitute             => $substitute,
 316     repeat                 => $repeat,
 317 ));
 318 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 1' );
 319
 320 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp | dateonly>>.' WHERE code = 'test_date';});
 321 $prepared_letter = GetPreparedLetter((
 322     module                 => 'test_date',
 323     branchcode             => '',
 324     letter_code            => 'test_date',
 325     tables                 => $tables,
 326     substitute             => $substitute,
 327     repeat                 => $repeat,
 328 ));
 329 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 2' );
 330
 331 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp|dateonly >>.' WHERE code = 'test_date';});
 332 $prepared_letter = GetPreparedLetter((
 333     module                 => 'test_date',
 334     branchcode             => '',
 335     letter_code            => 'test_date',
 336     tables                 => $tables,
 337     substitute             => $substitute,
 338     repeat                 => $repeat,
 339 ));
 340 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 3' );
 341
 342 t::lib::Mocks::mock_preference( 'TimeFormat', '12hr' );
 343 my $yesterday_night = $date->clone->add( days => -1 )->set_hour(22);
 344 $dbh->do(q|UPDATE biblio SET timestamp = ? WHERE biblionumber = ?|, undef, $yesterday_night, $biblionumber );
 345 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp>>.' WHERE code = 'test_date';});
 346 $prepared_letter = GetPreparedLetter((
 347     module                 => 'test_date',
 348     branchcode             => '',
 349     letter_code            => 'test_date',
 350     tables                 => $tables,
 351     substitute             => $substitute,
 352     repeat                 => $repeat,
 353 ));
 354 is( $prepared_letter->{content}, q|And also this one:| . output_pref({ dt => $yesterday_night }) . q|.|, 'dateonly test 3' );
 355
 356 $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>');});
 357
 358 # Test that _parseletter doesn't modify its parameters bug 15429
 359 {
 360     my $values = { dateexpiry => '2015-12-13', };
 361     C4::Letters::_parseletter($prepared_letter, 'borrowers', $values);
 362     is( $values->{dateexpiry}, '2015-12-13', "_parseletter doesn't modify its parameters" );
 363 }
 364
 365 my $booksellerid = C4::Bookseller::AddBookseller(
 366     {
 367         name => "my vendor",
 368         address1 => "bookseller's address",
 369         phone => "0123456",
 370         active => 1,
 371         deliverytime => 5,
 372     },
 373     [
 374         { name => 'John Smith',  phone => '0123456x1', claimacquisition => 1 },
 375         { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1 },
 376     ]
 377 );
 378 my $basketno = NewBasket($booksellerid, 1);
 379
 380 my $budgetid = C4::Budgets::AddBudget({
 381     budget_code => "budget_code_test_letters",
 382     budget_name => "budget_name_test_letters",
 383 });
 384
 385 my $bib = MARC::Record->new();
 386 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 387     $bib->append_fields(
 388         MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
 389     );
 390 } else {
 391     $bib->append_fields(
 392         MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
 393     );
 394 }
 395
 396 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
 397 my $order = Koha::Acquisition::Order->new(
 398     {
 399         basketno => $basketno,
 400         quantity => 1,
 401         biblionumber => $biblionumber,
 402         budget_id => $budgetid,
 403     }
 404 )->insert;
 405 my $ordernumber = $order->{ordernumber};
 406
 407 C4::Acquisition::CloseBasket( $basketno );
 408 my $err;
 409 warning_like {
 410     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 411     qr/^Bookseller .* without emails at/,
 412     "SendAlerts prints a warning";
 413 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
 414
 415 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 416 $bookseller->contacts->[0]->email('testemail@mydomain.com');
 417 C4::Bookseller::ModBookseller($bookseller);
 418 $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 419
 420 # Ensure that the preference 'LetterLog' is set to logging
 421 t::lib::Mocks::mock_preference( 'LetterLog', 'on' );
 422
 423 {
 424 warning_is {
 425     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 426     "Fake sendmail",
 427     "SendAlerts is using the mocked sendmail routine";
 428
 429 is($err, 1, "Successfully sent claim");
 430 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
 431 is($mail{'Message'}, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
 432 }
 433
 434 {
 435 use C4::Serials;
 436
 437 my $notes = 'notes';
 438 my $internalnotes = 'intnotes';
 439 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
 440 my $subscriptionid = NewSubscription(
 441      undef,      "",     undef, undef, undef, $biblionumber,
 442     '2013-01-01', 1, undef, undef,  undef,
 443     undef,      undef,  undef, undef, undef, undef,
 444     1,          $notes,undef, '2013-01-01', undef, 1,
 445     undef,       undef,  0,    $internalnotes,  0,
 446     undef, undef, 0,          undef,         '2013-12-31', 0
 447 );
 448 $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>>');});
 449 my ($serials_count, @serials) = GetSerials($subscriptionid);
 450 my $serial = $serials[0];
 451
 452 my $borrowernumber = AddMember(
 453     firstname    => 'John',
 454     surname      => 'Smith',
 455     categorycode => 'PT',
 456     branchcode   => $library->{branchcode},
 457     dateofbirth  => $date,
 458     email        => 'john.smith@test.de',
 459 );
 460 my $alert_id = C4::Letters::addalert($borrowernumber, 'issue', $subscriptionid);
 461
 462
 463 my $err2;
 464 warning_is {
 465 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
 466     "Fake sendmail",
 467     "SendAlerts is using the mocked sendmail routine";
 468 is($err2, "", "Successfully sent serial notification");
 469 is($mail{'To'}, 'john.smith@test.de', "mailto correct in sent serial notification");
 470 is($mail{'Message'}, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
 471 }