C4/Letters.pm

   1 package C4::Letters;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   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
  22 use Carp qw( carp croak );
  23 use Template;
  24 use Module::Load::Conditional qw( can_load );
  25
  26 use Try::Tiny qw( catch try );
  27
  28 use C4::Members;
  29 use C4::Log qw( logaction );
  30 use C4::SMS;
  31 use C4::Templates;
  32 use Koha::DateUtils qw( dt_from_string output_pref );
  33 use Koha::SMS::Providers;
  34
  35 use Koha::Email;
  36 use Koha::Notice::Messages;
  37 use Koha::Notice::Templates;
  38 use Koha::DateUtils qw( dt_from_string output_pref );
  39 use Koha::Auth::TwoFactorAuth;
  40 use Koha::Patrons;
  41 use Koha::SMTP::Servers;
  42 use Koha::Subscriptions;
  43
  44 use constant SERIALIZED_EMAIL_CONTENT_TYPE => 'message/rfc822';
  45
  46 our (@ISA, @EXPORT_OK);
  47 BEGIN {
  48     require Exporter;
  49     @ISA = qw(Exporter);
  50     @EXPORT_OK = qw(
  51       GetLetters
  52       GetLettersAvailableForALibrary
  53       GetLetterTemplates
  54       DelLetter
  55       GetPreparedLetter
  56       GetWrappedLetter
  57       SendAlerts
  58       GetPrintMessages
  59       GetQueuedMessages
  60       GetMessage
  61       GetMessageTransportTypes
  62
  63       EnqueueLetter
  64       SendQueuedMessages
  65       ResendMessage
  66     );
  67 }
  68
  69 =head1 NAME
  70
  71 C4::Letters - Give functions for Letters management
  72
  73 =head1 SYNOPSIS
  74
  75   use C4::Letters;
  76
  77 =head1 DESCRIPTION
  78
  79   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  80   late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
  81
  82   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  83
  84 =head2 GetLetters([$module])
  85
  86   $letters = &GetLetters($module);
  87   returns informations about letters.
  88   if needed, $module filters for letters given module
  89
  90   DEPRECATED - You must use Koha::Notice::Templates instead
  91   The group by clause is confusing and can lead to issues
  92
  93 =cut
  94
  95 sub GetLetters {
  96     my ($filters) = @_;
  97     my $module    = $filters->{module};
  98     my $code      = $filters->{code};
  99     my $branchcode = $filters->{branchcode};
 100     my $dbh       = C4::Context->dbh;
 101     my $letters   = $dbh->selectall_arrayref(
 102         q|
 103             SELECT code, module, name
 104             FROM letter
 105             WHERE 1
 106         |
 107           . ( $module ? q| AND module = ?| : q|| )
 108           . ( $code   ? q| AND code = ?|   : q|| )
 109           . ( defined $branchcode   ? q| AND branchcode = ?|   : q|| )
 110           . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
 111         , ( $module ? $module : () )
 112         , ( $code ? $code : () )
 113         , ( defined $branchcode ? $branchcode : () )
 114     );
 115
 116     return $letters;
 117 }
 118
 119 =head2 GetLetterTemplates
 120
 121     my $letter_templates = GetLetterTemplates(
 122         {
 123             module => 'circulation',
 124             code => 'my code',
 125             branchcode => 'CPL', # '' for default,
 126         }
 127     );
 128
 129     Return a hashref of letter templates.
 130
 131 =cut
 132
 133 sub GetLetterTemplates {
 134     my ( $params ) = @_;
 135
 136     my $module    = $params->{module};
 137     my $code      = $params->{code};
 138     my $branchcode = $params->{branchcode} // '';
 139     my $dbh       = C4::Context->dbh;
 140     return Koha::Notice::Templates->search(
 141         {
 142             module     => $module,
 143             code       => $code,
 144             branchcode => $branchcode,
 145             (
 146                 C4::Context->preference('TranslateNotices')
 147                 ? ()
 148                 : ( lang => 'default' )
 149             )
 150         }
 151     )->unblessed;
 152 }
 153
 154 =head2 GetLettersAvailableForALibrary
 155
 156     my $letters = GetLettersAvailableForALibrary(
 157         {
 158             branchcode => 'CPL', # '' for default
 159             module => 'circulation',
 160         }
 161     );
 162
 163     Return an arrayref of letters, sorted by name.
 164     If a specific letter exist for the given branchcode, it will be retrieve.
 165     Otherwise the default letter will be.
 166
 167 =cut
 168
 169 sub GetLettersAvailableForALibrary {
 170     my ($filters)  = @_;
 171     my $branchcode = $filters->{branchcode};
 172     my $module     = $filters->{module};
 173
 174     croak "module should be provided" unless $module;
 175
 176     my $dbh             = C4::Context->dbh;
 177     my $default_letters = $dbh->selectall_arrayref(
 178         q|
 179             SELECT module, code, branchcode, name
 180             FROM letter
 181             WHERE 1
 182         |
 183           . q| AND branchcode = ''|
 184           . ( $module ? q| AND module = ?| : q|| )
 185           . q| ORDER BY name|, { Slice => {} }
 186         , ( $module ? $module : () )
 187     );
 188
 189     my $specific_letters;
 190     if ($branchcode) {
 191         $specific_letters = $dbh->selectall_arrayref(
 192             q|
 193                 SELECT module, code, branchcode, name
 194                 FROM letter
 195                 WHERE 1
 196             |
 197               . q| AND branchcode = ?|
 198               . ( $module ? q| AND module = ?| : q|| )
 199               . q| ORDER BY name|, { Slice => {} }
 200             , $branchcode
 201             , ( $module ? $module : () )
 202         );
 203     }
 204
 205     my %letters;
 206     for my $l (@$default_letters) {
 207         $letters{ $l->{code} } = $l;
 208     }
 209     for my $l (@$specific_letters) {
 210         # Overwrite the default letter with the specific one.
 211         $letters{ $l->{code} } = $l;
 212     }
 213
 214     return [ map { $letters{$_} }
 215           sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
 216           keys %letters ];
 217
 218 }
 219
 220 =head2 DelLetter
 221
 222     DelLetter(
 223         {
 224             branchcode => 'CPL',
 225             module => 'circulation',
 226             code => 'my code',
 227             [ mtt => 'email', ]
 228         }
 229     );
 230
 231     Delete the letter. The mtt parameter is facultative.
 232     If not given, all templates mathing the other parameters will be removed.
 233
 234 =cut
 235
 236 sub DelLetter {
 237     my ($params)   = @_;
 238     my $branchcode = $params->{branchcode};
 239     my $module     = $params->{module};
 240     my $code       = $params->{code};
 241     my $mtt        = $params->{mtt};
 242     my $lang       = $params->{lang};
 243     my $dbh        = C4::Context->dbh;
 244     $dbh->do(q|
 245         DELETE FROM letter
 246         WHERE branchcode = ?
 247           AND module = ?
 248           AND code = ?
 249     |
 250     . ( $mtt ? q| AND message_transport_type = ?| : q|| )
 251     . ( $lang? q| AND lang = ?| : q|| )
 252     , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
 253 }
 254
 255 =head2 SendAlerts
 256
 257     my $err = &SendAlerts($type, $externalid, $letter_code);
 258
 259     Parameters:
 260       - $type : the type of alert
 261       - $externalid : the id of the "object" to query
 262       - $letter_code : the notice template to use
 263
 264     C<&SendAlerts> sends an email notice directly to a patron or a vendor.
 265
 266     Currently it supports ($type):
 267       - claim serial issues (claimissues)
 268       - claim acquisition orders (claimacquisition)
 269       - send acquisition orders to the vendor (orderacquisition)
 270       - notify patrons about newly received serial issues (issue)
 271       - notify patrons when their account is created (members)
 272
 273     Returns undef or { error => 'message } on failure.
 274     Returns true on success.
 275
 276 =cut
 277
 278 sub SendAlerts {
 279     my ( $type, $externalid, $letter_code ) = @_;
 280     my $dbh = C4::Context->dbh;
 281     my $error;
 282
 283     if ( $type eq 'issue' ) {
 284
 285         # prepare the letter...
 286         # search the subscriptionid
 287         my $sth =
 288           $dbh->prepare(
 289             "SELECT subscriptionid FROM serial WHERE serialid=?");
 290         $sth->execute($externalid);
 291         my ($subscriptionid) = $sth->fetchrow
 292           or warn( "No subscription for '$externalid'" ),
 293              return;
 294
 295         # search the biblionumber
 296         $sth =
 297           $dbh->prepare(
 298             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 299         $sth->execute($subscriptionid);
 300         my ($biblionumber) = $sth->fetchrow
 301           or warn( "No biblionumber for '$subscriptionid'" ),
 302              return;
 303
 304         # find the list of subscribers to notify
 305         my $subscription = Koha::Subscriptions->find( $subscriptionid );
 306         my $subscribers = $subscription->subscribers;
 307         while ( my $patron = $subscribers->next ) {
 308             my $email = $patron->email or next;
 309
 310 #                    warn "sending issues...";
 311             my $userenv = C4::Context->userenv;
 312             my $library = $patron->library;
 313             my $letter = GetPreparedLetter (
 314                 module => 'serial',
 315                 letter_code => $letter_code,
 316                 branchcode => $userenv->{branch},
 317                 tables => {
 318                     'branches'    => $library->branchcode,
 319                     'biblio'      => $biblionumber,
 320                     'biblioitems' => $biblionumber,
 321                     'borrowers'   => $patron->unblessed,
 322                     'subscription' => $subscriptionid,
 323                     'serial' => $externalid,
 324                 },
 325                 want_librarian => 1,
 326             ) or return;
 327
 328             # FIXME: This 'default' behaviour should be moved to Koha::Email
 329             my $mail = Koha::Email->create(
 330                 {
 331                     to       => $email,
 332                     from     => $library->branchemail,
 333                     reply_to => $library->branchreplyto,
 334                     sender   => $library->branchreturnpath,
 335                     subject  => "" . $letter->{title},
 336                 }
 337             );
 338
 339             if ( $letter->{is_html} ) {
 340                 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
 341             }
 342             else {
 343                 $mail->text_body( $letter->{content} );
 344             }
 345
 346             my $success = try {
 347                 $mail->send_or_die({ transport => $library->smtp_server->transport });
 348             }
 349             catch {
 350                 # We expect ref($_) eq 'Email::Sender::Failure'
 351                 $error = $_->message;
 352
 353                 carp "$_";
 354                 return;
 355             };
 356
 357             return { error => $error }
 358                 unless $success;
 359         }
 360     }
 361     elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
 362
 363         # prepare the letter...
 364         my $strsth;
 365         my $sthorders;
 366         my $dataorders;
 367         my $action;
 368         my $basketno;
 369         if ( $type eq 'claimacquisition') {
 370             $strsth = qq{
 371             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
 372             FROM aqorders
 373             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 374             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 375             LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
 376             WHERE aqorders.ordernumber IN (
 377             };
 378
 379             if (!@$externalid){
 380                 carp "No order selected";
 381                 return { error => "no_order_selected" };
 382             }
 383             $strsth .= join( ",", ('?') x @$externalid ) . ")";
 384             $action = "ACQUISITION CLAIM";
 385             $sthorders = $dbh->prepare($strsth);
 386             $sthorders->execute( @$externalid );
 387             $dataorders = $sthorders->fetchall_arrayref( {} );
 388         }
 389
 390         if ($type eq 'claimissues') {
 391             $strsth = qq{
 392             SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
 393             aqbooksellers.id AS booksellerid
 394             FROM serial
 395             LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
 396             LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
 397             LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
 398             LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 399             WHERE serial.serialid IN (
 400             };
 401
 402             if (!@$externalid){
 403                 carp "No issues selected";
 404                 return { error => "no_issues_selected" };
 405             }
 406
 407             $strsth .= join( ",", ('?') x @$externalid ) . ")";
 408             $action = "SERIAL CLAIM";
 409             $sthorders = $dbh->prepare($strsth);
 410             $sthorders->execute( @$externalid );
 411             $dataorders = $sthorders->fetchall_arrayref( {} );
 412         }
 413
 414         if ( $type eq 'orderacquisition') {
 415             my $basketno = $externalid;
 416             $strsth = qq{
 417             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
 418             FROM aqorders
 419             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 420             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 421             LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
 422             WHERE aqbasket.basketno = ?
 423             AND orderstatus IN ('new','ordered')
 424             };
 425
 426             unless ( $basketno ) {
 427                 carp "No basketnumber given";
 428                 return { error => "no_basketno" };
 429             }
 430             $action = "ACQUISITION ORDER";
 431             $sthorders = $dbh->prepare($strsth);
 432             $sthorders->execute($basketno);
 433             $dataorders = $sthorders->fetchall_arrayref( {} );
 434         }
 435
 436         my $sthbookseller =
 437           $dbh->prepare("select * from aqbooksellers where id=?");
 438         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 439         my $databookseller = $sthbookseller->fetchrow_hashref;
 440
 441         my $addressee =  $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
 442
 443         my $sthcontact =
 444           $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
 445         $sthcontact->execute( $dataorders->[0]->{booksellerid} );
 446         my $datacontact = $sthcontact->fetchrow_hashref;
 447
 448         my @email;
 449         my @cc;
 450         push @email, $datacontact->{email}           if ( $datacontact && $datacontact->{email} );
 451         unless (@email) {
 452             warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
 453             return { error => "no_email" };
 454         }
 455         my $addlcontact;
 456         while ($addlcontact = $sthcontact->fetchrow_hashref) {
 457             push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
 458         }
 459
 460         my $userenv = C4::Context->userenv;
 461         my $letter = GetPreparedLetter (
 462             module => $type,
 463             letter_code => $letter_code,
 464             branchcode => $userenv->{branch},
 465             tables => {
 466                 'branches'      => $userenv->{branch},
 467                 'aqbooksellers' => $databookseller,
 468                 'aqcontacts'    => $datacontact,
 469                 'aqbasket'      => $basketno,
 470             },
 471             repeat => $dataorders,
 472             want_librarian => 1,
 473         ) or return { error => "no_letter" };
 474
 475         # Remove the order tag
 476         $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
 477
 478         # ... then send mail
 479         my $library = Koha::Libraries->find( $userenv->{branch} );
 480         my $mail = Koha::Email->create(
 481             {
 482                 to => join( ',', @email ),
 483                 cc => join( ',', @cc ),
 484                 (
 485                     (
 486                         C4::Context->preference("ClaimsBccCopy")
 487                           && ( $type eq 'claimacquisition'
 488                             || $type eq 'claimissues' )
 489                     )
 490                     ? ( bcc => $userenv->{emailaddress} )
 491                     : ()
 492                 ),
 493                 from => $library->branchemail
 494                   || C4::Context->preference('KohaAdminEmailAddress'),
 495                 subject => "" . $letter->{title},
 496             }
 497         );
 498
 499         if ( $letter->{is_html} ) {
 500             $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
 501         }
 502         else {
 503             $mail->text_body( "" . $letter->{content} );
 504         }
 505
 506         my $success = try {
 507             $mail->send_or_die({ transport => $library->smtp_server->transport });
 508         }
 509         catch {
 510             # We expect ref($_) eq 'Email::Sender::Failure'
 511             $error = $_->message;
 512
 513             carp "$_";
 514             return;
 515         };
 516
 517         return { error => $error }
 518             unless $success;
 519
 520         my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
 521         logaction(
 522             $module,
 523             $action,
 524             undef,
 525             "To="
 526                 . join( ',', @email )
 527                 . " Title="
 528                 . $letter->{title}
 529                 . " Content="
 530                 . $letter->{content}
 531         ) if C4::Context->preference("ClaimsLog");
 532     }
 533
 534     # If we come here, return an OK status
 535     return 1;
 536 }
 537
 538 =head2 GetPreparedLetter( %params )
 539
 540     %params hash:
 541       module => letter module, mandatory
 542       letter_code => letter code, mandatory
 543       branchcode => for letter selection, if missing default system letter taken
 544       tables => a hashref with table names as keys. Values are either:
 545         - a scalar - primary key value
 546         - an arrayref - primary key values
 547         - a hashref - full record
 548       substitute => custom substitution key/value pairs
 549       repeat => records to be substituted on consecutive lines:
 550         - an arrayref - tries to guess what needs substituting by
 551           taking remaining << >> tokensr; not recommended
 552         - a hashref token => @tables - replaces <token> << >> << >> </token>
 553           subtemplate for each @tables row; table is a hashref as above
 554       want_librarian => boolean,  if set to true triggers librarian details
 555         substitution from the userenv
 556     Return value:
 557       letter fields hashref (title & content useful)
 558
 559 =cut
 560
 561 sub GetPreparedLetter {
 562     my %params = @_;
 563
 564     my $letter = $params{letter};
 565     my $lang   = $params{lang} || 'default';
 566
 567     unless ( $letter ) {
 568         my $module      = $params{module} or croak "No module";
 569         my $letter_code = $params{letter_code} or croak "No letter_code";
 570         my $branchcode  = $params{branchcode} || '';
 571         my $mtt         = $params{message_transport_type} || 'email';
 572
 573         my $template = Koha::Notice::Templates->find_effective_template(
 574             {
 575                 module                 => $module,
 576                 code                   => $letter_code,
 577                 branchcode             => $branchcode,
 578                 message_transport_type => $mtt,
 579                 lang                   => $lang
 580             }
 581         );
 582
 583         unless ( $template ) {
 584             warn( "No $module $letter_code letter transported by " . $mtt );
 585             return;
 586         }
 587
 588         $letter = $template->unblessed;
 589         $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
 590     }
 591
 592     my $objects = $params{objects} || {};
 593     my $tables = $params{tables} || {};
 594     my $substitute = $params{substitute} || {};
 595     my $loops  = $params{loops} || {}; # loops is not supported for historical notices syntax
 596     my $repeat = $params{repeat};
 597     %$tables || %$substitute || $repeat || %$loops || %$objects
 598       or carp( "ERROR: nothing to substitute - all of 'objects', 'tables', 'loops' and 'substitute' are empty" ),
 599          return;
 600     my $want_librarian = $params{want_librarian};
 601
 602     if (%$substitute) {
 603         while ( my ($token, $val) = each %$substitute ) {
 604             $val //= q{};
 605             if ( $token eq 'items.content' ) {
 606                 $val =~ s|\n|<br/>|g if $letter->{is_html};
 607             }
 608
 609             $letter->{title} =~ s/<<$token>>/$val/g;
 610             $letter->{content} =~ s/<<$token>>/$val/g;
 611        }
 612     }
 613
 614     my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
 615     $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
 616
 617     if ($want_librarian) {
 618         # parsing librarian name
 619         my $userenv = C4::Context->userenv;
 620         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
 621         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
 622         $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
 623     }
 624
 625     my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
 626
 627     if ($repeat) {
 628         if (ref ($repeat) eq 'ARRAY' ) {
 629             $repeat_no_enclosing_tags = $repeat;
 630         } else {
 631             $repeat_enclosing_tags = $repeat;
 632         }
 633     }
 634
 635     if ($repeat_enclosing_tags) {
 636         while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
 637             if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
 638                 my $subcontent = $1;
 639                 my @lines = map {
 640                     my %subletter = ( title => '', content => $subcontent );
 641                     _substitute_tables( \%subletter, $_ );
 642                     $subletter{content};
 643                 } @$tag_tables;
 644                 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
 645             }
 646         }
 647     }
 648
 649     if (%$tables) {
 650         _substitute_tables( $letter, $tables );
 651     }
 652
 653     if ($repeat_no_enclosing_tags) {
 654         if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
 655             my $line = $&;
 656             my $i = 1;
 657             my @lines = map {
 658                 my $c = $line;
 659                 $c =~ s/<<count>>/$i/go;
 660                 foreach my $field ( keys %{$_} ) {
 661                     $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
 662                 }
 663                 $i++;
 664                 $c;
 665             } @$repeat_no_enclosing_tags;
 666
 667             my $replaceby = join( "\n", @lines );
 668             $letter->{content} =~ s/\Q$line\E/$replaceby/s;
 669         }
 670     }
 671
 672     $letter->{content} = _process_tt(
 673         {
 674             content    => $letter->{content},
 675             lang       => $lang,
 676             loops      => $loops,
 677             objects    => $objects,
 678             substitute => $substitute,
 679             tables     => $tables,
 680         }
 681     );
 682
 683     $letter->{title} = _process_tt(
 684         {
 685             content    => $letter->{title},
 686             lang       => $lang,
 687             loops      => $loops,
 688             objects    => $objects,
 689             substitute => $substitute,
 690             tables     => $tables,
 691         }
 692     );
 693
 694     $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
 695
 696     return $letter;
 697 }
 698
 699 sub _substitute_tables {
 700     my ( $letter, $tables ) = @_;
 701     while ( my ($table, $param) = each %$tables ) {
 702         next unless $param;
 703
 704         my $ref = ref $param;
 705
 706         my $values;
 707         if ($ref && $ref eq 'HASH') {
 708             $values = $param;
 709         }
 710         else {
 711             my $sth = _parseletter_sth($table);
 712             unless ($sth) {
 713                 warn "_parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 714                 return;
 715             }
 716             $sth->execute( $ref ? @$param : $param );
 717
 718             $values = $sth->fetchrow_hashref;
 719             $sth->finish();
 720         }
 721
 722         _parseletter ( $letter, $table, $values );
 723     }
 724 }
 725
 726 sub _parseletter_sth {
 727     my $table = shift;
 728     my $sth;
 729     unless ($table) {
 730         carp "ERROR: _parseletter_sth() called without argument (table)";
 731         return;
 732     }
 733     # NOTE: we used to check whether we had a statement handle cached in
 734     #       a %handles module-level variable. This was a dumb move and
 735     #       broke things for the rest of us. prepare_cached is a better
 736     #       way to cache statement handles anyway.
 737     my $query =
 738     ($table eq 'accountlines' )    ? "SELECT * FROM $table WHERE   accountlines_id = ?"                               :
 739     ($table eq 'biblio'       )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
 740     ($table eq 'biblioitems'  )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
 741     ($table eq 'credits'      )    ? "SELECT * FROM accountlines WHERE   accountlines_id = ?"                         :
 742     ($table eq 'debits'       )    ? "SELECT * FROM accountlines WHERE   accountlines_id = ?"                         :
 743     ($table eq 'items'        )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 744     ($table eq 'issues'       )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 745     ($table eq 'old_issues'   )    ? "SELECT * FROM $table WHERE     issue_id = ?"  :
 746     ($table eq 'reserves'     )    ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?"             :
 747     ($table eq 'borrowers'    )    ? "SELECT * FROM $table WHERE borrowernumber = ?"                                  :
 748     ($table eq 'branches'     )    ? "SELECT * FROM $table WHERE     branchcode = ?"                                  :
 749     ($table eq 'suggestions'  )    ? "SELECT * FROM $table WHERE   suggestionid = ?"                                  :
 750     ($table eq 'aqbooksellers')    ? "SELECT * FROM $table WHERE             id = ?"                                  :
 751     ($table eq 'aqorders'     )    ? "SELECT * FROM $table WHERE    ordernumber = ?"                                  :
 752     ($table eq 'aqbasket'     )    ? "SELECT * FROM $table WHERE       basketno = ?"                                  :
 753     ($table eq 'illrequests'  )    ? "SELECT * FROM $table WHERE  illrequest_id = ?"                                  :
 754     ($table eq 'article_requests') ? "SELECT * FROM $table WHERE             id = ?"                                  :
 755     ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
 756     ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
 757     ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
 758     ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
 759     ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
 760     ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
 761     undef ;
 762     unless ($query) {
 763         warn "ERROR: No _parseletter_sth query for table '$table'";
 764         return;     # nothing to get
 765     }
 766     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
 767         warn "ERROR: Failed to prepare query: '$query'";
 768         return;
 769     }
 770     return $sth;    # now cache is populated for that $table
 771 }
 772
 773 =head2 _parseletter($letter, $table, $values)
 774
 775     parameters :
 776     - $letter : a hash to letter fields (title & content useful)
 777     - $table : the Koha table to parse.
 778     - $values_in : table record hashref
 779     parse all fields from a table, and replace values in title & content with the appropriate value
 780     (not exported sub, used only internally)
 781
 782 =cut
 783
 784 sub _parseletter {
 785     my ( $letter, $table, $values_in ) = @_;
 786
 787     # Work on a local copy of $values_in (passed by reference) to avoid side effects
 788     # in callers ( by changing / formatting values )
 789     my $values = $values_in ? { %$values_in } : {};
 790
 791     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
 792         $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
 793     }
 794
 795     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 796         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
 797     }
 798
 799     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
 800         my $todaysdate = output_pref( dt_from_string() );
 801         $letter->{content} =~ s/<<today>>/$todaysdate/go;
 802     }
 803
 804     while ( my ($field, $val) = each %$values ) {
 805         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
 806             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
 807             #Therefore adding the test on biblio. This includes biblioitems,
 808             #but excludes items. Removed unneeded global and lookahead.
 809
 810         if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
 811             my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
 812             $val = $av->count ? $av->next->lib : '';
 813         }
 814
 815         # Dates replacement
 816         my $replacedby   = defined ($val) ? $val : '';
 817         if (    $replacedby
 818             and not $replacedby =~ m|9999-12-31|
 819             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
 820         {
 821             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
 822             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
 823             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
 824
 825             for my $letter_field ( qw( title content ) ) {
 826                 my $filter_string_used = q{};
 827                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
 828                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
 829                     $filter_string_used = $1 || q{};
 830                     $dateonly = $1 unless $dateonly;
 831                 }
 832                 my $replacedby_date = eval {
 833                     output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
 834                 };
 835                 $replacedby_date //= q{};
 836
 837                 if ( $letter->{ $letter_field } ) {
 838                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
 839                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
 840                 }
 841             }
 842         }
 843         # Other fields replacement
 844         else {
 845             for my $letter_field ( qw( title content ) ) {
 846                 if ( $letter->{ $letter_field } ) {
 847                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
 848                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
 849                 }
 850             }
 851         }
 852     }
 853
 854     if ($table eq 'borrowers' && $letter->{content}) {
 855         my $patron = Koha::Patrons->find( $values->{borrowernumber} );
 856         if ( $patron ) {
 857             my $attributes = $patron->extended_attributes;
 858             my %attr;
 859             while ( my $attribute = $attributes->next ) {
 860                 my $code = $attribute->code;
 861                 my $val  = $attribute->description; # FIXME - we always display intranet description here!
 862                 $val =~ s/\p{P}(?=$)//g if $val;
 863                 next unless $val gt '';
 864                 $attr{$code} ||= [];
 865                 push @{ $attr{$code} }, $val;
 866             }
 867             while ( my ($code, $val_ar) = each %attr ) {
 868                 my $replacefield = "<<borrower-attribute:$code>>";
 869                 my $replacedby   = join ',', @$val_ar;
 870                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 871             }
 872         }
 873     }
 874     return $letter;
 875 }
 876
 877 =head2 EnqueueLetter
 878
 879   my $success = EnqueueLetter( { letter => $letter,
 880         borrowernumber => '12', message_transport_type => 'email' } )
 881
 882 Places a letter in the message_queue database table, which will
 883 eventually get processed (sent) by the process_message_queue.pl
 884 cronjob when it calls SendQueuedMessages.
 885
 886 Return message_id on success
 887
 888 Parameters
 889 * letter - required; A letter hashref as returned from GetPreparedLetter
 890 * message_transport_type - required; One of the available mtts
 891 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
 892 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
 893 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
 894 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
 895
 896 =cut
 897
 898 sub EnqueueLetter {
 899     my $params = shift or return;
 900
 901     return unless exists $params->{'letter'};
 902 #   return unless exists $params->{'borrowernumber'};
 903     return unless exists $params->{'message_transport_type'};
 904
 905     my $content = $params->{letter}->{content};
 906     $content =~ s/\s+//g if(defined $content);
 907     if ( not defined $content or $content eq '' ) {
 908         Koha::Logger->get->info("Trying to add an empty message to the message queue");
 909         return;
 910     }
 911
 912     # If we have any attachments we should encode then into the body.
 913     if ( $params->{'attachments'} ) {
 914         $params->{'letter'} = _add_attachments(
 915             {   letter      => $params->{'letter'},
 916                 attachments => $params->{'attachments'},
 917             }
 918         );
 919     }
 920
 921     my $dbh       = C4::Context->dbh();
 922     my $statement = << 'ENDSQL';
 923 INSERT INTO message_queue
 924 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
 925 VALUES
 926 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      CAST(NOW() AS DATETIME),       ?,          ?,            ?,           ?,              ? )
 927 ENDSQL
 928
 929     my $sth    = $dbh->prepare($statement);
 930     my $result = $sth->execute(
 931         $params->{'borrowernumber'},              # borrowernumber
 932         $params->{'letter'}->{'title'},           # subject
 933         $params->{'letter'}->{'content'},         # content
 934         $params->{'letter'}->{'metadata'} || '',  # metadata
 935         $params->{'letter'}->{'code'}     || '',  # letter_code
 936         $params->{'message_transport_type'},      # message_transport_type
 937         'pending',                                # status
 938         $params->{'to_address'},                  # to_address
 939         $params->{'from_address'},                # from_address
 940         $params->{'reply_address'},               # reply_address
 941         $params->{'letter'}->{'content-type'},    # content_type
 942         $params->{'failure_code'}        || '',   # failure_code
 943     );
 944     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 945 }
 946
 947 =head2 SendQueuedMessages ([$hashref])
 948
 949     my $sent = SendQueuedMessages({
 950         letter_code => $letter_code,
 951         borrowernumber => $who_letter_is_for,
 952         limit => 50,
 953         verbose => 1,
 954         type => 'sms',
 955     });
 956
 957 Sends all of the 'pending' items in the message queue, unless
 958 parameters are passed.
 959
 960 The letter_code, borrowernumber and limit parameters are used
 961 to build a parameter set for _get_unsent_messages, thus limiting
 962 which pending messages will be processed. They are all optional.
 963
 964 The verbose parameter can be used to generate debugging output.
 965 It is also optional.
 966
 967 Returns number of messages sent.
 968
 969 =cut
 970
 971 sub SendQueuedMessages {
 972     my $params = shift;
 973
 974     my $which_unsent_messages  = {
 975         'message_id'     => $params->{'message_id'},
 976         'limit'          => $params->{'limit'} // 0,
 977         'borrowernumber' => $params->{'borrowernumber'} // q{},
 978         'letter_code'    => $params->{'letter_code'} // q{},
 979         'type'           => $params->{'type'} // q{},
 980     };
 981     my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
 982     MESSAGE: foreach my $message ( @$unsent_messages ) {
 983         my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
 984         # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
 985         $message_object->make_column_dirty('status');
 986         return unless $message_object->store;
 987
 988         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 989         warn sprintf( 'sending %s message to patron: %s',
 990                       $message->{'message_transport_type'},
 991                       $message->{'borrowernumber'} || 'Admin' )
 992           if $params->{'verbose'};
 993         # This is just begging for subclassing
 994         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 995         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 996             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 997         }
 998         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 999             if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1000                 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1001                 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1002                 unless ( $sms_provider ) {
1003                     warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1004                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1005                     next MESSAGE;
1006                 }
1007                 unless ( $patron->smsalertnumber ) {
1008                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1009                     warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1010                     next MESSAGE;
1011                 }
1012                 $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1013                 $message->{to_address} .= '@' . $sms_provider->domain();
1014
1015                 # Check for possible from_address override
1016                 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1017                 if ($from_address && $message->{from_address} ne $from_address) {
1018                     $message->{from_address} = $from_address;
1019                     _update_message_from_address($message->{'message_id'}, $message->{from_address});
1020                 }
1021
1022                 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1023                 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1024             } else {
1025                 _send_message_by_sms( $message );
1026             }
1027         }
1028     }
1029     return scalar( @$unsent_messages );
1030 }
1031
1032 =head2 GetRSSMessages
1033
1034   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1035
1036 returns a listref of all queued RSS messages for a particular person.
1037
1038 =cut
1039
1040 sub GetRSSMessages {
1041     my $params = shift;
1042
1043     return unless $params;
1044     return unless ref $params;
1045     return unless $params->{'borrowernumber'};
1046
1047     return _get_unsent_messages( { message_transport_type => 'rss',
1048                                    limit                  => $params->{'limit'},
1049                                    borrowernumber         => $params->{'borrowernumber'}, } );
1050 }
1051
1052 =head2 GetPrintMessages
1053
1054   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1055
1056 Returns a arrayref of all queued print messages (optionally, for a particular
1057 person).
1058
1059 =cut
1060
1061 sub GetPrintMessages {
1062     my $params = shift || {};
1063
1064     return _get_unsent_messages( { message_transport_type => 'print',
1065                                    borrowernumber         => $params->{'borrowernumber'},
1066                                  } );
1067 }
1068
1069 =head2 GetQueuedMessages ([$hashref])
1070
1071   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1072
1073 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1074 and limited to specified limit.
1075
1076 Return is an arrayref of hashes, each has represents a message in the message queue.
1077
1078 =cut
1079
1080 sub GetQueuedMessages {
1081     my $params = shift;
1082
1083     my $dbh = C4::Context->dbh();
1084     my $statement = << 'ENDSQL';
1085 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1086 FROM message_queue
1087 ENDSQL
1088
1089     my @query_params;
1090     my @whereclauses;
1091     if ( exists $params->{'borrowernumber'} ) {
1092         push @whereclauses, ' borrowernumber = ? ';
1093         push @query_params, $params->{'borrowernumber'};
1094     }
1095
1096     if ( @whereclauses ) {
1097         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1098     }
1099
1100     if ( defined $params->{'limit'} ) {
1101         $statement .= ' LIMIT ? ';
1102         push @query_params, $params->{'limit'};
1103     }
1104
1105     my $sth = $dbh->prepare( $statement );
1106     my $result = $sth->execute( @query_params );
1107     return $sth->fetchall_arrayref({});
1108 }
1109
1110 =head2 GetMessageTransportTypes
1111
1112   my @mtt = GetMessageTransportTypes();
1113
1114   returns an arrayref of transport types
1115
1116 =cut
1117
1118 sub GetMessageTransportTypes {
1119     my $dbh = C4::Context->dbh();
1120     my $mtts = $dbh->selectcol_arrayref("
1121         SELECT message_transport_type
1122         FROM message_transport_types
1123         ORDER BY message_transport_type
1124     ");
1125     return $mtts;
1126 }
1127
1128 =head2 GetMessage
1129
1130     my $message = C4::Letters::Message($message_id);
1131
1132 =cut
1133
1134 sub GetMessage {
1135     my ( $message_id ) = @_;
1136     return unless $message_id;
1137     my $dbh = C4::Context->dbh;
1138     return $dbh->selectrow_hashref(q|
1139         SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, failure_code
1140         FROM message_queue
1141         WHERE message_id = ?
1142     |, {}, $message_id );
1143 }
1144
1145 =head2 ResendMessage
1146
1147   Attempt to resend a message which has failed previously.
1148
1149   my $has_been_resent = C4::Letters::ResendMessage($message_id);
1150
1151   Updates the message to 'pending' status so that
1152   it will be resent later on.
1153
1154   returns 1 on success, 0 on failure, undef if no message was found
1155
1156 =cut
1157
1158 sub ResendMessage {
1159     my $message_id = shift;
1160     return unless $message_id;
1161
1162     my $message = GetMessage( $message_id );
1163     return unless $message;
1164     my $rv = 0;
1165     if ( $message->{status} ne 'pending' ) {
1166         $rv = C4::Letters::_set_message_status({
1167             message_id => $message_id,
1168             status => 'pending',
1169         });
1170         $rv = $rv > 0? 1: 0;
1171         # Clear destination email address to force address update
1172         _update_message_to_address( $message_id, undef ) if $rv &&
1173             $message->{message_transport_type} eq 'email';
1174     }
1175     return $rv;
1176 }
1177
1178 =head2 _add_attachements
1179
1180   _add_attachments({ letter => $letter, attachments => $attachments });
1181
1182   named parameters:
1183   letter - the standard letter hashref
1184   attachments - listref of attachments. each attachment is a hashref of:
1185     type - the mime type, like 'text/plain'
1186     content - the actual attachment
1187     filename - the name of the attachment.
1188
1189   returns your letter object, with the content updated.
1190   This routine picks the I<content> of I<letter> and generates a MIME
1191   email, attaching the passed I<attachments> using Koha::Email. The
1192   content is replaced by the string representation of the MIME object,
1193   and the content-type is updated for later handling.
1194
1195 =cut
1196
1197 sub _add_attachments {
1198     my $params = shift;
1199
1200     my $letter = $params->{letter};
1201     my $attachments = $params->{attachments};
1202     return $letter unless @$attachments;
1203
1204     my $message = Koha::Email->new;
1205
1206     if ( $letter->{is_html} ) {
1207         $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1208     }
1209     else {
1210         $message->text_body( $letter->{content} );
1211     }
1212
1213     foreach my $attachment ( @$attachments ) {
1214         $message->attach(
1215             Encode::encode( "UTF-8", $attachment->{content} ),
1216             content_type => $attachment->{type} || 'application/octet-stream',
1217             name         => $attachment->{filename},
1218             disposition  => 'attachment',
1219         );
1220     }
1221
1222     $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1223     $letter->{content} = $message->as_string;
1224
1225     return $letter;
1226
1227 }
1228
1229 =head2 _get_unsent_messages
1230
1231   This function's parameter hash reference takes the following
1232   optional named parameters:
1233    message_transport_type: method of message sending (e.g. email, sms, etc.)
1234    borrowernumber        : who the message is to be sent
1235    letter_code           : type of message being sent (e.g. PASSWORD_RESET)
1236    message_id            : the message_id of the message. In that case the sub will return only 1 result
1237    limit                 : maximum number of messages to send
1238
1239   This function returns an array of matching hash referenced rows from
1240   message_queue with some borrower information added.
1241
1242 =cut
1243
1244 sub _get_unsent_messages {
1245     my $params = shift;
1246
1247     my $dbh = C4::Context->dbh();
1248     my $statement = qq{
1249         SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.failure_code
1250         FROM message_queue mq
1251         LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1252         WHERE status = ?
1253     };
1254
1255     my @query_params = ('pending');
1256     if ( ref $params ) {
1257         if ( $params->{'message_transport_type'} ) {
1258             $statement .= ' AND mq.message_transport_type = ? ';
1259             push @query_params, $params->{'message_transport_type'};
1260         }
1261         if ( $params->{'borrowernumber'} ) {
1262             $statement .= ' AND mq.borrowernumber = ? ';
1263             push @query_params, $params->{'borrowernumber'};
1264         }
1265         if ( $params->{'letter_code'} ) {
1266             $statement .= ' AND mq.letter_code = ? ';
1267             push @query_params, $params->{'letter_code'};
1268         }
1269         if ( $params->{'type'} ) {
1270             $statement .= ' AND message_transport_type = ? ';
1271             push @query_params, $params->{'type'};
1272         }
1273         if ( $params->{message_id} ) {
1274             $statement .= ' AND message_id = ?';
1275             push @query_params, $params->{message_id};
1276         }
1277         if ( $params->{'limit'} ) {
1278             $statement .= ' limit ? ';
1279             push @query_params, $params->{'limit'};
1280         }
1281     }
1282
1283     my $sth = $dbh->prepare( $statement );
1284     my $result = $sth->execute( @query_params );
1285     return $sth->fetchall_arrayref({});
1286 }
1287
1288 sub _send_message_by_email {
1289     my $message = shift or return;
1290     my ($username, $password, $method) = @_;
1291
1292     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1293     my $to_address = $message->{'to_address'};
1294     unless ($to_address) {
1295         unless ($patron) {
1296             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1297             _set_message_status(
1298                 {
1299                     message_id   => $message->{'message_id'},
1300                     status       => 'failed',
1301                     failure_code => 'INVALID_BORNUMBER'
1302                 }
1303             );
1304             return;
1305         }
1306         $to_address = $patron->notice_email_address;
1307         unless ($to_address) {
1308             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1309             # warning too verbose for this more common case?
1310             _set_message_status(
1311                 {
1312                     message_id   => $message->{'message_id'},
1313                     status       => 'failed',
1314                     failure_code => 'NO_EMAIL'
1315                 }
1316             );
1317             return;
1318         }
1319     }
1320
1321     my $subject = $message->{'subject'};
1322
1323     my $content = $message->{'content'};
1324     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1325     my $is_html = $content_type =~ m/html/io;
1326
1327     my $branch_email = undef;
1328     my $branch_replyto = undef;
1329     my $branch_returnpath = undef;
1330     my $library;
1331
1332     if ($patron) {
1333         $library           = $patron->library;
1334         $branch_email      = $library->from_email_address;
1335         $branch_replyto    = $library->branchreplyto;
1336         $branch_returnpath = $library->branchreturnpath;
1337     }
1338
1339     # NOTE: Patron may not be defined above so branch_email may be undefined still
1340     # so we need to fallback to KohaAdminEmailAddress as a last resort.
1341     my $from_address =
1342          $message->{'from_address'}
1343       || $branch_email
1344       || C4::Context->preference('KohaAdminEmailAddress');
1345     if( !$from_address ) {
1346         _set_message_status(
1347             {
1348                 message_id   => $message->{'message_id'},
1349                 status       => 'failed',
1350                 failure_code => 'NO_FROM',
1351             }
1352         );
1353         return;
1354     };
1355     my $email;
1356
1357     try {
1358
1359         my $params = {
1360             to => $to_address,
1361             (
1362                 C4::Context->preference('NoticeBcc')
1363                 ? ( bcc => C4::Context->preference('NoticeBcc') )
1364                 : ()
1365             ),
1366             from     => $from_address,
1367             reply_to => $message->{'reply_address'} || $branch_replyto,
1368             sender   => $branch_returnpath,
1369             subject  => "" . $message->{subject}
1370         };
1371
1372         if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1373
1374             # The message has been previously composed as a valid MIME object
1375             # and serialized as a string on the DB
1376             $email = Koha::Email->new_from_string($content);
1377             $email->create($params);
1378         } else {
1379             $email = Koha::Email->create($params);
1380             if ($is_html) {
1381                 $email->html_body( _wrap_html( $content, $subject ) );
1382             } else {
1383                 $email->text_body($content);
1384             }
1385         }
1386     }
1387     catch {
1388         if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1389             _set_message_status(
1390                 {
1391                     message_id   => $message->{'message_id'},
1392                     status       => 'failed',
1393                     failure_code => "INVALID_EMAIL:".$_->parameter
1394                 }
1395             );
1396         } else {
1397             _set_message_status(
1398                 {
1399                     message_id   => $message->{'message_id'},
1400                     status       => 'failed',
1401                     failure_code => 'UNKNOWN_ERROR'
1402                 }
1403             );
1404         }
1405         return 0;
1406     };
1407     return unless $email;
1408
1409     my $smtp_server;
1410     if ( $library ) {
1411         $smtp_server = $library->smtp_server;
1412     }
1413     else {
1414         $smtp_server = Koha::SMTP::Servers->get_default;
1415     }
1416
1417     if ( $username ) {
1418         $smtp_server->set(
1419             {
1420                 sasl_username => $username,
1421                 sasl_password => $password,
1422             }
1423         );
1424     }
1425
1426 # if initial message address was empty, coming here means that a to address was found and
1427 # queue should be updated; same if to address was overriden by Koha::Email->create
1428     _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1429       if !$message->{to_address}
1430       || $message->{to_address} ne $email->email->header('To');
1431
1432     try {
1433         $email->send_or_die({ transport => $smtp_server->transport });
1434
1435         _set_message_status(
1436             {
1437                 message_id => $message->{'message_id'},
1438                 status     => 'sent',
1439                 failure_code => ''
1440             }
1441         );
1442         return 1;
1443     }
1444     catch {
1445         _set_message_status(
1446             {
1447                 message_id => $message->{'message_id'},
1448                 status     => 'failed',
1449                 failure_code => 'SENDMAIL'
1450             }
1451         );
1452         carp "$_";
1453         carp "$Mail::Sendmail::error";
1454         return;
1455     };
1456 }
1457
1458 sub _wrap_html {
1459     my ($content, $title) = @_;
1460
1461     my $css = C4::Context->preference("NoticeCSS") || '';
1462     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1463     return <<EOS;
1464 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1465     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1466 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1467 <head>
1468 <title>$title</title>
1469 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1470 $css
1471 </head>
1472 <body>
1473 $content
1474 </body>
1475 </html>
1476 EOS
1477 }
1478
1479 sub _is_duplicate {
1480     my ( $message ) = @_;
1481     my $dbh = C4::Context->dbh;
1482     my $count = $dbh->selectrow_array(q|
1483         SELECT COUNT(*)
1484         FROM message_queue
1485         WHERE message_transport_type = ?
1486         AND borrowernumber = ?
1487         AND letter_code = ?
1488         AND CAST(updated_on AS date) = CAST(NOW() AS date)
1489         AND status="sent"
1490         AND content = ?
1491     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1492     return $count;
1493 }
1494
1495 sub _send_message_by_sms {
1496     my $message = shift or return;
1497     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1498     _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1499
1500     unless ( $patron and $patron->smsalertnumber ) {
1501         _set_message_status( { message_id => $message->{'message_id'},
1502                                status     => 'failed',
1503                                failure_code => 'MISSING_SMS' } );
1504         return;
1505     }
1506
1507     if ( _is_duplicate( $message ) ) {
1508         _set_message_status(
1509             {
1510                 message_id   => $message->{'message_id'},
1511                 status       => 'failed',
1512                 failure_code => 'DUPLICATE_MESSAGE'
1513             }
1514         );
1515         return;
1516     }
1517
1518     my $success = C4::SMS->send_sms(
1519         {
1520             destination => $patron->smsalertnumber,
1521             message     => $message->{'content'},
1522         }
1523     );
1524
1525     if ($success) {
1526         _set_message_status(
1527             {
1528                 message_id   => $message->{'message_id'},
1529                 status       => 'sent',
1530                 failure_code => ''
1531             }
1532         );
1533     }
1534     else {
1535         _set_message_status(
1536             {
1537                 message_id   => $message->{'message_id'},
1538                 status       => 'failed',
1539                 failure_code => 'NO_NOTES'
1540             }
1541         );
1542     }
1543
1544     return $success;
1545 }
1546
1547 sub _update_message_to_address {
1548     my ($id, $to)= @_;
1549     my $dbh = C4::Context->dbh();
1550     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1551 }
1552
1553 sub _update_message_from_address {
1554     my ($message_id, $from_address) = @_;
1555     my $dbh = C4::Context->dbh();
1556     $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1557 }
1558
1559 sub _set_message_status {
1560     my $params = shift or return;
1561
1562     foreach my $required_parameter ( qw( message_id status ) ) {
1563         return unless exists $params->{ $required_parameter };
1564     }
1565
1566     my $dbh = C4::Context->dbh();
1567     my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1568     my $sth = $dbh->prepare( $statement );
1569     my $result = $sth->execute( $params->{'status'},
1570                                 $params->{'failure_code'} || '',
1571                                 $params->{'message_id'} );
1572     return $result;
1573 }
1574
1575 sub _process_tt {
1576     my ( $params ) = @_;
1577
1578     my $content    = $params->{content};
1579     my $tables     = $params->{tables};
1580     my $loops      = $params->{loops};
1581     my $objects    = $params->{objects};
1582     my $substitute = $params->{substitute} || {};
1583     my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1584     my ($theme, $availablethemes);
1585
1586     my $htdocs = C4::Context->config('intrahtdocs');
1587     ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1588     my @includes;
1589     foreach (@$availablethemes) {
1590         push @includes, "$htdocs/$_/$lang/includes";
1591         push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1592     }
1593
1594     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1595     my $template           = Template->new(
1596         {
1597             EVAL_PERL    => 1,
1598             ABSOLUTE     => 1,
1599             PLUGIN_BASE  => 'Koha::Template::Plugin',
1600             COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
1601             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1602             INCLUDE_PATH => \@includes,
1603             FILTERS      => {},
1604             ENCODING     => 'UTF-8',
1605         }
1606     ) or die Template->error();
1607
1608     my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1609
1610     $content = add_tt_filters( $content );
1611     $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1612
1613     if ( $content =~ m|\[% otp_token %\]| ) {
1614         my $patron = Koha::Patrons->find(C4::Context->userenv->{number});
1615         $tt_params->{otp_token} = Koha::Auth::TwoFactorAuth->new({patron => $patron})->code;
1616     }
1617
1618     my $output;
1619     my $schema = Koha::Database->new->schema;
1620     $schema->txn_begin;
1621     $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1622     $schema->txn_rollback;
1623
1624     return $output;
1625 }
1626
1627 sub _get_tt_params {
1628     my ($tables, $is_a_loop) = @_;
1629
1630     my $params;
1631     $is_a_loop ||= 0;
1632
1633     my $config = {
1634         article_requests => {
1635             module   => 'Koha::ArticleRequests',
1636             singular => 'article_request',
1637             plural   => 'article_requests',
1638             pk       => 'id',
1639         },
1640         aqbasket => {
1641             module   => 'Koha::Acquisition::Baskets',
1642             singular => 'basket',
1643             plural   => 'baskets',
1644             pk       => 'basketno',
1645         },
1646         biblio => {
1647             module   => 'Koha::Biblios',
1648             singular => 'biblio',
1649             plural   => 'biblios',
1650             pk       => 'biblionumber',
1651         },
1652         biblioitems => {
1653             module   => 'Koha::Biblioitems',
1654             singular => 'biblioitem',
1655             plural   => 'biblioitems',
1656             pk       => 'biblioitemnumber',
1657         },
1658         borrowers => {
1659             module   => 'Koha::Patrons',
1660             singular => 'borrower',
1661             plural   => 'borrowers',
1662             pk       => 'borrowernumber',
1663         },
1664         branches => {
1665             module   => 'Koha::Libraries',
1666             singular => 'branch',
1667             plural   => 'branches',
1668             pk       => 'branchcode',
1669         },
1670         credits => {
1671             module => 'Koha::Account::Lines',
1672             singular => 'credit',
1673             plural => 'credits',
1674             pk => 'accountlines_id',
1675         },
1676         debits => {
1677             module => 'Koha::Account::Lines',
1678             singular => 'debit',
1679             plural => 'debits',
1680             pk => 'accountlines_id',
1681         },
1682         items => {
1683             module   => 'Koha::Items',
1684             singular => 'item',
1685             plural   => 'items',
1686             pk       => 'itemnumber',
1687         },
1688         additional_contents => {
1689             module   => 'Koha::AdditionalContents',
1690             singular => 'additional_content',
1691             plural   => 'additional_contents',
1692             pk       => 'idnew',
1693         },
1694         opac_news => {
1695             module   => 'Koha::AdditionalContents',
1696             singular => 'news',
1697             plural   => 'news',
1698             pk       => 'idnew',
1699         },
1700         aqorders => {
1701             module   => 'Koha::Acquisition::Orders',
1702             singular => 'order',
1703             plural   => 'orders',
1704             pk       => 'ordernumber',
1705         },
1706         reserves => {
1707             module   => 'Koha::Holds',
1708             singular => 'hold',
1709             plural   => 'holds',
1710             pk       => 'reserve_id',
1711         },
1712         serial => {
1713             module   => 'Koha::Serials',
1714             singular => 'serial',
1715             plural   => 'serials',
1716             pk       => 'serialid',
1717         },
1718         subscription => {
1719             module   => 'Koha::Subscriptions',
1720             singular => 'subscription',
1721             plural   => 'subscriptions',
1722             pk       => 'subscriptionid',
1723         },
1724         suggestions => {
1725             module   => 'Koha::Suggestions',
1726             singular => 'suggestion',
1727             plural   => 'suggestions',
1728             pk       => 'suggestionid',
1729         },
1730         issues => {
1731             module   => 'Koha::Checkouts',
1732             singular => 'checkout',
1733             plural   => 'checkouts',
1734             fk       => 'itemnumber',
1735         },
1736         old_issues => {
1737             module   => 'Koha::Old::Checkouts',
1738             singular => 'old_checkout',
1739             plural   => 'old_checkouts',
1740             pk       => 'issue_id',
1741         },
1742         overdues => {
1743             module   => 'Koha::Checkouts',
1744             singular => 'overdue',
1745             plural   => 'overdues',
1746             fk       => 'itemnumber',
1747         },
1748         borrower_modifications => {
1749             module   => 'Koha::Patron::Modifications',
1750             singular => 'patron_modification',
1751             plural   => 'patron_modifications',
1752             fk       => 'verification_token',
1753         },
1754         illrequests => {
1755             module   => 'Koha::Illrequests',
1756             singular => 'illrequest',
1757             plural   => 'illrequests',
1758             pk       => 'illrequest_id'
1759         }
1760     };
1761
1762     foreach my $table ( keys %$tables ) {
1763         next unless $config->{$table};
1764
1765         my $ref = ref( $tables->{$table} ) || q{};
1766         my $module = $config->{$table}->{module};
1767
1768         if ( can_load( modules => { $module => undef } ) ) {
1769             my $pk = $config->{$table}->{pk};
1770             my $fk = $config->{$table}->{fk};
1771
1772             if ( $is_a_loop ) {
1773                 my $values = $tables->{$table} || [];
1774                 unless ( ref( $values ) eq 'ARRAY' ) {
1775                     croak "ERROR processing table $table. Wrong API call.";
1776                 }
1777                 my $key = $pk ? $pk : $fk;
1778                 # $key does not come from user input
1779                 my $objects = $module->search(
1780                     { $key => $values },
1781                     {
1782                             # We want to retrieve the data in the same order
1783                             # FIXME MySQLism
1784                             # field is a MySQLism, but they are no other way to do it
1785                             # To be generic we could do it in perl, but we will need to fetch
1786                             # all the data then order them
1787                         @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1788                     }
1789                 );
1790                 $params->{ $config->{$table}->{plural} } = $objects;
1791             }
1792             elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1793                 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1794                 my $object;
1795                 if ( $fk ) { # Using a foreign key for lookup
1796                     if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1797                         my $search;
1798                         foreach my $key ( @$fk ) {
1799                             $search->{$key} = $id->{$key};
1800                         }
1801                         $object = $module->search( $search )->last();
1802                     } else { # Foreign key is single column
1803                         $object = $module->search( { $fk => $id } )->last();
1804                     }
1805                 } else { # using the table's primary key for lookup
1806                     $object = $module->find($id);
1807                 }
1808                 $params->{ $config->{$table}->{singular} } = $object;
1809             }
1810             else {    # $ref eq 'ARRAY'
1811                 my $object;
1812                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
1813                     $object = $module->search( { $pk => $tables->{$table} } )->last();
1814                 }
1815                 else {                                  # Params are mutliple foreign keys
1816                     croak "Multiple foreign keys (table $table) should be passed using an hashref";
1817                 }
1818                 $params->{ $config->{$table}->{singular} } = $object;
1819             }
1820         }
1821         else {
1822             croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1823         }
1824     }
1825
1826     $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1827
1828     return $params;
1829 }
1830
1831 =head3 add_tt_filters
1832
1833 $content = add_tt_filters( $content );
1834
1835 Add TT filters to some specific fields if needed.
1836
1837 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1838
1839 =cut
1840
1841 sub add_tt_filters {
1842     my ( $content ) = @_;
1843     $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1844     $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1845     return $content;
1846 }
1847
1848 =head2 get_item_content
1849
1850     my $item = Koha::Items->find(...)->unblessed;
1851     my @item_content_fields = qw( date_due title barcode author itemnumber );
1852     my $item_content = C4::Letters::get_item_content({
1853                              item => $item,
1854                              item_content_fields => \@item_content_fields
1855                        });
1856
1857 This function generates a tab-separated list of values for the passed item. Dates
1858 are formatted following the current setup.
1859
1860 =cut
1861
1862 sub get_item_content {
1863     my ( $params ) = @_;
1864     my $item = $params->{item};
1865     my $dateonly = $params->{dateonly} || 0;
1866     my $item_content_fields = $params->{item_content_fields} || [];
1867
1868     return unless $item;
1869
1870     my @item_info = map {
1871         $_ =~ /^date|date$/
1872           ? eval {
1873             output_pref(
1874                 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1875           }
1876           : $item->{$_}
1877           || ''
1878     } @$item_content_fields;
1879     return join( "\t", @item_info ) . "\n";
1880 }
1881
1882 1;
1883 __END__