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