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