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