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