C4/Letters.pm

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