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