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     ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
 805     undef ;
 806     unless ($query) {
 807         warn "ERROR: No _parseletter_sth query for table '$table'";
 808         return;     # nothing to get
 809     }
 810     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
 811         warn "ERROR: Failed to prepare query: '$query'";
 812         return;
 813     }
 814     return $sth;    # now cache is populated for that $table
 815 }
 816
 817 =head2 _parseletter($letter, $table, $values)
 818
 819     parameters :
 820     - $letter : a hash to letter fields (title & content useful)
 821     - $table : the Koha table to parse.
 822     - $values_in : table record hashref
 823     parse all fields from a table, and replace values in title & content with the appropriate value
 824     (not exported sub, used only internally)
 825
 826 =cut
 827
 828 sub _parseletter {
 829     my ( $letter, $table, $values_in ) = @_;
 830
 831     # Work on a local copy of $values_in (passed by reference) to avoid side effects
 832     # in callers ( by changing / formatting values )
 833     my $values = $values_in ? { %$values_in } : {};
 834
 835     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
 836         $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
 837     }
 838
 839     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 840         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
 841     }
 842
 843     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
 844         my $todaysdate = output_pref( dt_from_string() );
 845         $letter->{content} =~ s/<<today>>/$todaysdate/go;
 846     }
 847
 848     while ( my ($field, $val) = each %$values ) {
 849         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
 850             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
 851             #Therefore adding the test on biblio. This includes biblioitems,
 852             #but excludes items. Removed unneeded global and lookahead.
 853
 854         if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
 855             my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
 856             $val = $av->count ? $av->next->lib : '';
 857         }
 858
 859         # Dates replacement
 860         my $replacedby   = defined ($val) ? $val : '';
 861         if (    $replacedby
 862             and not $replacedby =~ m|9999-12-31|
 863             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
 864         {
 865             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
 866             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
 867             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
 868
 869             for my $letter_field ( qw( title content ) ) {
 870                 my $filter_string_used = q{};
 871                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
 872                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
 873                     $filter_string_used = $1 || q{};
 874                     $dateonly = $1 unless $dateonly;
 875                 }
 876                 my $replacedby_date = eval {
 877                     output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
 878                 };
 879
 880                 if ( $letter->{ $letter_field } ) {
 881                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
 882                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
 883                 }
 884             }
 885         }
 886         # Other fields replacement
 887         else {
 888             for my $letter_field ( qw( title content ) ) {
 889                 if ( $letter->{ $letter_field } ) {
 890                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
 891                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
 892                 }
 893             }
 894         }
 895     }
 896
 897     if ($table eq 'borrowers' && $letter->{content}) {
 898         my $patron = Koha::Patrons->find( $values->{borrowernumber} );
 899         if ( $patron ) {
 900             my $attributes = $patron->extended_attributes;
 901             my %attr;
 902             while ( my $attribute = $attributes->next ) {
 903                 my $code = $attribute->code;
 904                 my $val  = $attribute->description; # FIXME - we always display intranet description here!
 905                 $val =~ s/\p{P}(?=$)//g if $val;
 906                 next unless $val gt '';
 907                 $attr{$code} ||= [];
 908                 push @{ $attr{$code} }, $val;
 909             }
 910             while ( my ($code, $val_ar) = each %attr ) {
 911                 my $replacefield = "<<borrower-attribute:$code>>";
 912                 my $replacedby   = join ',', @$val_ar;
 913                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 914             }
 915         }
 916     }
 917     return $letter;
 918 }
 919
 920 =head2 EnqueueLetter
 921
 922   my $success = EnqueueLetter( { letter => $letter,
 923         borrowernumber => '12', message_transport_type => 'email' } )
 924
 925 Places a letter in the message_queue database table, which will
 926 eventually get processed (sent) by the process_message_queue.pl
 927 cronjob when it calls SendQueuedMessages.
 928
 929 Return message_id on success
 930
 931 Parameters
 932 * letter - required; A letter hashref as returned from GetPreparedLetter
 933 * message_transport_type - required; One of the available mtts
 934 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
 935 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
 936 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
 937 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
 938
 939 =cut
 940
 941 sub EnqueueLetter {
 942     my $params = shift or return;
 943
 944     return unless exists $params->{'letter'};
 945 #   return unless exists $params->{'borrowernumber'};
 946     return unless exists $params->{'message_transport_type'};
 947
 948     my $content = $params->{letter}->{content};
 949     $content =~ s/\s+//g if(defined $content);
 950     if ( not defined $content or $content eq '' ) {
 951         Koha::Logger->get->info("Trying to add an empty message to the message queue");
 952         return;
 953     }
 954
 955     # If we have any attachments we should encode then into the body.
 956     if ( $params->{'attachments'} ) {
 957         $params->{'letter'} = _add_attachments(
 958             {   letter      => $params->{'letter'},
 959                 attachments => $params->{'attachments'},
 960             }
 961         );
 962     }
 963
 964     my $dbh       = C4::Context->dbh();
 965     my $statement = << 'ENDSQL';
 966 INSERT INTO message_queue
 967 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
 968 VALUES
 969 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      CAST(NOW() AS DATETIME),       ?,          ?,            ?,           ?,              ? )
 970 ENDSQL
 971
 972     my $sth    = $dbh->prepare($statement);
 973     my $result = $sth->execute(
 974         $params->{'borrowernumber'},              # borrowernumber
 975         $params->{'letter'}->{'title'},           # subject
 976         $params->{'letter'}->{'content'},         # content
 977         $params->{'letter'}->{'metadata'} || '',  # metadata
 978         $params->{'letter'}->{'code'}     || '',  # letter_code
 979         $params->{'message_transport_type'},      # message_transport_type
 980         'pending',                                # status
 981         $params->{'to_address'},                  # to_address
 982         $params->{'from_address'},                # from_address
 983         $params->{'reply_address'},               # reply_address
 984         $params->{'letter'}->{'content-type'},    # content_type
 985         $params->{'failure_code'}        || '',   # failure_code
 986     );
 987     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 988 }
 989
 990 =head2 SendQueuedMessages ([$hashref])
 991
 992     my $sent = SendQueuedMessages({
 993         letter_code => $letter_code,
 994         borrowernumber => $who_letter_is_for,
 995         limit => 50,
 996         verbose => 1,
 997         type => 'sms',
 998     });
 999
