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