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 => 60;
  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 # addalert
 188 my $type = 'my type';
 189 my $externalid = 'my external id';
 190 my $alert_id = C4::Letters::addalert($borrowernumber, $type, $externalid);
 191 isnt( $alert_id, undef, 'addalert does not return undef' );
 192
 193 my $alerts = C4::Letters::getalert($borrowernumber);
 194 is( @$alerts, 1, 'addalert adds an alert' );
 195 is( $alerts->[0]->{alertid}, $alert_id, 'addalert returns the alert id correctly' );
 196 is( $alerts->[0]->{type}, $type, 'addalert stores the type correctly' );
 197 is( $alerts->[0]->{externalid}, $externalid, 'addalert stores the externalid correctly' );
 198
 199
 200 # getalert
 201 $alerts = C4::Letters::getalert($borrowernumber, $type);
 202 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 203 $alerts = C4::Letters::getalert($borrowernumber, $type, $externalid);
 204 is( @$alerts, 1, 'getalert returns the correct number of alerts' );
 205 $alerts = C4::Letters::getalert($borrowernumber, 'another type');
 206 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 207 $alerts = C4::Letters::getalert($borrowernumber, $type, 'another external id');
 208 is( @$alerts, 0, 'getalert returns the correct number of alerts' );
 209
 210
 211 # delalert
 212 eval {
 213     C4::Letters::delalert();
 214 };
 215 isnt( $@, undef, 'delalert without argument returns an error' );
 216 $alerts = C4::Letters::getalert($borrowernumber);
 217 is( @$alerts, 1, 'delalert without argument does not remove an alert' );
 218
 219 C4::Letters::delalert($alert_id);
 220 $alerts = C4::Letters::getalert($borrowernumber);
 221 is( @$alerts, 0, 'delalert removes an alert' );
 222
 223
 224 # GetPreparedLetter
 225 t::lib::Mocks::mock_preference('OPACBaseURL', 'http://thisisatest.com');
 226
 227 my $sms_content = 'This is a SMS for an <<status>>';
 228 $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 );
 229
 230 my $tables = {
 231     borrowers => $borrowernumber,
 232     branches => 'CPL',
 233     biblio => $biblionumber,
 234 };
 235 my $substitute = {
 236     status => 'overdue',
 237 };
 238 my $repeat = [
 239     {
 240         itemcallnumber => 'my callnumber1',
 241         barcode        => '1234',
 242     },
 243     {
 244         itemcallnumber => 'my callnumber2',
 245         barcode        => '5678',
 246     },
 247 ];
 248 my $prepared_letter = GetPreparedLetter((
 249     module      => 'my module',
 250     branchcode  => 'CPL',
 251     letter_code => 'my code',
 252     tables      => $tables,
 253     substitute  => $substitute,
 254     repeat      => $repeat,
 255 ));
 256 my $branch = GetBranchDetail('CPL');
 257 my $my_title_letter = qq|$branch->{branchname} - $substitute->{status}|;
 258 my $my_content_letter = qq|Dear Jane Smith,
 259 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.
 260
 261 $branch->{branchname}
 262 $branch->{branchaddress1}
 263 URL: http://thisisatest.com
 264
 265 The following item(s) is/are currently $substitute->{status}:
 266
 267 <item> 1. $repeat->[0]->{itemcallnumber}, Barcode: $repeat->[0]->{barcode} </item>
 268 <item> 2. $repeat->[1]->{itemcallnumber}, Barcode: $repeat->[1]->{barcode} </item>
 269
 270 Thank-you for your prompt attention to this matter.
 271 Don't forget your date of birth: | . output_pref({ dt => $date, dateonly => 1 }) . q|.
 272 Look at this wonderful biblio timestamp: | . output_pref({ dt => $date }) . ".\n";
 273 is( $prepared_letter->{title}, $my_title_letter, 'GetPreparedLetter returns the title correctly' );
 274 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 275
 276 $prepared_letter = GetPreparedLetter((
 277     module                 => 'my module',
 278     branchcode             => 'CPL',
 279     letter_code            => 'my code',
 280     tables                 => $tables,
 281     substitute             => $substitute,
 282     repeat                 => $repeat,
 283     message_transport_type => 'sms',
 284 ));
 285 $my_content_letter = qq|This is a SMS for an $substitute->{status}|;
 286 is( $prepared_letter->{content}, $my_content_letter, 'GetPreparedLetter returns the content correctly' );
 287
 288 $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>');});
 289
 290 my $booksellerid = C4::Bookseller::AddBookseller(
 291     {
 292         name => "my vendor",
 293         address1 => "bookseller's address",
 294         phone => "0123456",
 295         active => 1,
 296         deliverytime => 5,
 297     },
 298     [
 299         { name => 'John Smith',  phone => '0123456x1', claimacquisition => 1 },
 300         { name => 'Leo Tolstoy', phone => '0123456x2', claimissues => 1 },
 301     ]
 302 );
 303 my $basketno = NewBasket($booksellerid, 1);
 304
 305 my $budgetid = C4::Budgets::AddBudget({
 306     budget_code => "budget_code_test_letters",
 307     budget_name => "budget_name_test_letters",
 308 });
 309
 310 my $bib = MARC::Record->new();
 311 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 312     $bib->append_fields(
 313         MARC::Field->new('200', ' ', ' ', a => 'Silence in the library'),
 314     );
 315 } else {
 316     $bib->append_fields(
 317         MARC::Field->new('245', ' ', ' ', a => 'Silence in the library'),
 318     );
 319 }
 320
 321 ($biblionumber, $biblioitemnumber) = AddBiblio($bib, '');
 322 my $order = Koha::Acquisition::Order->new(
 323     {
 324         basketno => $basketno,
 325         quantity => 1,
 326         biblionumber => $biblionumber,
 327         budget_id => $budgetid,
 328     }
 329 )->insert;
 330 my $ordernumber = $order->{ordernumber};
 331
 332 C4::Acquisition::CloseBasket( $basketno );
 333 my $err;
 334 warning_like {
 335     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 336     qr/^Bookseller .* without emails at/,
 337     "SendAlerts prints a warning";
 338 is($err->{'error'}, 'no_email', "Trying to send an alert when there's no e-mail results in an error");
 339
 340 my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 341 $bookseller->contacts->[0]->email('testemail@mydomain.com');
 342 C4::Bookseller::ModBookseller($bookseller);
 343 $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
 344
 345 warning_is {
 346     $err = SendAlerts( 'claimacquisition', [ $ordernumber ], 'TESTACQCLAIM' ) }
 347     "Fake sendmail",
 348     "SendAlerts is using the mocked sendmail routine";
 349
 350 is($err, 1, "Successfully sent claim");
 351 is($mail{'To'}, 'testemail@mydomain.com', "mailto correct in sent claim");
 352 is($mail{'Message'}, 'my vendor|John Smith|Ordernumber ' . $ordernumber . ' (Silence in the library) (1 ordered)', 'Claim notice text constructed successfully');
 353
 354 $schema->storage->txn_rollback();