1000 Sends all of the 'pending' items in the message queue, unless
1001 parameters are passed.
1002
1003 The letter_code, borrowernumber and limit parameters are used
1004 to build a parameter set for _get_unsent_messages, thus limiting
1005 which pending messages will be processed. They are all optional.
1006
1007 The verbose parameter can be used to generate debugging output.
1008 It is also optional.
1009
1010 Returns number of messages sent.
1011
1012 =cut
1013
1014 sub SendQueuedMessages {
1015     my $params = shift;
1016
1017     my $which_unsent_messages  = {
1018         'message_id'     => $params->{'message_id'},
1019         'limit'          => $params->{'limit'} // 0,
1020         'borrowernumber' => $params->{'borrowernumber'} // q{},
1021         'letter_code'    => $params->{'letter_code'} // q{},
1022         'type'           => $params->{'type'} // q{},
1023     };
1024     my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1025     MESSAGE: foreach my $message ( @$unsent_messages ) {
1026         my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1027         # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1028         $message_object->make_column_dirty('status');
1029         return unless $message_object->store;
1030
1031         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1032         warn sprintf( 'sending %s message to patron: %s',
1033                       $message->{'message_transport_type'},
1034                       $message->{'borrowernumber'} || 'Admin' )
1035           if $params->{'verbose'};
1036         # This is just begging for subclassing
1037         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1038         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1039             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1040         }
1041         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1042             if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1043                 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1044                 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1045                 unless ( $sms_provider ) {
1046                     warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1047                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1048                     next MESSAGE;
1049                 }
1050                 unless ( $patron->smsalertnumber ) {
1051                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1052                     warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1053                     next MESSAGE;
1054                 }
1055                 $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1056                 $message->{to_address} .= '@' . $sms_provider->domain();
1057
1058                 # Check for possible from_address override
1059                 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1060                 if ($from_address && $message->{from_address} ne $from_address) {
1061                     $message->{from_address} = $from_address;
1062                     _update_message_from_address($message->{'message_id'}, $message->{from_address});
1063                 }
1064
1065                 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1066                 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1067             } else {
1068                 _send_message_by_sms( $message );
1069             }
1070         }
1071     }
1072     return scalar( @$unsent_messages );
1073 }
1074
1075 =head2 GetRSSMessages
1076
1077   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1078
1079 returns a listref of all queued RSS messages for a particular person.
1080
1081 =cut
1082
1083 sub GetRSSMessages {
1084     my $params = shift;
1085
1086     return unless $params;
1087     return unless ref $params;
1088     return unless $params->{'borrowernumber'};
1089
1090     return _get_unsent_messages( { message_transport_type => 'rss',
1091                                    limit                  => $params->{'limit'},
1092                                    borrowernumber         => $params->{'borrowernumber'}, } );
1093 }
1094
1095 =head2 GetPrintMessages
1096
1097   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1098
1099 Returns a arrayref of all queued print messages (optionally, for a particular
1100 person).
1101
1102 =cut
1103
1104 sub GetPrintMessages {
1105     my $params = shift || {};
1106
1107     return _get_unsent_messages( { message_transport_type => 'print',
1108                                    borrowernumber         => $params->{'borrowernumber'},
1109                                  } );
1110 }
1111
1112 =head2 GetQueuedMessages ([$hashref])
1113
1114   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1115
1116 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1117 and limited to specified limit.
1118
1119 Return is an arrayref of hashes, each has represents a message in the message queue.
1120
1121 =cut
1122
1123 sub GetQueuedMessages {
1124     my $params = shift;
1125
1126     my $dbh = C4::Context->dbh();
1127     my $statement = << 'ENDSQL';
1128 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1129 FROM message_queue
1130 ENDSQL
1131
1132     my @query_params;
1133     my @whereclauses;
1134     if ( exists $params->{'borrowernumber'} ) {
1135         push @whereclauses, ' borrowernumber = ? ';
1136         push @query_params, $params->{'borrowernumber'};
1137     }
1138
1139     if ( @whereclauses ) {
1140         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1141     }
1142
1143     if ( defined $params->{'limit'} ) {
1144         $statement .= ' LIMIT ? ';
1145         push @query_params, $params->{'limit'};
1146     }
1147
1148     my $sth = $dbh->prepare( $statement );
1149     my $result = $sth->execute( @query_params );
1150     return $sth->fetchall_arrayref({});
1151 }
1152
1153 =head2 GetMessageTransportTypes
1154
1155   my @mtt = GetMessageTransportTypes();
1156
1157   returns an arrayref of transport types
1158
1159 =cut
1160
1161 sub GetMessageTransportTypes {
1162     my $dbh = C4::Context->dbh();
1163     my $mtts = $dbh->selectcol_arrayref("
1164         SELECT message_transport_type
1165         FROM message_transport_types
1166         ORDER BY message_transport_type
1167     ");
1168     return $mtts;
1169 }
1170
1171 =head2 GetMessage
1172
1173     my $message = C4::Letters::Message($message_id);
1174
1175 =cut
1176
1177 sub GetMessage {
1178     my ( $message_id ) = @_;
1179     return unless $message_id;
1180     my $dbh = C4::Context->dbh;
1181     return $dbh->selectrow_hashref(q|
1182         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
1183         FROM message_queue
1184         WHERE message_id = ?
1185     |, {}, $message_id );
1186 }
1187
1188 =head2 ResendMessage
1189
1190   Attempt to resend a message which has failed previously.
1191
1192   my $has_been_resent = C4::Letters::ResendMessage($message_id);
1193
1194   Updates the message to 'pending' status so that
1195   it will be resent later on.
1196
1197   returns 1 on success, 0 on failure, undef if no message was found
1198
1199 =cut
1200
1201 sub ResendMessage {
1202     my $message_id = shift;
1203     return unless $message_id;
1204
1205     my $message = GetMessage( $message_id );
1206     return unless $message;
1207     my $rv = 0;
1208     if ( $message->{status} ne 'pending' ) {
1209         $rv = C4::Letters::_set_message_status({
1210             message_id => $message_id,
1211             status => 'pending',
1212         });
1213         $rv = $rv > 0? 1: 0;
1214         # Clear destination email address to force address update
1215         _update_message_to_address( $message_id, undef ) if $rv &&
1216             $message->{message_transport_type} eq 'email';
1217     }
1218     return $rv;
1219 }
1220
1221 =head2 _add_attachements
1222
1223   _add_attachments({ letter => $letter, attachments => $attachments });
1224
1225   named parameters:
1226   letter - the standard letter hashref
1227   attachments - listref of attachments. each attachment is a hashref of:
1228     type - the mime type, like 'text/plain'
1229     content - the actual attachment
1230     filename - the name of the attachment.
1231
1232   returns your letter object, with the content updated.
1233   This routine picks the I<content> of I<letter> and generates a MIME
1234   email, attaching the passed I<attachments> using Koha::Email. The
1235   content is replaced by the string representation of the MIME object,
1236   and the content-type is updated for later handling.
1237
1238 =cut
1239
1240 sub _add_attachments {
1241     my $params = shift;
1242
1243     my $letter = $params->{letter};
1244     my $attachments = $params->{attachments};
1245     return $letter unless @$attachments;
1246
1247     my $message = Koha::Email->new;
1248
1249     if ( $letter->{is_html} ) {
1250         $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1251     }
1252     else {
1253         $message->text_body( $letter->{content} );
1254     }
1255
1256     foreach my $attachment ( @$attachments ) {
1257         $message->attach(
1258             Encode::encode( "UTF-8", $attachment->{content} ),
1259             content_type => $attachment->{type} || 'application/octet-stream',
1260             name         => $attachment->{filename},
1261             disposition  => 'attachment',
1262         );
1263     }
1264
1265     $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1266     $letter->{content} = $message->as_string;
1267
1268     return $letter;
1269
1270 }
1271
1272 =head2 _get_unsent_messages
1273
1274   This function's parameter hash reference takes the following
1275   optional named parameters:
1276    message_transport_type: method of message sending (e.g. email, sms, etc.)
1277    borrowernumber        : who the message is to be sent
1278    letter_code           : type of message being sent (e.g. PASSWORD_RESET)
1279    message_id            : the message_id of the message. In that case the sub will return only 1 result
1280    limit                 : maximum number of messages to send
1281
1282   This function returns an array of matching hash referenced rows from
1283   message_queue with some borrower information added.
1284
1285 =cut
1286
1287 sub _get_unsent_messages {
1288     my $params = shift;
1289
1290     my $dbh = C4::Context->dbh();
1291     my $statement = qq{
1292         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
1293         FROM message_queue mq
1294         LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1295         WHERE status = ?
1296     };
1297
1298     my @query_params = ('pending');
1299     if ( ref $params ) {
1300         if ( $params->{'message_transport_type'} ) {
1301             $statement .= ' AND mq.message_transport_type = ? ';
1302             push @query_params, $params->{'message_transport_type'};
1303         }
1304         if ( $params->{'borrowernumber'} ) {
1305             $statement .= ' AND mq.borrowernumber = ? ';
1306             push @query_params, $params->{'borrowernumber'};
1307         }
1308         if ( $params->{'letter_code'} ) {
1309             $statement .= ' AND mq.letter_code = ? ';
1310             push @query_params, $params->{'letter_code'};
1311         }
1312         if ( $params->{'type'} ) {
1313             $statement .= ' AND message_transport_type = ? ';
1314             push @query_params, $params->{'type'};
1315         }
1316         if ( $params->{message_id} ) {
1317             $statement .= ' AND message_id = ?';
1318             push @query_params, $params->{message_id};
1319         }
1320         if ( $params->{'limit'} ) {
1321             $statement .= ' limit ? ';
1322             push @query_params, $params->{'limit'};
1323         }
1324     }
1325
1326     my $sth = $dbh->prepare( $statement );
1327     my $result = $sth->execute( @query_params );
1328     return $sth->fetchall_arrayref({});
1329 }
1330
1331 sub _send_message_by_email {
1332     my $message = shift or return;
1333     my ($username, $password, $method) = @_;
1334
1335     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1336     my $to_address = $message->{'to_address'};
1337     unless ($to_address) {
1338         unless ($patron) {
1339             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1340             _set_message_status(
1341                 {
1342                     message_id   => $message->{'message_id'},
1343                     status       => 'failed',
1344                     failure_code => 'INVALID_BORNUMBER'
1345                 }
1346             );
1347             return;
1348         }
1349         $to_address = $patron->notice_email_address;
1350         unless ($to_address) {
1351             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1352             # warning too verbose for this more common case?
1353             _set_message_status(
1354                 {
1355                     message_id   => $message->{'message_id'},
1356                     status       => 'failed',
1357                     failure_code => 'NO_EMAIL'
1358                 }
1359             );
1360             return;
1361         }
1362     }
1363
1364     my $subject = $message->{'subject'};
1365
1366     my $content = $message->{'content'};
1367     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1368     my $is_html = $content_type =~ m/html/io;
1369
1370     my $branch_email = undef;
1371     my $branch_replyto = undef;
1372     my $branch_returnpath = undef;
1373     my $library;
1374
1375     if ($patron) {
1376         $library           = $patron->library;
1377         $branch_email      = $library->from_email_address;
1378         $branch_replyto    = $library->branchreplyto;
1379         $branch_returnpath = $library->branchreturnpath;
1380     }
1381
1382     # NOTE: Patron may not be defined above so branch_email may be undefined still
1383     # so we need to fallback to KohaAdminEmailAddress as a last resort.
1384     my $from_address =
1385          $message->{'from_address'}
1386       || $branch_email
1387       || C4::Context->preference('KohaAdminEmailAddress');
1388     if( !$from_address ) {
1389         _set_message_status(
1390             {
1391                 message_id   => $message->{'message_id'},
1392                 status       => 'failed',
1393                 failure_code => 'NO_FROM',
1394             }
1395         );
1396         return;
1397     };
1398     my $email;
1399
1400     try {
1401
1402         my $params = {
1403             to => $to_address,
1404             (
1405                 C4::Context->preference('NoticeBcc')
1406                 ? ( bcc => C4::Context->preference('NoticeBcc') )
1407                 : ()
1408             ),
1409             from     => $from_address,
1410             reply_to => $message->{'reply_address'} || $branch_replyto,
1411             sender   => $branch_returnpath,
1412             subject  => "" . $message->{subject}
1413         };
1414
1415         if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1416
1417             # The message has been previously composed as a valid MIME object
1418             # and serialized as a string on the DB
1419             $email = Koha::Email->new_from_string($content);
1420             $email->create($params);
1421         } else {
1422             $email = Koha::Email->create($params);
1423             if ($is_html) {
1424                 $email->html_body( _wrap_html( $content, $subject ) );
1425             } else {
1426                 $email->text_body($content);
1427             }
1428         }
1429     }
1430     catch {
1431         if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1432             _set_message_status(
1433                 {
1434                     message_id   => $message->{'message_id'},
1435                     status       => 'failed',
1436                     failure_code => "INVALID_EMAIL:".$_->parameter
1437                 }
1438             );
1439         } else {
1440             _set_message_status(
1441                 {
1442                     message_id   => $message->{'message_id'},
1443                     status       => 'failed',
1444                     failure_code => 'UNKNOWN_ERROR'
1445                 }
1446             );
1447         }
1448         return 0;
1449     };
1450     return unless $email;
1451
1452     my $smtp_server;
1453     if ( $library ) {
1454         $smtp_server = $library->smtp_server;
1455     }
1456     else {
1457         $smtp_server = Koha::SMTP::Servers->get_default;
1458     }
1459
1460     if ( $username ) {
1461         $smtp_server->set(
1462             {
1463                 sasl_username => $username,
1464                 sasl_password => $password,
1465             }
1466         );
1467     }
1468
1469 # if initial message address was empty, coming here means that a to address was found and
1470 # queue should be updated; same if to address was overriden by Koha::Email->create
1471     _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1472       if !$message->{to_address}
1473       || $message->{to_address} ne $email->email->header('To');
1474
1475     try {
1476         $email->send_or_die({ transport => $smtp_server->transport });
1477
1478         _set_message_status(
1479             {
1480                 message_id => $message->{'message_id'},
1481                 status     => 'sent',
1482                 failure_code => ''
1483             }
1484         );
1485         return 1;
1486     }
1487     catch {
1488         _set_message_status(
1489             {
1490                 message_id => $message->{'message_id'},
1491                 status     => 'failed',
1492                 failure_code => 'SENDMAIL'
1493             }
1494         );
1495         carp "$_";
1496         carp "$Mail::Sendmail::error";
1497         return;
1498     };
1499 }
1500
1501 sub _wrap_html {
1502     my ($content, $title) = @_;
1503
1504     my $css = C4::Context->preference("NoticeCSS") || '';
1505     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1506     return <<EOS;
1507 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1508     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1509 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1510 <head>
1511 <title>$title</title>
1512 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1513 $css
1514 </head>
1515 <body>
1516 $content
1517 </body>
1518 </html>
1519 EOS
1520 }
1521
1522 sub _is_duplicate {
1523     my ( $message ) = @_;
1524     my $dbh = C4::Context->dbh;
1525     my $count = $dbh->selectrow_array(q|
1526         SELECT COUNT(*)
1527         FROM message_queue
1528         WHERE message_transport_type = ?
1529         AND borrowernumber = ?
1530         AND letter_code = ?
1531         AND CAST(updated_on AS date) = CAST(NOW() AS date)
1532         AND status="sent"
1533         AND content = ?
1534     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1535     return $count;
1536 }
1537
1538 sub _send_message_by_sms {
1539     my $message = shift or return;
1540     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1541
1542     unless ( $patron and $patron->smsalertnumber ) {
1543         _set_message_status( { message_id => $message->{'message_id'},
1544                                status     => 'failed',
1545                                failure_code => 'MISSING_SMS' } );
1546         return;
1547     }
1548
1549     if ( _is_duplicate( $message ) ) {
1550         _set_message_status(
1551             {
1552                 message_id   => $message->{'message_id'},
1553                 status       => 'failed',
1554                 failure_code => 'DUPLICATE_MESSAGE'
1555             }
1556         );
1557         return;
1558     }
1559
1560     my $success = C4::SMS->send_sms(
1561         {
1562             destination => $patron->smsalertnumber,
1563             message     => $message->{'content'},
1564         }
1565     );
1566
1567     if ($success) {
1568         _set_message_status(
1569             {
1570                 message_id   => $message->{'message_id'},
1571                 status       => 'sent',
1572                 failure_code => ''
1573             }
1574         );
1575     }
1576     else {
1577         _set_message_status(
1578             {
1579                 message_id   => $message->{'message_id'},
1580                 status       => 'failed',
1581                 failure_code => 'NO_NOTES'
1582             }
1583         );
1584     }
1585
1586     return $success;
1587 }
1588
1589 sub _update_message_to_address {
1590     my ($id, $to)= @_;
1591     my $dbh = C4::Context->dbh();
1592     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1593 }
1594
1595 sub _update_message_from_address {
1596     my ($message_id, $from_address) = @_;
1597     my $dbh = C4::Context->dbh();
1598     $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1599 }
1600
1601 sub _set_message_status {
1602     my $params = shift or return;
1603
1604     foreach my $required_parameter ( qw( message_id status ) ) {
1605         return unless exists $params->{ $required_parameter };
1606     }
1607
1608     my $dbh = C4::Context->dbh();
1609     my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1610     my $sth = $dbh->prepare( $statement );
1611     my $result = $sth->execute( $params->{'status'},
1612                                 $params->{'failure_code'} || '',
1613                                 $params->{'message_id'} );
1614     return $result;
1615 }
1616
1617 sub _process_tt {
1618     my ( $params ) = @_;
1619
1620     my $content = $params->{content};
1621     my $tables = $params->{tables};
1622     my $loops = $params->{loops};
1623     my $substitute = $params->{substitute} || {};
1624     my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1625     my ($theme, $availablethemes);
1626
1627     my $htdocs = C4::Context->config('intrahtdocs');
1628     ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1629     my @includes;
1630     foreach (@$availablethemes) {
1631         push @includes, "$htdocs/$_/$lang/includes";
1632         push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1633     }
1634
1635     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1636     my $template           = Template->new(
1637         {
1638             EVAL_PERL    => 1,
1639             ABSOLUTE     => 1,
1640             PLUGIN_BASE  => 'Koha::Template::Plugin',
1641             COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
1642             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1643             INCLUDE_PATH => \@includes,
1644             FILTERS      => {},
1645             ENCODING     => 'UTF-8',
1646         }
1647     ) or die Template->error();
1648
1649     my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1650
1651     $content = add_tt_filters( $content );
1652     $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1653
1654     my $output;
1655     $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1656
1657     return $output;
1658 }
1659
1660 sub _get_tt_params {
1661     my ($tables, $is_a_loop) = @_;
1662
1663     my $params;
1664     $is_a_loop ||= 0;
1665
1666     my $config = {
1667         article_requests => {
1668             module   => 'Koha::ArticleRequests',
1669             singular => 'article_request',
1670             plural   => 'article_requests',
1671             pk       => 'id',
1672         },
1673         aqbasket => {
1674             module   => 'Koha::Acquisition::Baskets',
1675             singular => 'basket',
1676             plural   => 'baskets',
1677             pk       => 'basketno',
1678         },
1679         biblio => {
1680             module   => 'Koha::Biblios',
1681             singular => 'biblio',
1682             plural   => 'biblios',
1683             pk       => 'biblionumber',
1684         },
1685         biblioitems => {
1686             module   => 'Koha::Biblioitems',
1687             singular => 'biblioitem',
1688             plural   => 'biblioitems',
1689             pk       => 'biblioitemnumber',
1690         },
1691         borrowers => {
1692             module   => 'Koha::Patrons',
1693             singular => 'borrower',
1694             plural   => 'borrowers',
1695             pk       => 'borrowernumber',
1696         },
1697         branches => {
1698             module   => 'Koha::Libraries',
1699             singular => 'branch',
1700             plural   => 'branches',
1701             pk       => 'branchcode',
1702         },
1703         credits => {
1704             module => 'Koha::Account::Lines',
1705             singular => 'credit',
1706             plural => 'credits',
1707             pk => 'accountlines_id',
1708         },
1709         debits => {
1710             module => 'Koha::Account::Lines',
1711             singular => 'debit',
1712             plural => 'debits',
1713             pk => 'accountlines_id',
1714         },
1715         items => {
1716             module   => 'Koha::Items',
1717             singular => 'item',
1718             plural   => 'items',
1719             pk       => 'itemnumber',
1720         },
1721         additional_contents => {
1722             module   => 'Koha::AdditionalContents',
1723             singular => 'additional_content',
1724             plural   => 'additional_contents',
1725             pk       => 'idnew',
1726         },
1727         opac_news => {
1728             module   => 'Koha::AdditionalContents',
1729             singular => 'news',
1730             plural   => 'news',
1731             pk       => 'idnew',
1732         },
1733         aqorders => {
1734             module   => 'Koha::Acquisition::Orders',
1735             singular => 'order',
1736             plural   => 'orders',
1737             pk       => 'ordernumber',
1738         },
1739         reserves => {
1740             module   => 'Koha::Holds',
1741             singular => 'hold',
1742             plural   => 'holds',
1743             pk       => 'reserve_id',
1744         },
1745         serial => {
1746             module   => 'Koha::Serials',
1747             singular => 'serial',
1748             plural   => 'serials',
1749             pk       => 'serialid',
1750         },
1751         subscription => {
1752             module   => 'Koha::Subscriptions',
1753             singular => 'subscription',
1754             plural   => 'subscriptions',
1755             pk       => 'subscriptionid',
1756         },
1757         suggestions => {
1758             module   => 'Koha::Suggestions',
1759             singular => 'suggestion',
1760             plural   => 'suggestions',
1761             pk       => 'suggestionid',
1762         },
1763         issues => {
1764             module   => 'Koha::Checkouts',
1765             singular => 'checkout',
1766             plural   => 'checkouts',
1767             fk       => 'itemnumber',
1768         },
1769         old_issues => {
1770             module   => 'Koha::Old::Checkouts',
1771             singular => 'old_checkout',
1772             plural   => 'old_checkouts',
1773             pk       => 'issue_id',
1774         },
1775         overdues => {
1776             module   => 'Koha::Checkouts',
1777             singular => 'overdue',
1778             plural   => 'overdues',
1779             fk       => 'itemnumber',
1780         },
1781         borrower_modifications => {
1782             module   => 'Koha::Patron::Modifications',
1783             singular => 'patron_modification',
1784             plural   => 'patron_modifications',
1785             fk       => 'verification_token',
1786         },
1787         illrequests => {
1788             module   => 'Koha::Illrequests',
1789             singular => 'illrequest',
1790             plural   => 'illrequests',
1791             pk       => 'illrequest_id'
1792         }
1793     };
1794
1795     foreach my $table ( keys %$tables ) {
1796         next unless $config->{$table};
1797
1798         my $ref = ref( $tables->{$table} ) || q{};
1799         my $module = $config->{$table}->{module};
1800
1801         if ( can_load( modules => { $module => undef } ) ) {
1802             my $pk = $config->{$table}->{pk};
1803             my $fk = $config->{$table}->{fk};
1804
1805             if ( $is_a_loop ) {
1806                 my $values = $tables->{$table} || [];
1807                 unless ( ref( $values ) eq 'ARRAY' ) {
1808                     croak "ERROR processing table $table. Wrong API call.";
1809                 }
1810                 my $key = $pk ? $pk : $fk;
1811                 # $key does not come from user input
1812                 my $objects = $module->search(
1813                     { $key => $values },
1814                     {
1815                             # We want to retrieve the data in the same order
1816                             # FIXME MySQLism
1817                             # field is a MySQLism, but they are no other way to do it
1818                             # To be generic we could do it in perl, but we will need to fetch
1819                             # all the data then order them
1820                         @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1821                     }
1822                 );
1823                 $params->{ $config->{$table}->{plural} } = $objects;
1824             }
1825             elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1826                 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1827                 my $object;
1828                 if ( $fk ) { # Using a foreign key for lookup
1829                     if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1830                         my $search;
1831                         foreach my $key ( @$fk ) {
1832                             $search->{$key} = $id->{$key};
1833                         }
1834                         $object = $module->search( $search )->last();
1835                     } else { # Foreign key is single column
1836                         $object = $module->search( { $fk => $id } )->last();
1837                     }
1838                 } else { # using the table's primary key for lookup
1839                     $object = $module->find($id);
1840                 }
1841                 $params->{ $config->{$table}->{singular} } = $object;
1842             }
1843             else {    # $ref eq 'ARRAY'
1844                 my $object;
1845                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
1846                     $object = $module->search( { $pk => $tables->{$table} } )->last();
1847                 }
1848                 else {                                  # Params are mutliple foreign keys
1849                     croak "Multiple foreign keys (table $table) should be passed using an hashref";
1850                 }
1851                 $params->{ $config->{$table}->{singular} } = $object;
1852             }
1853         }
1854         else {
1855             croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1856         }
1857     }
1858
1859     $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1860
1861     return $params;
1862 }
1863
1864 =head3 add_tt_filters
1865
1866 $content = add_tt_filters( $content );
1867
1868 Add TT filters to some specific fields if needed.
1869
1870 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1871
1872 =cut
1873
1874 sub add_tt_filters {
1875     my ( $content ) = @_;
1876     $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1877     $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1878     return $content;
1879 }
1880
1881 =head2 get_item_content
1882
1883     my $item = Koha::Items->find(...)->unblessed;
1884     my @item_content_fields = qw( date_due title barcode author itemnumber );
1885     my $item_content = C4::Letters::get_item_content({
1886                              item => $item,
1887                              item_content_fields => \@item_content_fields
1888                        });
1889
1890 This function generates a tab-separated list of values for the passed item. Dates
1891 are formatted following the current setup.
1892
1893 =cut
1894
1895 sub get_item_content {
1896     my ( $params ) = @_;
1897     my $item = $params->{item};
1898     my $dateonly = $params->{dateonly} || 0;
1899     my $item_content_fields = $params->{item_content_fields} || [];
1900
1901     return unless $item;
1902
1903     my @item_info = map {
1904         $_ =~ /^date|date$/
1905           ? eval {
1906             output_pref(
1907                 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1908           }
1909           : $item->{$_}
1910           || ''
1911     } @$item_content_fields;
1912     return join( "\t", @item_info ) . "\n";
1913 }
1914
1915 1;
1916 __END__