C4/Letters.pm

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