C4/Letters.pm

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