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