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 'credits'      )    ? "SELECT * FROM accountlines WHERE   accountlines_id = ?"                         :
 743     ($table eq 'debits'       )    ? "SELECT * FROM accountlines WHERE   accountlines_id = ?"                         :
 744     ($table eq 'items'        )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 745     ($table eq 'issues'       )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 746     ($table eq 'old_issues'   )    ? "SELECT * FROM $table WHERE     issue_id = ?"  :
 747     ($table eq 'reserves'     )    ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?"             :
 748     ($table eq 'borrowers'    )    ? "SELECT * FROM $table WHERE borrowernumber = ?"                                  :
 749     ($table eq 'branches'     )    ? "SELECT * FROM $table WHERE     branchcode = ?"                                  :
 750     ($table eq 'suggestions'  )    ? "SELECT * FROM $table WHERE   suggestionid = ?"                                  :
 751     ($table eq 'aqbooksellers')    ? "SELECT * FROM $table WHERE             id = ?"                                  :
 752     ($table eq 'aqorders'     )    ? "SELECT * FROM $table WHERE    ordernumber = ?"                                  :
 753     ($table eq 'aqbasket'     )    ? "SELECT * FROM $table WHERE       basketno = ?"                                  :
 754     ($table eq 'illrequests'  )    ? "SELECT * FROM $table WHERE  illrequest_id = ?"                                  :
 755     ($table eq 'article_requests') ? "SELECT * FROM $table WHERE             id = ?"                                  :
 756     ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
 757     ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
 758     ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
 759     ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
 760     ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
 761     ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
 762     undef ;
 763     unless ($query) {
 764         warn "ERROR: No _parseletter_sth query for table '$table'";
 765         return;     # nothing to get
 766     }
 767     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
 768         warn "ERROR: Failed to prepare query: '$query'";
 769         return;
 770     }
 771     return $sth;    # now cache is populated for that $table
 772 }
 773
 774 =head2 _parseletter($letter, $table, $values)
 775
 776     parameters :
 777     - $letter : a hash to letter fields (title & content useful)
 778     - $table : the Koha table to parse.
 779     - $values_in : table record hashref
 780     parse all fields from a table, and replace values in title & content with the appropriate value
 781     (not exported sub, used only internally)
 782
 783 =cut
 784
 785 sub _parseletter {
 786     my ( $letter, $table, $values_in ) = @_;
 787
 788     # Work on a local copy of $values_in (passed by reference) to avoid side effects
 789     # in callers ( by changing / formatting values )
 790     my $values = $values_in ? { %$values_in } : {};
 791
 792     # FIXME Dates formatting must be done in notice's templates
 793     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
 794         $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
 795     }
 796
 797     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 798         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
 799     }
 800
 801     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
 802         my $todaysdate = output_pref( dt_from_string() );
 803         $letter->{content} =~ s/<<today>>/$todaysdate/go;
 804     }
 805
 806     while ( my ($field, $val) = each %$values ) {
 807         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
 808             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
 809             #Therefore adding the test on biblio. This includes biblioitems,
 810             #but excludes items. Removed unneeded global and lookahead.
 811
 812         if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
 813             my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
 814             $val = $av->count ? $av->next->lib : '';
 815         }
 816
 817         # Dates replacement
 818         my $replacedby   = defined ($val) ? $val : '';
 819         if (    $replacedby
 820             and not $replacedby =~ m|9999-12-31|
 821             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
 822         {
 823             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
 824             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
 825             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
 826
 827             for my $letter_field ( qw( title content ) ) {
 828                 my $filter_string_used = q{};
 829                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
 830                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
 831                     $filter_string_used = $1 || q{};
 832                     $dateonly = $1 unless $dateonly;
 833                 }
 834                 my $replacedby_date = eval {
 835                     output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
 836                 };
 837                 $replacedby_date //= q{};
 838
 839                 if ( $letter->{ $letter_field } ) {
 840                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
 841                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
 842                 }
 843             }
 844         }
 845         # Other fields replacement
 846         else {
 847             for my $letter_field ( qw( title content ) ) {
 848                 if ( $letter->{ $letter_field } ) {
 849                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
 850                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
 851                 }
 852             }
 853         }
 854     }
 855
 856     if ($table eq 'borrowers' && $letter->{content}) {
 857         my $patron = Koha::Patrons->find( $values->{borrowernumber} );
 858         if ( $patron ) {
 859             my $attributes = $patron->extended_attributes;
 860             my %attr;
 861             while ( my $attribute = $attributes->next ) {
 862                 my $code = $attribute->code;
 863                 my $val  = $attribute->description; # FIXME - we always display intranet description here!
 864                 $val =~ s/\p{P}(?=$)//g if $val;
 865                 next unless $val gt '';
 866                 $attr{$code} ||= [];
 867                 push @{ $attr{$code} }, $val;
 868             }
 869             while ( my ($code, $val_ar) = each %attr ) {
 870                 my $replacefield = "<<borrower-attribute:$code>>";
 871                 my $replacedby   = join ',', @$val_ar;
 872                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 873             }
 874         }
 875     }
 876     return $letter;
 877 }
 878
 879 =head2 EnqueueLetter
 880
 881   my $success = EnqueueLetter( { letter => $letter,
 882         borrowernumber => '12', message_transport_type => 'email' } )
 883
 884 Places a letter in the message_queue database table, which will
 885 eventually get processed (sent) by the process_message_queue.pl
 886 cronjob when it calls SendQueuedMessages.
 887
 888 Return message_id on success
 889
 890 Parameters
 891 * letter - required; A letter hashref as returned from GetPreparedLetter
 892 * message_transport_type - required; One of the available mtts
 893 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
 894 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
 895 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
 896 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
 897
 898 =cut
 899
 900 sub EnqueueLetter {
 901     my $params = shift or return;
 902
 903     return unless exists $params->{'letter'};
 904 #   return unless exists $params->{'borrowernumber'};
 905     return unless exists $params->{'message_transport_type'};
 906
 907     my $content = $params->{letter}->{content};
 908     $content =~ s/\s+//g if(defined $content);
 909     if ( not defined $content or $content eq '' ) {
 910         Koha::Logger->get->info("Trying to add an empty message to the message queue");
 911         return;
 912     }
 913
 914     # If we have any attachments we should encode then into the body.
 915     if ( $params->{'attachments'} ) {
 916         $params->{'letter'} = _add_attachments(
 917             {   letter      => $params->{'letter'},
 918                 attachments => $params->{'attachments'},
 919             }
 920         );
 921     }
 922
 923     my $dbh       = C4::Context->dbh();
 924     my $statement = << 'ENDSQL';
 925 INSERT INTO message_queue
 926 ( letter_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
 927 VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
 928 ENDSQL
 929
 930     my $sth    = $dbh->prepare($statement);
 931     my $result = $sth->execute(
 932         $params->{letter}->{id} || undef,         # letter.id
 933         $params->{'borrowernumber'},              # borrowernumber
 934         $params->{'letter'}->{'title'},           # subject
 935         $params->{'letter'}->{'content'},         # content
 936         $params->{'letter'}->{'metadata'} || '',  # metadata
 937         $params->{'letter'}->{'code'}     || '',  # letter_code
 938         $params->{'message_transport_type'},      # message_transport_type
 939         'pending',                                # status
 940         $params->{'to_address'},                  # to_address
 941         $params->{'from_address'},                # from_address
 942         $params->{'reply_address'},               # reply_address
 943         $params->{'letter'}->{'content-type'},    # content_type
 944         $params->{'failure_code'}        || '',   # failure_code
 945     );
 946     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 947 }
 948
 949 =head2 SendQueuedMessages ([$hashref])
 950
 951     my $sent = SendQueuedMessages({
 952         letter_code => $letter_code,
 953         borrowernumber => $who_letter_is_for,
 954         limit => 50,
 955         verbose => 1,
 956         type => 'sms',
 957     });
 958
 959 Sends all of the 'pending' items in the message queue, unless
 960 parameters are passed.
 961
 962 The letter_code, borrowernumber and limit parameters are used
 963 to build a parameter set for _get_unsent_messages, thus limiting
 964 which pending messages will be processed. They are all optional.
 965
 966 The verbose parameter can be used to generate debugging output.
 967 It is also optional.
 968
 969 Returns number of messages sent.
 970
 971 =cut
 972
 973 sub SendQueuedMessages {
 974     my $params = shift;
 975
 976     my $which_unsent_messages = {
 977         'message_id'             => $params->{'message_id'},
 978         'limit'                  => $params->{'limit'} // 0,
 979         'borrowernumber'         => $params->{'borrowernumber'} // q{},
 980         'letter_code'            => $params->{'letter_code'} // q{},
 981         'message_transport_type' => $params->{'type'} // q{},
 982         'where'                  => $params->{'where'} // q{},
 983     };
 984     my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
 985     MESSAGE: foreach my $message ( @$unsent_messages ) {
 986         my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
 987         # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
 988         $message_object->make_column_dirty('status');
 989         return unless $message_object->store;
 990
 991         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 992         warn sprintf( 'sending %s message to patron: %s',
 993                       $message->{'message_transport_type'},
 994                       $message->{'borrowernumber'} || 'Admin' )
 995           if $params->{'verbose'};
 996         # This is just begging for subclassing
 997         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 998         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 999             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1000         }
1001         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1002             if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1003                 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1004                 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1005                 unless ( $sms_provider ) {
1006                     warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1007                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1008                     next MESSAGE;
1009                 }
1010                 unless ( $patron->smsalertnumber ) {
1011                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1012                     warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1013                     next MESSAGE;
1014                 }
1015                 $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1016                 $message->{to_address} .= '@' . $sms_provider->domain();
1017
1018                 # Check for possible from_address override
1019                 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1020                 if ($from_address && $message->{from_address} ne $from_address) {
1021                     $message->{from_address} = $from_address;
1022                     _update_message_from_address($message->{'message_id'}, $message->{from_address});
1023                 }
1024
1025                 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1026                 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1027             } else {
1028                 _send_message_by_sms( $message );
1029             }
1030         }
1031     }
1032     return scalar( @$unsent_messages );
1033 }
1034
1035 =head2 GetRSSMessages
1036
1037   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1038
1039 returns a listref of all queued RSS messages for a particular person.
1040
1041 =cut
1042
1043 sub GetRSSMessages {
1044     my $params = shift;
1045
1046     return unless $params;
1047     return unless ref $params;
1048     return unless $params->{'borrowernumber'};
1049
1050     return _get_unsent_messages( { message_transport_type => 'rss',
1051                                    limit                  => $params->{'limit'},
1052                                    borrowernumber         => $params->{'borrowernumber'}, } );
1053 }
1054
1055 =head2 GetPrintMessages
1056
1057   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1058
1059 Returns a arrayref of all queued print messages (optionally, for a particular
1060 person).
1061
1062 =cut
1063
1064 sub GetPrintMessages {
1065     my $params = shift || {};
1066
1067     return _get_unsent_messages( { message_transport_type => 'print',
1068                                    borrowernumber         => $params->{'borrowernumber'},
1069                                  } );
1070 }
1071
1072 =head2 GetQueuedMessages ([$hashref])
1073
1074   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1075
1076 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1077 and limited to specified limit.
1078
1079 Return is an arrayref of hashes, each has represents a message in the message queue.
1080
1081 =cut
1082
1083 sub GetQueuedMessages {
1084     my $params = shift;
1085
1086     my $dbh = C4::Context->dbh();
1087     my $statement = << 'ENDSQL';
1088 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1089 FROM message_queue
1090 ENDSQL
1091
1092     my @query_params;
1093     my @whereclauses;
1094     if ( exists $params->{'borrowernumber'} ) {
1095         push @whereclauses, ' borrowernumber = ? ';
1096         push @query_params, $params->{'borrowernumber'};
1097     }
1098
1099     if ( @whereclauses ) {
1100         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1101     }
1102
1103     if ( defined $params->{'limit'} ) {
1104         $statement .= ' LIMIT ? ';
1105         push @query_params, $params->{'limit'};
1106     }
1107
1108     my $sth = $dbh->prepare( $statement );
1109     my $result = $sth->execute( @query_params );
1110     return $sth->fetchall_arrayref({});
1111 }
1112
1113 =head2 GetMessageTransportTypes
1114
1115   my @mtt = GetMessageTransportTypes();
1116
1117   returns an arrayref of transport types
1118
1119 =cut
1120
1121 sub GetMessageTransportTypes {
1122     my $dbh = C4::Context->dbh();
1123     my $mtts = $dbh->selectcol_arrayref("
1124         SELECT message_transport_type
1125         FROM message_transport_types
1126         ORDER BY message_transport_type
1127     ");
1128     return $mtts;
1129 }
1130
1131 =head2 GetMessage
1132
1133     my $message = C4::Letters::Message($message_id);
1134
1135 =cut
1136
1137 sub GetMessage {
1138     my ( $message_id ) = @_;
1139     return unless $message_id;
1140     my $dbh = C4::Context->dbh;
1141     return $dbh->selectrow_hashref(q|
1142         SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, failure_code
1143         FROM message_queue
1144         WHERE message_id = ?
1145     |, {}, $message_id );
1146 }
1147
1148 =head2 ResendMessage
1149
1150   Attempt to resend a message which has failed previously.
1151
1152   my $has_been_resent = C4::Letters::ResendMessage($message_id);
1153
1154   Updates the message to 'pending' status so that
1155   it will be resent later on.
1156
1157   returns 1 on success, 0 on failure, undef if no message was found
1158
1159 =cut
1160
1161 sub ResendMessage {
1162     my $message_id = shift;
1163     return unless $message_id;
1164
1165     my $message = GetMessage( $message_id );
1166     return unless $message;
1167     my $rv = 0;
1168     if ( $message->{status} ne 'pending' ) {
1169         $rv = C4::Letters::_set_message_status({
1170             message_id => $message_id,
1171             status => 'pending',
1172         });
1173         $rv = $rv > 0? 1: 0;
1174         # Clear destination email address to force address update
1175         _update_message_to_address( $message_id, undef ) if $rv &&
1176             $message->{message_transport_type} eq 'email';
1177     }
1178     return $rv;
1179 }
1180
1181 =head2 _add_attachements
1182
1183   _add_attachments({ letter => $letter, attachments => $attachments });
1184
1185   named parameters:
1186   letter - the standard letter hashref
1187   attachments - listref of attachments. each attachment is a hashref of:
1188     type - the mime type, like 'text/plain'
1189     content - the actual attachment
1190     filename - the name of the attachment.
1191
1192   returns your letter object, with the content updated.
1193   This routine picks the I<content> of I<letter> and generates a MIME
1194   email, attaching the passed I<attachments> using Koha::Email. The
1195   content is replaced by the string representation of the MIME object,
1196   and the content-type is updated for later handling.
1197
1198 =cut
1199
1200 sub _add_attachments {
1201     my $params = shift;
1202
1203     my $letter = $params->{letter};
1204     my $attachments = $params->{attachments};
1205     return $letter unless @$attachments;
1206
1207     my $message = Koha::Email->new;
1208
1209     if ( $letter->{is_html} ) {
1210         $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1211     }
1212     else {
1213         $message->text_body( $letter->{content} );
1214     }
1215
1216     foreach my $attachment ( @$attachments ) {
1217         $message->attach(
1218             Encode::encode( "UTF-8", $attachment->{content} ),
1219             content_type => $attachment->{type} || 'application/octet-stream',
1220             name         => $attachment->{filename},
1221             disposition  => 'attachment',
1222         );
1223     }
1224
1225     $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1226     $letter->{content} = $message->as_string;
1227
1228     return $letter;
1229
1230 }
1231
1232 =head2 _get_unsent_messages
1233
1234   This function's parameter hash reference takes the following
1235   optional named parameters:
1236    message_transport_type: method of message sending (e.g. email, sms, etc.)
1237                            Can be a single string, or an arrayref of strings
1238    borrowernumber        : who the message is to be sent
1239    letter_code           : type of message being sent (e.g. PASSWORD_RESET)
1240                            Can be a single string, or an arrayref of strings
1241    message_id            : the message_id of the message. In that case the sub will return only 1 result
1242    limit                 : maximum number of messages to send
1243
1244   This function returns an array of matching hash referenced rows from
1245   message_queue with some borrower information added.
1246
1247 =cut
1248
1249 sub _get_unsent_messages {
1250     my $params = shift;
1251
1252     my $dbh = C4::Context->dbh();
1253     my $statement = qq{
1254         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
1255         FROM message_queue mq
1256         LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1257         WHERE status = ?
1258     };
1259
1260     my @query_params = ('pending');
1261     if ( ref $params ) {
1262         if ( $params->{'borrowernumber'} ) {
1263             $statement .= ' AND mq.borrowernumber = ? ';
1264             push @query_params, $params->{'borrowernumber'};
1265         }
1266         if ( $params->{'letter_code'} ) {
1267             my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1268             if ( @letter_codes ) {
1269                 my $q = join( ",", ("?") x @letter_codes );
1270                 $statement .= " AND mq.letter_code IN ( $q ) ";
1271                 push @query_params, @letter_codes;
1272             }
1273         }
1274         if ( $params->{'message_transport_type'} ) {
1275             my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1276             if ( @types ) {
1277                 my $q = join( ",", ("?") x @types );
1278                 $statement .= " AND message_transport_type IN ( $q ) ";
1279                 push @query_params, @types;
1280             }
1281         }
1282         if ( $params->{message_id} ) {
1283             $statement .= ' AND message_id = ?';
1284             push @query_params, $params->{message_id};
1285         }
1286         if ( $params->{where} ) {
1287             $statement .= " AND $params->{where} ";
1288         }
1289         if ( $params->{'limit'} ) {
1290             $statement .= ' limit ? ';
1291             push @query_params, $params->{'limit'};
1292         }
1293     }
1294
1295     my $sth = $dbh->prepare( $statement );
1296     my $result = $sth->execute( @query_params );
1297     return $sth->fetchall_arrayref({});
1298 }
1299
1300 sub _send_message_by_email {
1301     my $message = shift or return;
1302     my ($username, $password, $method) = @_;
1303
1304     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1305     my $to_address = $message->{'to_address'};
1306     unless ($to_address) {
1307         unless ($patron) {
1308             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1309             _set_message_status(
1310                 {
1311                     message_id   => $message->{'message_id'},
1312                     status       => 'failed',
1313                     failure_code => 'INVALID_BORNUMBER'
1314                 }
1315             );
1316             return;
1317         }
1318         $to_address = $patron->notice_email_address;
1319         unless ($to_address) {
1320             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1321             # warning too verbose for this more common case?
1322             _set_message_status(
1323                 {
1324                     message_id   => $message->{'message_id'},
1325                     status       => 'failed',
1326                     failure_code => 'NO_EMAIL'
1327                 }
1328             );
1329             return;
1330         }
1331     }
1332
1333     my $subject = $message->{'subject'};
1334
1335     my $content = $message->{'content'};
1336     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1337     my $is_html = $content_type =~ m/html/io;
1338
1339     my $branch_email = undef;
1340     my $branch_replyto = undef;
1341     my $branch_returnpath = undef;
1342     my $library;
1343
1344     if ($patron) {
1345         $library           = $patron->library;
1346         $branch_email      = $library->from_email_address;
1347         $branch_replyto    = $library->branchreplyto;
1348         $branch_returnpath = $library->branchreturnpath;
1349     }
1350
1351     # NOTE: Patron may not be defined above so branch_email may be undefined still
1352     # so we need to fallback to KohaAdminEmailAddress as a last resort.
1353     my $from_address =
1354          $message->{'from_address'}
1355       || $branch_email
1356       || C4::Context->preference('KohaAdminEmailAddress');
1357     if( !$from_address ) {
1358         _set_message_status(
1359             {
1360                 message_id   => $message->{'message_id'},
1361                 status       => 'failed',
1362                 failure_code => 'NO_FROM',
1363             }
1364         );
1365         return;
1366     };
1367     my $email;
1368
1369     try {
1370
1371         my $params = {
1372             to => $to_address,
1373             (
1374                 C4::Context->preference('NoticeBcc')
1375                 ? ( bcc => C4::Context->preference('NoticeBcc') )
1376                 : ()
1377             ),
1378             from     => $from_address,
1379             reply_to => $message->{'reply_address'} || $branch_replyto,
1380             sender   => $branch_returnpath,
1381             subject  => "" . $message->{subject}
1382         };
1383
1384         if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1385
1386             # The message has been previously composed as a valid MIME object
1387             # and serialized as a string on the DB
1388             $email = Koha::Email->new_from_string($content);
1389             $email->create($params);
1390         } else {
1391             $email = Koha::Email->create($params);
1392             if ($is_html) {
1393                 $email->html_body( _wrap_html( $content, $subject ) );
1394             } else {
1395                 $email->text_body($content);
1396             }
1397         }
1398     }
1399     catch {
1400         if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1401             _set_message_status(
1402                 {
1403                     message_id   => $message->{'message_id'},
1404                     status       => 'failed',
1405                     failure_code => "INVALID_EMAIL:".$_->parameter
1406                 }
1407             );
1408         } else {
1409             _set_message_status(
1410                 {
1411                     message_id   => $message->{'message_id'},
1412                     status       => 'failed',
1413                     failure_code => 'UNKNOWN_ERROR'
1414                 }
1415             );
1416         }
1417         return 0;
1418     };
1419     return unless $email;
1420
1421     my $smtp_server;
1422     if ( $library ) {
1423         $smtp_server = $library->smtp_server;
1424     }
1425     else {
1426         $smtp_server = Koha::SMTP::Servers->get_default;
1427     }
1428
1429     if ( $username ) {
1430         $smtp_server->set(
1431             {
1432                 sasl_username => $username,
1433                 sasl_password => $password,
1434             }
1435         );
1436     }
1437
1438 # if initial message address was empty, coming here means that a to address was found and
1439 # queue should be updated; same if to address was overriden by Koha::Email->create
1440     _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1441       if !$message->{to_address}
1442       || $message->{to_address} ne $email->email->header('To');
1443
1444     try {
1445         $email->send_or_die({ transport => $smtp_server->transport });
1446
1447         _set_message_status(
1448             {
1449                 message_id => $message->{'message_id'},
1450                 status     => 'sent',
1451                 failure_code => ''
1452             }
1453         );
1454         return 1;
1455     }
1456     catch {
1457         _set_message_status(
1458             {
1459                 message_id => $message->{'message_id'},
1460                 status     => 'failed',
1461                 failure_code => 'SENDMAIL'
1462             }
1463         );
1464         carp "$_";
1465         carp "$Mail::Sendmail::error";
1466         return;
1467     };
1468 }
1469
1470 sub _wrap_html {
1471     my ($content, $title) = @_;
1472
1473     my $css = C4::Context->preference("NoticeCSS") || '';
1474     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1475     return <<EOS;
1476 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1477     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1478 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1479 <head>
1480 <title>$title</title>
1481 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1482 $css
1483 </head>
1484 <body>
1485 $content
1486 </body>
1487 </html>
1488 EOS
1489 }
1490
1491 sub _is_duplicate {
1492     my ( $message ) = @_;
1493     my $dbh = C4::Context->dbh;
1494     my $count = $dbh->selectrow_array(q|
1495         SELECT COUNT(*)
1496         FROM message_queue
1497         WHERE message_transport_type = ?
1498         AND borrowernumber = ?
1499         AND letter_code = ?
1500         AND CAST(updated_on AS date) = CAST(NOW() AS date)
1501         AND status="sent"
1502         AND content = ?
1503     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1504     return $count;
1505 }
1506
1507 sub _send_message_by_sms {
1508     my $message = shift or return;
1509     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1510     _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1511
1512     unless ( $patron and $patron->smsalertnumber ) {
1513         _set_message_status( { message_id => $message->{'message_id'},
1514                                status     => 'failed',
1515                                failure_code => 'MISSING_SMS' } );
1516         return;
1517     }
1518
1519     if ( _is_duplicate( $message ) ) {
1520         _set_message_status(
1521             {
1522                 message_id   => $message->{'message_id'},
1523                 status       => 'failed',
1524                 failure_code => 'DUPLICATE_MESSAGE'
1525             }
1526         );
1527         return;
1528     }
1529
1530     my $success = C4::SMS->send_sms(
1531         {
1532             destination => $patron->smsalertnumber,
1533             message     => $message->{'content'},
1534         }
1535     );
1536
1537     if ($success) {
1538         _set_message_status(
1539             {
1540                 message_id   => $message->{'message_id'},
1541                 status       => 'sent',
1542                 failure_code => ''
1543             }
1544         );
1545     }
1546     else {
1547         _set_message_status(
1548             {
1549                 message_id   => $message->{'message_id'},
1550                 status       => 'failed',
1551                 failure_code => 'NO_NOTES'
1552             }
1553         );
1554     }
1555
1556     return $success;
1557 }
1558
1559 sub _update_message_to_address {
1560     my ($id, $to)= @_;
1561     my $dbh = C4::Context->dbh();
1562     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1563 }
1564
1565 sub _update_message_from_address {
1566     my ($message_id, $from_address) = @_;
1567     my $dbh = C4::Context->dbh();
1568     $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1569 }
1570
1571 sub _set_message_status {
1572     my $params = shift or return;
1573
1574     foreach my $required_parameter ( qw( message_id status ) ) {
1575         return unless exists $params->{ $required_parameter };
1576     }
1577
1578     my $dbh = C4::Context->dbh();
1579     my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1580     my $sth = $dbh->prepare( $statement );
1581     my $result = $sth->execute( $params->{'status'},
1582                                 $params->{'failure_code'} || '',
1583                                 $params->{'message_id'} );
1584     return $result;
1585 }
1586
1587 sub _process_tt {
1588     my ( $params ) = @_;
1589
1590     my $content    = $params->{content};
1591     my $tables     = $params->{tables};
1592     my $loops      = $params->{loops};
1593     my $objects    = $params->{objects} || {};
1594     my $substitute = $params->{substitute} || {};
1595     my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1596     my ($theme, $availablethemes);
1597
1598     my $htdocs = C4::Context->config('intrahtdocs');
1599     ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1600     my @includes;
1601     foreach (@$availablethemes) {
1602         push @includes, "$htdocs/$_/$lang/includes";
1603         push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1604     }
1605
1606     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1607     my $template           = Template->new(
1608         {
1609             EVAL_PERL    => 1,
1610             ABSOLUTE     => 1,
1611             PLUGIN_BASE  => 'Koha::Template::Plugin',
1612             COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
1613             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1614             INCLUDE_PATH => \@includes,
1615             FILTERS      => {},
1616             ENCODING     => 'UTF-8',
1617         }
1618     ) or die Template->error();
1619
1620     my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1621
1622     $content = add_tt_filters( $content );
1623     $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %][% PROCESS 'html_helpers.inc' %]$content|;
1624
1625     my $output;
1626     my $schema = Koha::Database->new->schema;
1627     $schema->txn_begin;
1628     my $processed = try {
1629         $template->process( \$content, $tt_params, \$output );
1630     }
1631     finally {
1632         $schema->txn_rollback;
1633     };
1634     croak "ERROR PROCESSING TEMPLATE: " . $template->error() unless $processed;
1635
1636     return $output;
1637 }
1638
1639 sub _get_tt_params {
1640     my ($tables, $is_a_loop) = @_;
1641
1642     my $params;
1643     $is_a_loop ||= 0;
1644
1645     my $config = {
1646         article_requests => {
1647             module   => 'Koha::ArticleRequests',
1648             singular => 'article_request',
1649             plural   => 'article_requests',
1650             pk       => 'id',
1651         },
1652         aqbasket => {
1653             module   => 'Koha::Acquisition::Baskets',
1654             singular => 'basket',
1655             plural   => 'baskets',
1656             pk       => 'basketno',
1657         },
1658         biblio => {
1659             module   => 'Koha::Biblios',
1660             singular => 'biblio',
1661             plural   => 'biblios',
1662             pk       => 'biblionumber',
1663         },
1664         biblioitems => {
1665             module   => 'Koha::Biblioitems',
1666             singular => 'biblioitem',
1667             plural   => 'biblioitems',
1668             pk       => 'biblioitemnumber',
1669         },
1670         borrowers => {
1671             module   => 'Koha::Patrons',
1672             singular => 'borrower',
1673             plural   => 'borrowers',
1674             pk       => 'borrowernumber',
1675         },
1676         branches => {
1677             module   => 'Koha::Libraries',
1678             singular => 'branch',
1679             plural   => 'branches',
1680             pk       => 'branchcode',
1681         },
1682         credits => {
1683             module => 'Koha::Account::Lines',
1684             singular => 'credit',
1685             plural => 'credits',
1686             pk => 'accountlines_id',
1687         },
1688         debits => {
1689             module => 'Koha::Account::Lines',
1690             singular => 'debit',
1691             plural => 'debits',
1692             pk => 'accountlines_id',
1693         },
1694         items => {
1695             module   => 'Koha::Items',
1696             singular => 'item',
1697             plural   => 'items',
1698             pk       => 'itemnumber',
1699         },
1700         additional_contents => {
1701             module   => 'Koha::AdditionalContents',
1702             singular => 'additional_content',
1703             plural   => 'additional_contents',
1704             pk       => 'idnew',
1705         },
1706         opac_news => {
1707             module   => 'Koha::AdditionalContents',
1708             singular => 'news',
1709             plural   => 'news',
1710             pk       => 'idnew',
1711         },
1712         aqorders => {
1713             module   => 'Koha::Acquisition::Orders',
1714             singular => 'order',
1715             plural   => 'orders',
1716             pk       => 'ordernumber',
1717         },
1718         reserves => {
1719             module   => 'Koha::Holds',
1720             singular => 'hold',
1721             plural   => 'holds',
1722             pk       => 'reserve_id',
1723         },
1724         serial => {
1725             module   => 'Koha::Serials',
1726             singular => 'serial',
1727             plural   => 'serials',
1728             pk       => 'serialid',
1729         },
1730         subscription => {
1731             module   => 'Koha::Subscriptions',
1732             singular => 'subscription',
1733             plural   => 'subscriptions',
1734             pk       => 'subscriptionid',
1735         },
1736         suggestions => {
1737             module   => 'Koha::Suggestions',
1738             singular => 'suggestion',
1739             plural   => 'suggestions',
1740             pk       => 'suggestionid',
1741         },
1742         tickets => {
1743             module   => 'Koha::Tickets',
1744             singular => 'ticket',
1745             plural   => 'tickets',
1746             pk       => 'id',
1747         },
1748         issues => {
1749             module   => 'Koha::Checkouts',
1750             singular => 'checkout',
1751             plural   => 'checkouts',
1752             fk       => 'itemnumber',
1753         },
1754         old_issues => {
1755             module   => 'Koha::Old::Checkouts',
1756             singular => 'old_checkout',
1757             plural   => 'old_checkouts',
1758             pk       => 'issue_id',
1759         },
1760         overdues => {
1761             module   => 'Koha::Checkouts',
1762             singular => 'overdue',
1763             plural   => 'overdues',
1764             fk       => 'itemnumber',
1765         },
1766         borrower_modifications => {
1767             module   => 'Koha::Patron::Modifications',
1768             singular => 'patron_modification',
1769             plural   => 'patron_modifications',
1770             fk       => 'verification_token',
1771         },
1772         illrequests => {
1773             module   => 'Koha::Illrequests',
1774             singular => 'illrequest',
1775             plural   => 'illrequests',
1776             pk       => 'illrequest_id'
1777         }
1778     };
1779
1780     foreach my $table ( keys %$tables ) {
1781         next unless $config->{$table};
1782
1783         my $ref = ref( $tables->{$table} ) || q{};
1784         my $module = $config->{$table}->{module};
1785
1786         if ( can_load( modules => { $module => undef } ) ) {
1787             my $pk = $config->{$table}->{pk};
1788             my $fk = $config->{$table}->{fk};
1789
1790             if ( $is_a_loop ) {
1791                 my $values = $tables->{$table} || [];
1792                 unless ( ref( $values ) eq 'ARRAY' ) {
1793                     croak "ERROR processing table $table. Wrong API call.";
1794                 }
1795                 my $key = $pk ? $pk : $fk;
1796                 # $key does not come from user input
1797                 my $objects = $module->search(
1798                     { $key => $values },
1799                     {
1800                             # We want to retrieve the data in the same order
1801                             # FIXME MySQLism
1802                             # field is a MySQLism, but they are no other way to do it
1803                             # To be generic we could do it in perl, but we will need to fetch
1804                             # all the data then order them
1805                         @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1806                     }
1807                 );
1808                 $params->{ $config->{$table}->{plural} } = $objects;
1809             }
1810             elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1811                 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1812                 my $object;
1813                 if ( $fk ) { # Using a foreign key for lookup
1814                     if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1815                         my $search;
1816                         foreach my $key ( @$fk ) {
1817                             $search->{$key} = $id->{$key};
1818                         }
1819                         $object = $module->search( $search )->last();
1820                     } else { # Foreign key is single column
1821                         $object = $module->search( { $fk => $id } )->last();
1822                     }
1823                 } else { # using the table's primary key for lookup
1824                     $object = $module->find($id);
1825                 }
1826                 $params->{ $config->{$table}->{singular} } = $object;
1827             }
1828             else {    # $ref eq 'ARRAY'
1829                 my $object;
1830                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
1831                     $object = $module->search( { $pk => $tables->{$table} } )->last();
1832                 }
1833                 else {                                  # Params are mutliple foreign keys
1834                     croak "Multiple foreign keys (table $table) should be passed using an hashref";
1835                 }
1836                 $params->{ $config->{$table}->{singular} } = $object;
1837             }
1838         }
1839         else {
1840             croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1841         }
1842     }
1843
1844     $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1845
1846     return $params;
1847 }
1848
1849 =head3 add_tt_filters
1850
1851 $content = add_tt_filters( $content );
1852
1853 Add TT filters to some specific fields if needed.
1854
1855 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1856
1857 =cut
1858
1859 sub add_tt_filters {
1860     my ( $content ) = @_;
1861     $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1862     $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1863     return $content;
1864 }
1865
1866 =head2 get_item_content
1867
1868     my $item = Koha::Items->find(...)->unblessed;
1869     my @item_content_fields = qw( date_due title barcode author itemnumber );
1870     my $item_content = C4::Letters::get_item_content({
1871                              item => $item,
1872                              item_content_fields => \@item_content_fields
1873                        });
1874
1875 This function generates a tab-separated list of values for the passed item. Dates
1876 are formatted following the current setup.
1877
1878 =cut
1879
1880 sub get_item_content {
1881     my ( $params ) = @_;
1882     my $item = $params->{item};
1883     my $dateonly = $params->{dateonly} || 0;
1884     my $item_content_fields = $params->{item_content_fields} || [];
1885
1886     return unless $item;
1887
1888     my @item_info = map {
1889         $_ =~ /^date|date$/
1890           ? eval {
1891             output_pref(
1892                 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1893           }
1894           : $item->{$_}
1895           || ''
1896     } @$item_content_fields;
1897     return join( "\t", @item_info ) . "\n";
1898 }
1899
1900 1;
1901 __END__