C4/Letters.pm

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