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