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