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