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