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