C4/Letters.pm

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