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 => 69;
  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 C4::Letters::ResendMessage($messages->[0]->{message_id});
 142 $messages = C4::Letters::GetQueuedMessages({ borrowernumber => $borrowernumber });
 143 is($messages->[0]->{status},'pending', 'ResendMessage sets status to pending correctly (bug 12426)');
 144
 145 # GetLetters
 146 my $letters = C4::Letters::GetLetters();
 147 is( @$letters, 0, 'GetLetters returns the correct number of letters' );
 148
 149 my $title = q|<<branches.branchname>> - <<status>>|;
 150 my $content = q{Dear <<borrowers.firstname>> <<borrowers.surname>>,
 151 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.
 152
 153 <<branches.branchname>>
 154 <<branches.branchaddress1>>
 155 URL: <<OPACBaseURL>>
 156
 157 The following item(s) is/are currently <<status>>:
 158
 159 <item> <<count>>. <<items.itemcallnumber>>, Barcode: <<items.barcode>> </item>
 160
 161 Thank-you for your prompt attention to this matter.
 162 Don't forget your date of birth: <<borrowers.dateofbirth>>.
 163 Look at this wonderful biblio timestamp: <<biblio.timestamp>>.
 164 };
 165
 166 $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 );
 167 $letters = C4::Letters::GetLetters();
 168 is( @$letters, 1, 'GetLetters returns the correct number of letters' );
 169 is( $letters->[0]->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
 170 is( $letters->[0]->{module}, 'my module', 'GetLetters gets the module correctly' );
 171 is( $letters->[0]->{code}, 'my code', 'GetLetters gets the code correctly' );
 172 is( $letters->[0]->{name}, 'my name', 'GetLetters gets the name correctly' );
 173
 174
 175 # getletter
 176 my $letter = C4::Letters::getletter('my module', 'my code', $library->{branchcode}, 'email');
 177 is( $letter->{branchcode}, $library->{branchcode}, 'GetLetters gets the branch code correctly' );
 178 is( $letter->{module}, 'my module', 'GetLetters gets the module correctly' );
 179 is( $letter->{code}, 'my code', 'GetLetters gets the code correctly' );
 180 is( $letter->{name}, 'my name', 'GetLetters gets the name correctly' );
 181 is( $letter->{is_html}, 1, 'GetLetters gets the boolean is_html correctly' );
 182 is( $letter->{title}, $title, 'GetLetters gets the title correctly' );
 183 is( $letter->{content}, $content, 'GetLetters gets the content correctly' );
 184 is( $letter->{message_transport_type}, 'email', 'GetLetters gets the message type correctly' );
 185
 186 # Regression test for Bug 14206
 187 $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 );
 188 my $letter14206_a = C4::Letters::getletter('my module', 'my code', 'FFL' );
 189 is( $letter14206_a->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type not passed, correct mtt detected' );
 190 my $letter14206_b = C4::Letters::getletter('my module', 'my code', 'FFL', 'print');
 191 is( $letter14206_b->{message_transport_type}, 'print', 'Bug 14206 - message_transport_type passed, correct mtt detected'  );
 192
 193 # test for overdue_notices.pl
 194 my $overdue_rules = {
 195     letter1         => 'my code',
 196 };
 197 my $i = 1;
 198 my $branchcode = 'FFL';
 199 my $letter14206_c = C4::Letters::getletter('my module', $overdue_rules->{"letter$i"}, $branchcode);
 200 is( $letter14206_c->{message_transport_type}, 'print', 'Bug 14206 - correct mtt detected for call from overdue_notices.pl' );
 201
 202 # addalert
 203 my $type = 'my type';
 204 my $externalid = 'my external id';
 205 my $alert_id = C4::Letters::addalert($borrowernumber, $type, $externalid);
 206 isnt( $alert_id, undef, 'addalert does not return undef' );
 207
 208 my $alerts = C4::Letters::getalert($borrowernumber);
 209 is( @$alerts, 1, 'addalert adds an alert' );
 210 is( $alerts->[0]->{alertid}, $alert_id, 'addalert returns the alert id correctly' );
 211 is( $alerts->[0]->{type}, $type, 'addalert stores the type correctly' );
 212 is( $alerts->[0]->{externalid}, $externalid, 'addalert stores the externalid correctly' );
 213
 214
 215 # getalert
 216 $alerts = C4::Letters::getalert($borrowernumber, $type);
 217 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 218 $alerts = C4::Letters::getalert($borrowernumber, $type, $externalid);
 219 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 220 $alerts = C4::Letters::getalert($borrowernumber, 'another type');
 221 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 222 $alerts = C4::Letters::getalert($borrowernumber, $type, 'another external id');
 223 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 224
 225
 226 # delalert
 227 eval {
 228     C4::Letters::delalert();
 229 };
 230 isnt( $@, undef, 'delalert without argument returns an error' );
 231 $alerts = C4::Letters::getalert($borrowernumber);
 232 is( @$alerts, 1, 'delalert without argument does not remove an alert' );
 233
 234 C4::Letters::delalert($alert_id);
 235 $alerts = C4::Letters::getalert($borrowernumber);
 236 is( @$alerts, 0, 'delalert removes an alert' );
 237
 238
 239 # GetPreparedLetter
 240 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
 241
 242 my $sms_content = 'This is a SMS for an <<status>>';
 243 $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 );
 244
 245 my $tables = {
 246     borrowers => $borrowernumber,
 247     branches => $library->{branchcode},
 248     biblio => $biblionumber,
 249 };
 250 my $substitute = {
 251     status => 'overdue',
 252 };
 253 my $repeat = [
 254     {
 255         itemcallnumber => 'my callnumber1',
 256         barcode        => '1234',
 257     },
 258     {
 259         itemcallnumber => 'my callnumber2',
 260         barcode        => '5678',
 261     },
 262 ];
 263 my $prepared_letter = GetPreparedLetter((
 264     module      => 'my module',
 265     branchcode  => $library->{branchcode},
 266     letter_code => 'my code',
 267     tables      => $tables,
 268     substitute  => $substitute,
 269     repeat      => $repeat,
 270 ));
 271 my $retrieved_library = Koha::Libraries->find($library->{branchcode});
 272 my $my_title_letter = $retrieved_library->branchname . qq| - $substitute->{status}|;
 273 my $my_content_letter = qq|Dear Jane Smith,
 274 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.
 275
 276 |.$retrieved_library->branchname.qq|
 277 |.$retrieved_library->branchaddress1.qq|
 278 URL: http://thisisatest.com
 279
 280 The following item(s) is/are currently $substitute->{status}:
 281
 282 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
 283 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
 284
 285 Thank-you for your prompt attention to this matter.
 286 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
 287 Look at this wonderful biblio timestamp: | . output_pref({ dt => $date }) . ".\n";
 288
 289 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
 290 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 291
 292 $prepared_letter = GetPreparedLetter((
 293     module                 => 'my module',
 294     branchcode             => $library->{branchcode},
 295     letter_code            => 'my code',
 296     tables                 => $tables,
 297     substitute             => $substitute,
 298     repeat                 => $repeat,
 299     message_transport_type => 'sms',
 300 ));
 301 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
 302 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 303
 304 $dbh->do(q{INSERT INTO letter (module, code, name, title, content) VALUES ('test_date','TEST_DATE','Test dates','Test dates','This one only contains the date: <<biblio.timestamp | dateonly>>.');});
 305 $prepared_letter = GetPreparedLetter((
 306     module                 => 'test_date',
 307     branchcode             => '',
 308     letter_code            => 'test_date',
 309     tables                 => $tables,
 310     substitute             => $substitute,
 311     repeat                 => $repeat,
 312 ));
 313 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 1' );
 314
 315 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp | dateonly>>.' WHERE code = 'test_date';});
 316 $prepared_letter = GetPreparedLetter((
 317     module                 => 'test_date',
 318     branchcode             => '',
 319     letter_code            => 'test_date',
 320     tables                 => $tables,
 321     substitute             => $substitute,
 322     repeat                 => $repeat,
 323 ));
 324 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 2' );
 325
 326 $dbh->do(q{UPDATE letter SET content = 'And also this one:<<timestamp|dateonly >>.' WHERE code = 'test_date';});
 327 $prepared_letter = GetPreparedLetter((
 328     module                 => 'test_date',
 329     branchcode             => '',
 330     letter_code            => 'test_date',
 331     tables                 => $tables,
 332     substitute             => $substitute,
 333     repeat                 => $repeat,
 334 ));
 335 is( $prepared_letter->{content}, q|This one only contains the date: | . output_pref({ dt => $date, dateonly => 1 }) . q|.|, 'dateonly test 3' );
 336
 337 $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>');});
 338
 339 # Test that _parseletter doesn't modify its parameters bug 15429
 340 {
 341     my $values = { dateexpiry => '2015-12-13', };
 342     C4::Letters::_parseletter($prepared_letter, 'borrowers', $values);
 343     is( $values->{dateexpiry}, '2015-12-13', "_parseletter doesn't modify its parameters" );
 344 }
 345
 346 my $booksellerid = C4::Bookseller::AddBookseller(
 347     {
 348         name => "my vendor",
 349         address1 => "bookseller's address",
 350         phone => "0123456",
 351         active => 1,
 352         deliverytime => 5,
 353     },
 354     [
 355         { name => 'John Smith',  phone => '0123456x1', claimacquisition => 1 },
 356         { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1 },
 357     ]
 358 );
 359 my $basketno = NewBasket($booksellerid, 1);
 360
 361 my $budgetid = C4::Budgets::AddBudget({
 362     budget_code => "budget_code_test_letters",
 363     budget_name => "budget_name_test_letters",
 364 });
 365
 366 my $bib = MARC::Record->new();
 367 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 368     $bib->append_fields(
 369         MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
 370     );
 371 } else {
 372     $bib->append_fields(
 373         MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
 374     );
 375 }
 376
 377 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
 378 my $order = Koha::Acquisition::Order->new(
 379     {
 380         basketno => $basketno,
 381         quantity => 1,
 382         biblionumber => $biblionumber,
 383         budget_id => $budgetid,
 384     }
 385 )->insert;
 386 my $ordernumber = $order->{ordernumber};
 387
 388 C4::Acquisition::CloseBasket( $basketno );
 389 my $err;
 390 warning_like {
 391     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 392     qr/^Bookseller .* without emails at/,
 393     "SendAlerts prints a warning";
 394 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
 395
 396 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 397 $bookseller->contacts->[0]->email('testemail@mydomain.com');
 398 C4::Bookseller::ModBookseller($bookseller);
 399 $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 400
 401 # Ensure that the preference 'LetterLog' is set to logging
 402 C4::Context->set_preference( 'LetterLog', 'on' );
 403
 404 {
 405 warning_is {
 406     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 407     "Fake sendmail",
 408     "SendAlerts is using the mocked sendmail routine";
 409
 410 is($err, 1, "Successfully sent claim");
 411 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
 412 is($mail{'Message'}, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
 413 }
 414
 415 {
 416 use C4::Serials;
 417
 418 my $notes = 'notes';
 419 my $internalnotes = 'intnotes';
 420 $dbh->do(q|UPDATE subscription_numberpatterns SET numberingmethod='No. {X}' WHERE id=1|);
 421 my $subscriptionid = NewSubscription(
 422      undef,      "",     undef, undef, undef, $biblionumber,
 423     '2013-01-01', 1, undef, undef,  undef,
 424     undef,      undef,  undef, undef, undef, undef,
 425     1,          $notes,undef, '2013-01-01', undef, 1,
 426     undef,       undef,  0,    $internalnotes,  0,
 427     undef, undef, 0,          undef,         '2013-12-31', 0
 428 );
 429 $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>>');});
 430 my ($serials_count, @serials) = GetSerials($subscriptionid);
 431 my $serial = $serials[0];
 432
 433 my $borrowernumber = AddMember(
 434     firstname    => 'John',
 435     surname      => 'Smith',
 436     categorycode => 'PT',
 437     branchcode   => $library->{branchcode},
 438     dateofbirth  => $date,
 439     email        => 'john.smith@test.de',
 440 );
 441 my $alert_id = C4::Letters::addalert($borrowernumber, 'issue', $subscriptionid);
 442
 443
 444 my $err2;
 445 warning_is {
 446 $err2 = SendAlerts( 'issue', $serial->{serialid}, 'RLIST' ) }
 447     "Fake sendmail",
 448     "SendAlerts is using the mocked sendmail routine";
 449 is($err2, "", "Successfully sent serial notification");
 450 is($mail{'To'}, 'john.smith@test.de', "mailto correct in sent serial notification");
 451 is($mail{'Message'}, 'Silence in the library,'.$subscriptionid.',No. 0', 'Serial notification text constructed successfully');
 452 }