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