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