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