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 = Koha::Email->create(
1393         {
1394             to => $to_address,
1395             (
1396                 C4::Context->preference('NoticeBcc')
1397                 ? ( bcc => C4::Context->preference('NoticeBcc') )
1398                 : ()
1399             ),
1400             from     => $from_address,
1401             reply_to => $message->{'reply_address'} || $branch_replyto,
1402             sender   => $branch_returnpath,
1403             subject  => "" . $message->{subject}
1404         }
1405     );
1406
1407     if ( $is_html ) {
1408         $email->html_body(
1409             _wrap_html( $content, $subject )
1410         );
1411     }
1412     else {
1413         $email->text_body( $content );
1414     }
1415
1416     my $smtp_server;
1417     if ( $library ) {
1418         $smtp_server = $library->smtp_server;
1419     }
1420     else {
1421         $smtp_server = Koha::SMTP::Servers->get_default;
1422     }
1423
1424     if ( $username ) {
1425         $smtp_server->set(
1426             {
1427                 sasl_username => $username,
1428                 sasl_password => $password,
1429             }
1430         );
1431     }
1432
1433 # if initial message address was empty, coming here means that a to address was found and
1434 # queue should be updated; same if to address was overriden by Koha::Email->create
1435     _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1436       if !$message->{to_address}
1437       || $message->{to_address} ne $email->email->header('To');
1438
1439     try {
1440         $email->send_or_die({ transport => $smtp_server->transport });
1441
1442         _set_message_status(
1443             {
1444                 message_id => $message->{'message_id'},
1445                 status     => 'sent',
1446                 failure_code => ''
1447             }
1448         );
1449         return 1;
1450     }
1451     catch {
1452         _set_message_status(
1453             {
1454                 message_id => $message->{'message_id'},
1455                 status     => 'failed',
1456                 failure_code => 'SENDMAIL'
1457             }
1458         );
1459         carp "$_";
1460         carp "$Mail::Sendmail::error";
1461         return;
1462     };
1463 }
1464
1465 sub _wrap_html {
1466     my ($content, $title) = @_;
1467
1468     my $css = C4::Context->preference("NoticeCSS") || '';
1469     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1470     return <<EOS;
1471 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1472     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1473 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1474 <head>
1475 <title>$title</title>
1476 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1477 $css
1478 </head>
1479 <body>
1480 $content
1481 </body>
1482 </html>
1483 EOS
1484 }
1485
1486 sub _is_duplicate {
1487     my ( $message ) = @_;
1488     my $dbh = C4::Context->dbh;
1489     my $count = $dbh->selectrow_array(q|
1490         SELECT COUNT(*)
1491         FROM message_queue
1492         WHERE message_transport_type = ?
1493         AND borrowernumber = ?
1494         AND letter_code = ?
1495         AND CAST(updated_on AS date) = CAST(NOW() AS date)
1496         AND status="sent"
1497         AND content = ?
1498     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1499     return $count;
1500 }
1501
1502 sub _send_message_by_sms {
1503     my $message = shift or return;
1504     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1505
1506     unless ( $patron and $patron->smsalertnumber ) {
1507         _set_message_status( { message_id => $message->{'message_id'},
1508                                status     => 'failed',
1509                                failure_code => 'MISSING_SMS' } );
1510         return;
1511     }
1512
1513     if ( _is_duplicate( $message ) ) {
1514         _set_message_status(
1515             {
1516                 message_id   => $message->{'message_id'},
1517                 status       => 'failed',
1518                 failure_code => 'DUPLICATE_MESSAGE'
1519             }
1520         );
1521         return;
1522     }
1523
1524     my $success = C4::SMS->send_sms(
1525         {
1526             destination => $patron->smsalertnumber,
1527             message     => $message->{'content'},
1528         }
1529     );
1530
1531     if ($success) {
1532         _set_message_status(
1533             {
1534                 message_id   => $message->{'message_id'},
1535                 status       => 'sent',
1536                 failure_code => ''
1537             }
1538         );
1539     }
1540     else {
1541         _set_message_status(
1542             {
1543                 message_id   => $message->{'message_id'},
1544                 status       => 'failed',
1545                 failure_code => 'NO_NOTES'
1546             }
1547         );
1548     }
1549
1550     return $success;
1551 }
1552
1553 sub _update_message_to_address {
1554     my ($id, $to)= @_;
1555     my $dbh = C4::Context->dbh();
1556     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1557 }
1558
1559 sub _update_message_from_address {
1560     my ($message_id, $from_address) = @_;
1561     my $dbh = C4::Context->dbh();
1562     $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1563 }
1564
1565 sub _set_message_status {
1566     my $params = shift or return;
1567
1568     foreach my $required_parameter ( qw( message_id status ) ) {
1569         return unless exists $params->{ $required_parameter };
1570     }
1571
1572     my $dbh = C4::Context->dbh();
1573     my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1574     my $sth = $dbh->prepare( $statement );
1575     my $result = $sth->execute( $params->{'status'},
1576                                 $params->{'failure_code'} || '',
1577                                 $params->{'message_id'} );
1578     return $result;
1579 }
1580
1581 sub _process_tt {
1582     my ( $params ) = @_;
1583
1584     my $content = $params->{content};
1585     my $tables = $params->{tables};
1586     my $loops = $params->{loops};
1587     my $substitute = $params->{substitute} || {};
1588     my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1589     my ($theme, $availablethemes);
1590
1591     my $htdocs = C4::Context->config('intrahtdocs');
1592     ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1593     my @includes;
1594     foreach (@$availablethemes) {
1595         push @includes, "$htdocs/$_/$lang/includes";
1596         push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1597     }
1598
1599     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1600     my $template           = Template->new(
1601         {
1602             EVAL_PERL    => 1,
1603             ABSOLUTE     => 1,
1604             PLUGIN_BASE  => 'Koha::Template::Plugin',
1605             COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
1606             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1607             INCLUDE_PATH => \@includes,
1608             FILTERS      => {},
1609             ENCODING     => 'UTF-8',
1610         }
1611     ) or die Template->error();
1612
1613     my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1614
1615     $content = add_tt_filters( $content );
1616     $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1617
1618     my $output;
1619     $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1620
1621     return $output;
1622 }
1623
1624 sub _get_tt_params {
1625     my ($tables, $is_a_loop) = @_;
1626
1627     my $params;
1628     $is_a_loop ||= 0;
1629
1630     my $config = {
1631         article_requests => {
1632             module   => 'Koha::ArticleRequests',
1633             singular => 'article_request',
1634             plural   => 'article_requests',
1635             pk       => 'id',
1636         },
1637         aqbasket => {
1638             module   => 'Koha::Acquisition::Baskets',
1639             singular => 'basket',
1640             plural   => 'baskets',
1641             pk       => 'basketno',
1642         },
1643         biblio => {
1644             module   => 'Koha::Biblios',
1645             singular => 'biblio',
1646             plural   => 'biblios',
1647             pk       => 'biblionumber',
1648         },
1649         biblioitems => {
1650             module   => 'Koha::Biblioitems',
1651             singular => 'biblioitem',
1652             plural   => 'biblioitems',
1653             pk       => 'biblioitemnumber',
1654         },
1655         borrowers => {
1656             module   => 'Koha::Patrons',
1657             singular => 'borrower',
1658             plural   => 'borrowers',
1659             pk       => 'borrowernumber',
1660         },
1661         branches => {
1662             module   => 'Koha::Libraries',
1663             singular => 'branch',
1664             plural   => 'branches',
1665             pk       => 'branchcode',
1666         },
1667         credits => {
1668             module => 'Koha::Account::Lines',
1669             singular => 'credit',
1670             plural => 'credits',
1671             pk => 'accountlines_id',
1672         },
1673         debits => {
1674             module => 'Koha::Account::Lines',
1675             singular => 'debit',
1676             plural => 'debits',
1677             pk => 'accountlines_id',
1678         },
1679         items => {
1680             module   => 'Koha::Items',
1681             singular => 'item',
1682             plural   => 'items',
1683             pk       => 'itemnumber',
1684         },
1685         additional_contents => {
1686             module   => 'Koha::AdditionalContents',
1687             singular => 'additional_content',
1688             plural   => 'additional_contents',
1689             pk       => 'idnew',
1690         },
1691         opac_news => {
1692             module   => 'Koha::AdditionalContents',
1693             singular => 'news',
1694             plural   => 'news',
1695             pk       => 'idnew',
1696         },
1697         aqorders => {
1698             module   => 'Koha::Acquisition::Orders',
1699             singular => 'order',
1700             plural   => 'orders',
1701             pk       => 'ordernumber',
1702         },
1703         reserves => {
1704             module   => 'Koha::Holds',
1705             singular => 'hold',
1706             plural   => 'holds',
1707             pk       => 'reserve_id',
1708         },
1709         serial => {
1710             module   => 'Koha::Serials',
1711             singular => 'serial',
1712             plural   => 'serials',
1713             pk       => 'serialid',
1714         },
1715         subscription => {
1716             module   => 'Koha::Subscriptions',
1717             singular => 'subscription',
1718             plural   => 'subscriptions',
1719             pk       => 'subscriptionid',
1720         },
1721         suggestions => {
1722             module   => 'Koha::Suggestions',
1723             singular => 'suggestion',
1724             plural   => 'suggestions',
1725             pk       => 'suggestionid',
1726         },
1727         issues => {
1728             module   => 'Koha::Checkouts',
1729             singular => 'checkout',
1730             plural   => 'checkouts',
1731             fk       => 'itemnumber',
1732         },
1733         old_issues => {
1734             module   => 'Koha::Old::Checkouts',
1735             singular => 'old_checkout',
1736             plural   => 'old_checkouts',
1737             fk       => 'itemnumber',
1738         },
1739         overdues => {
1740             module   => 'Koha::Checkouts',
1741             singular => 'overdue',
1742             plural   => 'overdues',
1743             fk       => 'itemnumber',
1744         },
1745         borrower_modifications => {
1746             module   => 'Koha::Patron::Modifications',
1747             singular => 'patron_modification',
1748             plural   => 'patron_modifications',
1749             fk       => 'verification_token',
1750         },
1751         illrequests => {
1752             module   => 'Koha::Illrequests',
1753             singular => 'illrequest',
1754             plural   => 'illrequests',
1755             pk       => 'illrequest_id'
1756         }
1757     };
1758
1759     foreach my $table ( keys %$tables ) {
1760         next unless $config->{$table};
1761
1762         my $ref = ref( $tables->{$table} ) || q{};
1763         my $module = $config->{$table}->{module};
1764
1765         if ( can_load( modules => { $module => undef } ) ) {
1766             my $pk = $config->{$table}->{pk};
1767             my $fk = $config->{$table}->{fk};
1768
1769             if ( $is_a_loop ) {
1770                 my $values = $tables->{$table} || [];
1771                 unless ( ref( $values ) eq 'ARRAY' ) {
1772                     croak "ERROR processing table $table. Wrong API call.";
1773                 }
1774                 my $key = $pk ? $pk : $fk;
1775                 # $key does not come from user input
1776                 my $objects = $module->search(
1777                     { $key => $values },
1778                     {
1779                             # We want to retrieve the data in the same order
1780                             # FIXME MySQLism
1781                             # field is a MySQLism, but they are no other way to do it
1782                             # To be generic we could do it in perl, but we will need to fetch
1783                             # all the data then order them
1784                         @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1785                     }
1786                 );
1787                 $params->{ $config->{$table}->{plural} } = $objects;
1788             }
1789             elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1790                 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1791                 my $object;
1792                 if ( $fk ) { # Using a foreign key for lookup
1793                     if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1794                         my $search;
1795                         foreach my $key ( @$fk ) {
1796                             $search->{$key} = $id->{$key};
1797                         }
1798                         $object = $module->search( $search )->last();
1799                     } else { # Foreign key is single column
1800                         $object = $module->search( { $fk => $id } )->last();
1801                     }
1802                 } else { # using the table's primary key for lookup
1803                     $object = $module->find($id);
1804                 }
1805                 $params->{ $config->{$table}->{singular} } = $object;
1806             }
1807             else {    # $ref eq 'ARRAY'
1808                 my $object;
1809                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
1810                     $object = $module->search( { $pk => $tables->{$table} } )->last();
1811                 }
1812                 else {                                  # Params are mutliple foreign keys
1813                     croak "Multiple foreign keys (table $table) should be passed using an hashref";
1814                 }
1815                 $params->{ $config->{$table}->{singular} } = $object;
1816             }
1817         }
1818         else {
1819             croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1820         }
1821     }
1822
1823     $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1824
1825     return $params;
1826 }
1827
1828 =head3 add_tt_filters
1829
1830 $content = add_tt_filters( $content );
1831
1832 Add TT filters to some specific fields if needed.
1833
1834 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1835
1836 =cut
1837
1838 sub add_tt_filters {
1839     my ( $content ) = @_;
1840     $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1841     $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1842     return $content;
1843 }
1844
1845 =head2 get_item_content
1846
1847     my $item = Koha::Items->find(...)->unblessed;
1848     my @item_content_fields = qw( date_due title barcode author itemnumber );
1849     my $item_content = C4::Letters::get_item_content({
1850                              item => $item,
1851                              item_content_fields => \@item_content_fields
1852                        });
1853
1854 This function generates a tab-separated list of values for the passed item. Dates
1855 are formatted following the current setup.
1856
1857 =cut
1858
1859 sub get_item_content {
1860     my ( $params ) = @_;
1861     my $item = $params->{item};
1862     my $dateonly = $params->{dateonly} || 0;
1863     my $item_content_fields = $params->{item_content_fields} || [];
1864
1865     return unless $item;
1866
1867     my @item_info = map {
1868         $_ =~ /^date|date$/
1869           ? eval {
1870             output_pref(
1871                 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1872           }
1873           : $item->{$_}
1874           || ''
1875     } @$item_content_fields;
1876     return join( "\t", @item_info ) . "\n";
1877 }
1878
1879 1;
1880 __END__