C4/Letters.pm

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