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 strict;
  21 use warnings;
  22
  23 use MIME::Lite;
  24 use Mail::Sendmail;
  25 use Date::Calc qw( Add_Delta_Days );
  26 use Encode;
  27 use Carp;
  28 use Template;
  29 use Module::Load::Conditional qw(can_load);
  30
  31 use C4::Members;
  32 use C4::Members::Attributes qw(GetBorrowerAttributes);
  33 use C4::Log;
  34 use C4::SMS;
  35 use C4::Debug;
  36 use Koha::DateUtils;
  37 use Koha::SMS::Providers;
  38
  39 use Koha::Email;
  40 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
  41
  42 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  43
  44 BEGIN {
  45     require Exporter;
  46     @ISA = qw(Exporter);
  47     @EXPORT = qw(
  48         &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
  49     );
  50 }
  51
  52 =head1 NAME
  53
  54 C4::Letters - Give functions for Letters management
  55
  56 =head1 SYNOPSIS
  57
  58   use C4::Letters;
  59
  60 =head1 DESCRIPTION
  61
  62   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  63   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)
  64
  65   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  66
  67 =head2 GetLetters([$module])
  68
  69   $letters = &GetLetters($module);
  70   returns informations about letters.
  71   if needed, $module filters for letters given module
  72
  73 =cut
  74
  75 sub GetLetters {
  76     my ($filters) = @_;
  77     my $module    = $filters->{module};
  78     my $code      = $filters->{code};
  79     my $branchcode = $filters->{branchcode};
  80     my $dbh       = C4::Context->dbh;
  81     my $letters   = $dbh->selectall_arrayref(
  82         q|
  83             SELECT module, code, branchcode, name
  84             FROM letter
  85             WHERE 1
  86         |
  87           . ( $module ? q| AND module = ?| : q|| )
  88           . ( $code   ? q| AND code = ?|   : q|| )
  89           . ( defined $branchcode   ? q| AND branchcode = ?|   : q|| )
  90           . q| GROUP BY code ORDER BY name|, { Slice => {} }
  91         , ( $module ? $module : () )
  92         , ( $code ? $code : () )
  93         , ( defined $branchcode ? $branchcode : () )
  94     );
  95
  96     return $letters;
  97 }
  98
  99 =head2 GetLetterTemplates
 100
 101     my $letter_templates = GetLetterTemplates(
 102         {
 103             module => 'circulation',
 104             code => 'my code',
 105             branchcode => 'CPL', # '' for default,
 106         }
 107     );
 108
 109     Return a hashref of letter templates.
 110     The key will be the message transport type.
 111
 112 =cut
 113
 114 sub GetLetterTemplates {
 115     my ( $params ) = @_;
 116
 117     my $module    = $params->{module};
 118     my $code      = $params->{code};
 119     my $branchcode = $params->{branchcode} // '';
 120     my $dbh       = C4::Context->dbh;
 121     my $letters   = $dbh->selectall_hashref(
 122         q|
 123             SELECT module, code, branchcode, name, is_html, title, content, message_transport_type
 124             FROM letter
 125             WHERE module = ?
 126             AND code = ?
 127             and branchcode = ?
 128         |
 129         , 'message_transport_type'
 130         , undef
 131         , $module, $code, $branchcode
 132     );
 133
 134     return $letters;
 135 }
 136
 137 =head2 GetLettersAvailableForALibrary
 138
 139     my $letters = GetLettersAvailableForALibrary(
 140         {
 141             branchcode => 'CPL', # '' for default
 142             module => 'circulation',
 143         }
 144     );
 145
 146     Return an arrayref of letters, sorted by name.
 147     If a specific letter exist for the given branchcode, it will be retrieve.
 148     Otherwise the default letter will be.
 149
 150 =cut
 151
 152 sub GetLettersAvailableForALibrary {
 153     my ($filters)  = @_;
 154     my $branchcode = $filters->{branchcode};
 155     my $module     = $filters->{module};
 156
 157     croak "module should be provided" unless $module;
 158
 159     my $dbh             = C4::Context->dbh;
 160     my $default_letters = $dbh->selectall_arrayref(
 161         q|
 162             SELECT module, code, branchcode, name
 163             FROM letter
 164             WHERE 1
 165         |
 166           . q| AND branchcode = ''|
 167           . ( $module ? q| AND module = ?| : q|| )
 168           . q| ORDER BY name|, { Slice => {} }
 169         , ( $module ? $module : () )
 170     );
 171
 172     my $specific_letters;
 173     if ($branchcode) {
 174         $specific_letters = $dbh->selectall_arrayref(
 175             q|
 176                 SELECT module, code, branchcode, name
 177                 FROM letter
 178                 WHERE 1
 179             |
 180               . q| AND branchcode = ?|
 181               . ( $module ? q| AND module = ?| : q|| )
 182               . q| ORDER BY name|, { Slice => {} }
 183             , $branchcode
 184             , ( $module ? $module : () )
 185         );
 186     }
 187
 188     my %letters;
 189     for my $l (@$default_letters) {
 190         $letters{ $l->{code} } = $l;
 191     }
 192     for my $l (@$specific_letters) {
 193         # Overwrite the default letter with the specific one.
 194         $letters{ $l->{code} } = $l;
 195     }
 196
 197     return [ map { $letters{$_} }
 198           sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
 199           keys %letters ];
 200
 201 }
 202
 203 sub getletter {
 204     my ( $module, $code, $branchcode, $message_transport_type ) = @_;
 205     $message_transport_type //= '%';
 206
 207     if ( C4::Context->preference('IndependentBranches')
 208             and $branchcode
 209             and C4::Context->userenv ) {
 210
 211         $branchcode = C4::Context->userenv->{'branch'};
 212     }
 213     $branchcode //= '';
 214
 215     my $dbh = C4::Context->dbh;
 216     my $sth = $dbh->prepare(q{
 217         SELECT *
 218         FROM letter
 219         WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
 220         AND message_transport_type LIKE ?
 221         ORDER BY branchcode DESC LIMIT 1
 222     });
 223     $sth->execute( $module, $code, $branchcode, $message_transport_type );
 224     my $line = $sth->fetchrow_hashref
 225       or return;
 226     $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
 227     return { %$line };
 228 }
 229
 230
 231 =head2 DelLetter
 232
 233     DelLetter(
 234         {
 235             branchcode => 'CPL',
 236             module => 'circulation',
 237             code => 'my code',
 238             [ mtt => 'email', ]
 239         }
 240     );
 241
 242     Delete the letter. The mtt parameter is facultative.
 243     If not given, all templates mathing the other parameters will be removed.
 244
 245 =cut
 246
 247 sub DelLetter {
 248     my ($params)   = @_;
 249     my $branchcode = $params->{branchcode};
 250     my $module     = $params->{module};
 251     my $code       = $params->{code};
 252     my $mtt        = $params->{mtt};
 253     my $dbh        = C4::Context->dbh;
 254     $dbh->do(q|
 255         DELETE FROM letter
 256         WHERE branchcode = ?
 257           AND module = ?
 258           AND code = ?
 259     | . ( $mtt ? q| AND message_transport_type = ?| : q|| )
 260     , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ) );
 261 }
 262
 263 =head2 addalert ($borrowernumber, $type, $externalid)
 264
 265     parameters :
 266     - $borrowernumber : the number of the borrower subscribing to the alert
 267     - $type : the type of alert.
 268     - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 269
 270     create an alert and return the alertid (primary key)
 271
 272 =cut
 273
 274 sub addalert {
 275     my ( $borrowernumber, $type, $externalid ) = @_;
 276     my $dbh = C4::Context->dbh;
 277     my $sth =
 278       $dbh->prepare(
 279         "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
 280     $sth->execute( $borrowernumber, $type, $externalid );
 281
 282     # get the alert number newly created and return it
 283     my $alertid = $dbh->{'mysql_insertid'};
 284     return $alertid;
 285 }
 286
 287 =head2 delalert ($alertid)
 288
 289     parameters :
 290     - alertid : the alert id
 291     deletes the alert
 292
 293 =cut
 294
 295 sub delalert {
 296     my $alertid = shift or die "delalert() called without valid argument (alertid)";    # it's gonna die anyway.
 297     $debug and warn "delalert: deleting alertid $alertid";
 298     my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
 299     $sth->execute($alertid);
 300 }
 301
 302 =head2 getalert ([$borrowernumber], [$type], [$externalid])
 303
 304     parameters :
 305     - $borrowernumber : the number of the borrower subscribing to the alert
 306     - $type : the type of alert.
 307     - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 308     all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic.
 309
 310 =cut
 311
 312 sub getalert {
 313     my ( $borrowernumber, $type, $externalid ) = @_;
 314     my $dbh   = C4::Context->dbh;
 315     my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
 316     my @bind;
 317     if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
 318         $query .= " AND borrowernumber=?";
 319         push @bind, $borrowernumber;
 320     }
 321     if ($type) {
 322         $query .= " AND type=?";
 323         push @bind, $type;
 324     }
 325     if ($externalid) {
 326         $query .= " AND externalid=?";
 327         push @bind, $externalid;
 328     }
 329     my $sth = $dbh->prepare($query);
 330     $sth->execute(@bind);
 331     return $sth->fetchall_arrayref({});
 332 }
 333
 334 =head2 findrelatedto($type, $externalid)
 335
 336     parameters :
 337     - $type : the type of alert
 338     - $externalid : the id of the "object" to query
 339
 340     In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert.
 341     When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 342
 343 =cut
 344
 345 # outmoded POD:
 346 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 347
 348 sub findrelatedto {
 349     my $type       = shift or return;
 350     my $externalid = shift or return;
 351     my $q = ($type eq 'issue'   ) ?
 352 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
 353             ($type eq 'borrower') ?
 354 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
 355     unless ($q) {
 356         warn "findrelatedto(): Illegal type '$type'";
 357         return;
 358     }
 359     my $sth = C4::Context->dbh->prepare($q);
 360     $sth->execute($externalid);
 361     my ($result) = $sth->fetchrow;
 362     return $result;
 363 }
 364
 365 =head2 SendAlerts
 366
 367     parameters :
 368     - $type : the type of alert
 369     - $externalid : the id of the "object" to query
 370     - $letter_code : the letter to send.
 371
 372     send an alert to all borrowers having put an alert on a given subject.
 373
 374     Returns undef or { error => 'message } on failure.
 375     Returns true on success.
 376
 377 =cut
 378
 379 sub SendAlerts {
 380     my ( $type, $externalid, $letter_code ) = @_;
 381     my $dbh = C4::Context->dbh;
 382     if ( $type eq 'issue' ) {
 383
 384         # prepare the letter...
 385         # search the subscriptionid
 386         my $sth =
 387           $dbh->prepare(
 388             "SELECT subscriptionid FROM serial WHERE serialid=?");
 389         $sth->execute($externalid);
 390         my ($subscriptionid) = $sth->fetchrow
 391           or warn( "No subscription for '$externalid'" ),
 392              return;
 393
 394         # search the biblionumber
 395         $sth =
 396           $dbh->prepare(
 397             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 398         $sth->execute($subscriptionid);
 399         my ($biblionumber) = $sth->fetchrow
 400           or warn( "No biblionumber for '$subscriptionid'" ),
 401              return;
 402
 403         my %letter;
 404         # find the list of borrowers to alert
 405         my $alerts = getalert( '', 'issue', $subscriptionid );
 406         foreach (@$alerts) {
 407             my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
 408             my $email = $borinfo->{email} or next;
 409
 410 #                    warn "sending issues...";
 411             my $userenv = C4::Context->userenv;
 412             my $library = Koha::Libraries->find( $_->{branchcode} );
 413             my $letter = GetPreparedLetter (
 414                 module => 'serial',
 415                 letter_code => $letter_code,
 416                 branchcode => $userenv->{branch},
 417                 tables => {
 418                     'branches'    => $_->{branchcode},
 419                     'biblio'      => $biblionumber,
 420                     'biblioitems' => $biblionumber,
 421                     'borrowers'   => $borinfo,
 422                     'subscription' => $subscriptionid,
 423                     'serial' => $externalid,
 424                 },
 425                 want_librarian => 1,
 426             ) or return;
 427
 428             # ... then send mail
 429             my $message = Koha::Email->new();
 430             my %mail = $message->create_message_headers(
 431                 {
 432                     to      => $email,
 433                     from    => $library->branchemail,
 434                     replyto => $library->branchreplyto,
 435                     sender  => $library->branchreturnpath,
 436                     subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
 437                     message => $letter->{'is_html'}
 438                                 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
 439                                               Encode::encode( "UTF-8", "" . $letter->{'title'} ))
 440                                 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
 441                     contenttype => $letter->{'is_html'}
 442                                     ? 'text/html; charset="utf-8"'
 443                                     : 'text/plain; charset="utf-8"',
 444                 }
 445             );
 446             unless( sendmail(%mail) ) {
 447                 carp $Mail::Sendmail::error;
 448                 return { error => $Mail::Sendmail::error };
 449             }
 450         }
 451     }
 452     elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
 453
 454         # prepare the letter...
 455         # search the biblionumber
 456         my $strsth =  $type eq 'claimacquisition'
 457             ? qq{
 458             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
 459             FROM aqorders
 460             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 461             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 462             LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
 463             WHERE aqorders.ordernumber IN (
 464             }
 465             : qq{
 466             SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*,
 467             aqbooksellers.id AS booksellerid
 468             FROM serial
 469             LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
 470             LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
 471             LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 472             WHERE serial.serialid IN (
 473             };
 474
 475         if (!@$externalid){
 476             carp "No Order selected";
 477             return { error => "no_order_selected" };
 478         }
 479
 480         $strsth .= join( ",", @$externalid ) . ")";
 481         my $sthorders = $dbh->prepare($strsth);
 482         $sthorders->execute;
 483         my $dataorders = $sthorders->fetchall_arrayref( {} );
 484
 485         my $sthbookseller =
 486           $dbh->prepare("select * from aqbooksellers where id=?");
 487         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 488         my $databookseller = $sthbookseller->fetchrow_hashref;
 489         my $addressee =  $type eq 'claimacquisition' ? 'acqprimary' : 'serialsprimary';
 490         my $sthcontact =
 491           $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
 492         $sthcontact->execute( $dataorders->[0]->{booksellerid} );
 493         my $datacontact = $sthcontact->fetchrow_hashref;
 494
 495         my @email;
 496         my @cc;
 497         push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
 498         push @email, $datacontact->{email}           if ( $datacontact && $datacontact->{email} );
 499         unless (@email) {
 500             warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
 501             return { error => "no_email" };
 502         }
 503         my $addlcontact;
 504         while ($addlcontact = $sthcontact->fetchrow_hashref) {
 505             push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
 506         }
 507
 508         my $userenv = C4::Context->userenv;
 509         my $letter = GetPreparedLetter (
 510             module => $type,
 511             letter_code => $letter_code,
 512             branchcode => $userenv->{branch},
 513             tables => {
 514                 'branches'    => $userenv->{branch},
 515                 'aqbooksellers' => $databookseller,
 516                 'aqcontacts'    => $datacontact,
 517             },
 518             repeat => $dataorders,
 519             want_librarian => 1,
 520         ) or return;
 521
 522         # Remove the order tag
 523         $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
 524
 525         # ... then send mail
 526         my %mail = (
 527             To => join( ',', @email),
 528             Cc             => join( ',', @cc),
 529             From           => $userenv->{emailaddress},
 530             Subject        => Encode::encode( "UTF-8", "" . $letter->{title} ),
 531             Message => $letter->{'is_html'}
 532                             ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
 533                                           Encode::encode( "UTF-8", "" . $letter->{'title'} ))
 534                             : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
 535             'Content-Type' => $letter->{'is_html'}
 536                                 ? 'text/html; charset="utf-8"'
 537                                 : 'text/plain; charset="utf-8"',
 538         );
 539
 540         $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
 541           if C4::Context->preference('ReplytoDefault');
 542         $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
 543           if C4::Context->preference('ReturnpathDefault');
 544         $mail{'Bcc'} = $userenv->{emailaddress}
 545           if C4::Context->preference("ClaimsBccCopy");
 546
 547         unless ( sendmail(%mail) ) {
 548             carp $Mail::Sendmail::error;
 549             return { error => $Mail::Sendmail::error };
 550         }
 551
 552         logaction(
 553             "ACQUISITION",
 554             $type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM",
 555             undef,
 556             "To="
 557                 . join( ',', @email )
 558                 . " Title="
 559                 . $letter->{title}
 560                 . " Content="
 561                 . $letter->{content}
 562         ) if C4::Context->preference("LetterLog");
 563     }
 564    # send an "account details" notice to a newly created user
 565     elsif ( $type eq 'members' ) {
 566         my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
 567         my $letter = GetPreparedLetter (
 568             module => 'members',
 569             letter_code => $letter_code,
 570             branchcode => $externalid->{'branchcode'},
 571             tables => {
 572                 'branches'    => $library,
 573                 'borrowers' => $externalid->{'borrowernumber'},
 574             },
 575             substitute => { 'borrowers.password' => $externalid->{'password'} },
 576             want_librarian => 1,
 577         ) or return;
 578         return { error => "no_email" } unless $externalid->{'emailaddr'};
 579         my $email = Koha::Email->new();
 580         my %mail  = $email->create_message_headers(
 581             {
 582                 to      => $externalid->{'emailaddr'},
 583                 from    => $library->{branchemail},
 584                 replyto => $library->{branchreplyto},
 585                 sender  => $library->{branchreturnpath},
 586                 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
 587                 message => $letter->{'is_html'}
 588                             ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
 589                                           Encode::encode( "UTF-8", "" . $letter->{'title'}  ) )
 590                             : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
 591                 contenttype => $letter->{'is_html'}
 592                                 ? 'text/html; charset="utf-8"'
 593                                 : 'text/plain; charset="utf-8"',
 594             }
 595         );
 596         unless( sendmail(%mail) ) {
 597             carp $Mail::Sendmail::error;
 598             return { error => $Mail::Sendmail::error };
 599         }
 600     }
 601
 602     # If we come here, return an OK status
 603     return 1;
 604 }
 605
 606 =head2 GetPreparedLetter( %params )
 607
 608     %params hash:
 609       module => letter module, mandatory
 610       letter_code => letter code, mandatory
 611       branchcode => for letter selection, if missing default system letter taken
 612       tables => a hashref with table names as keys. Values are either:
 613         - a scalar - primary key value
 614         - an arrayref - primary key values
 615         - a hashref - full record
 616       substitute => custom substitution key/value pairs
 617       repeat => records to be substituted on consecutive lines:
 618         - an arrayref - tries to guess what needs substituting by
 619           taking remaining << >> tokensr; not recommended
 620         - a hashref token => @tables - replaces <token> << >> << >> </token>
 621           subtemplate for each @tables row; table is a hashref as above
 622       want_librarian => boolean,  if set to true triggers librarian details
 623         substitution from the userenv
 624     Return value:
 625       letter fields hashref (title & content useful)
 626
 627 =cut
 628
 629 sub GetPreparedLetter {
 630     my %params = @_;
 631
 632     my $module      = $params{module} or croak "No module";
 633     my $letter_code = $params{letter_code} or croak "No letter_code";
 634     my $branchcode  = $params{branchcode} || '';
 635     my $mtt         = $params{message_transport_type} || 'email';
 636
 637     my $letter = getletter( $module, $letter_code, $branchcode, $mtt )
 638         or warn( "No $module $letter_code letter transported by " . $mtt ),
 639             return;
 640
 641     my $tables = $params{tables};
 642     my $substitute = $params{substitute};
 643     my $repeat = $params{repeat};
 644     $tables || $substitute || $repeat
 645       or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ),
 646          return;
 647     my $want_librarian = $params{want_librarian};
 648
 649     if ($substitute) {
 650         while ( my ($token, $val) = each %$substitute ) {
 651             if ( $token eq 'items.content' ) {
 652                 $val =~ s|\n|<br/>|g if $letter->{is_html};
 653             }
 654
 655             $letter->{title} =~ s/<<$token>>/$val/g;
 656             $letter->{content} =~ s/<<$token>>/$val/g;
 657        }
 658     }
 659
 660     my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
 661     $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
 662
 663     if ($want_librarian) {
 664         # parsing librarian name
 665         my $userenv = C4::Context->userenv;
 666         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
 667         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
 668         $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
 669     }
 670
 671     my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
 672
 673     if ($repeat) {
 674         if (ref ($repeat) eq 'ARRAY' ) {
 675             $repeat_no_enclosing_tags = $repeat;
 676         } else {
 677             $repeat_enclosing_tags = $repeat;
 678         }
 679     }
 680
 681     if ($repeat_enclosing_tags) {
 682         while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
 683             if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
 684                 my $subcontent = $1;
 685                 my @lines = map {
 686                     my %subletter = ( title => '', content => $subcontent );
 687                     _substitute_tables( \%subletter, $_ );
 688                     $subletter{content};
 689                 } @$tag_tables;
 690                 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
 691             }
 692         }
 693     }
 694
 695     if ($tables) {
 696         _substitute_tables( $letter, $tables );
 697     }
 698
 699     if ($repeat_no_enclosing_tags) {
 700         if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
 701             my $line = $&;
 702             my $i = 1;
 703             my @lines = map {
 704                 my $c = $line;
 705                 $c =~ s/<<count>>/$i/go;
 706                 foreach my $field ( keys %{$_} ) {
 707                     $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
 708                 }
 709                 $i++;
 710                 $c;
 711             } @$repeat_no_enclosing_tags;
 712
 713             my $replaceby = join( "\n", @lines );
 714             $letter->{content} =~ s/\Q$line\E/$replaceby/s;
 715         }
 716     }
 717
 718     $letter->{content} = _process_tt(
 719         {
 720             content => $letter->{content},
 721             tables  => $tables,
 722         }
 723     );
 724
 725     $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
 726
 727     return $letter;
 728 }
 729
 730 sub _substitute_tables {
 731     my ( $letter, $tables ) = @_;
 732     while ( my ($table, $param) = each %$tables ) {
 733         next unless $param;
 734
 735         my $ref = ref $param;
 736
 737         my $values;
 738         if ($ref && $ref eq 'HASH') {
 739             $values = $param;
 740         }
 741         else {
 742             my $sth = _parseletter_sth($table);
 743             unless ($sth) {
 744                 warn "_parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 745                 return;
 746             }
 747             $sth->execute( $ref ? @$param : $param );
 748
 749             $values = $sth->fetchrow_hashref;
 750             $sth->finish();
 751         }
 752
 753         _parseletter ( $letter, $table, $values );
 754     }
 755 }
 756
 757 sub _parseletter_sth {
 758     my $table = shift;
 759     my $sth;
 760     unless ($table) {
 761         carp "ERROR: _parseletter_sth() called without argument (table)";
 762         return;
 763     }
 764     # NOTE: we used to check whether we had a statement handle cached in
 765     #       a %handles module-level variable. This was a dumb move and
 766     #       broke things for the rest of us. prepare_cached is a better
 767     #       way to cache statement handles anyway.
 768     my $query =
 769     ($table eq 'biblio'       )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
 770     ($table eq 'biblioitems'  )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
 771     ($table eq 'items'        )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 772     ($table eq 'issues'       )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 773     ($table eq 'old_issues'   )    ? "SELECT * FROM $table WHERE     itemnumber = ? ORDER BY timestamp DESC LIMIT 1"  :
 774     ($table eq 'reserves'     )    ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?"             :
 775     ($table eq 'borrowers'    )    ? "SELECT * FROM $table WHERE borrowernumber = ?"                                  :
 776     ($table eq 'branches'     )    ? "SELECT * FROM $table WHERE     branchcode = ?"                                  :
 777     ($table eq 'suggestions'  )    ? "SELECT * FROM $table WHERE   suggestionid = ?"                                  :
 778     ($table eq 'aqbooksellers')    ? "SELECT * FROM $table WHERE             id = ?"                                  :
 779     ($table eq 'aqorders'     )    ? "SELECT * FROM $table WHERE    ordernumber = ?"                                  :
 780     ($table eq 'opac_news'    )    ? "SELECT * FROM $table WHERE          idnew = ?"                                  :
 781     ($table eq 'article_requests') ? "SELECT * FROM $table WHERE             id = ?"                                  :
 782     ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
 783     ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
 784     ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
 785     undef ;
 786     unless ($query) {
 787         warn "ERROR: No _parseletter_sth query for table '$table'";
 788         return;     # nothing to get
 789     }
 790     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
 791         warn "ERROR: Failed to prepare query: '$query'";
 792         return;
 793     }
 794     return $sth;    # now cache is populated for that $table
 795 }
 796
 797 =head2 _parseletter($letter, $table, $values)
 798
 799     parameters :
 800     - $letter : a hash to letter fields (title & content useful)
 801     - $table : the Koha table to parse.
 802     - $values_in : table record hashref
 803     parse all fields from a table, and replace values in title & content with the appropriate value
 804     (not exported sub, used only internally)
 805
 806 =cut
 807
 808 sub _parseletter {
 809     my ( $letter, $table, $values_in ) = @_;
 810
 811     # Work on a local copy of $values_in (passed by reference) to avoid side effects
 812     # in callers ( by changing / formatting values )
 813     my $values = $values_in ? { %$values_in } : {};
 814
 815     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
 816         $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
 817     }
 818
 819     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 820         my @waitingdate = split /-/, $values->{'waitingdate'};
 821
 822         $values->{'expirationdate'} = '';
 823         if ( C4::Context->preference('ReservesMaxPickUpDelay') ) {
 824             my $dt = dt_from_string();
 825             $dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') );
 826             $values->{'expirationdate'} = output_pref( { dt => $dt, dateonly => 1 } );
 827         }
 828
 829         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
 830
 831     }
 832
 833     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
 834         my $todaysdate = output_pref( DateTime->now() );
 835         $letter->{content} =~ s/<<today>>/$todaysdate/go;
 836     }
 837
 838     while ( my ($field, $val) = each %$values ) {
 839         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
 840             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
 841             #Therefore adding the test on biblio. This includes biblioitems,
 842             #but excludes items. Removed unneeded global and lookahead.
 843
 844         if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
 845             my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
 846             $val = $av->count ? $av->next->lib : '';
 847         }
 848
 849         # Dates replacement
 850         my $replacedby   = defined ($val) ? $val : '';
 851         if (    $replacedby
 852             and not $replacedby =~ m|0000-00-00|
 853             and not $replacedby =~ m|9999-12-31|
 854             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
 855         {
 856             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
 857             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
 858             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
 859
 860             for my $letter_field ( qw( title content ) ) {
 861                 my $filter_string_used = q{};
 862                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
 863                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
 864                     $filter_string_used = $1 || q{};
 865                     $dateonly = $1 unless $dateonly;
 866                 }
 867                 my $replacedby_date = eval {
 868                     output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
 869                 };
 870
 871                 if ( $letter->{ $letter_field } ) {
 872                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
 873                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
 874                 }
 875             }
 876         }
 877         # Other fields replacement
 878         else {
 879             for my $letter_field ( qw( title content ) ) {
 880                 if ( $letter->{ $letter_field } ) {
 881                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
 882                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
 883                 }
 884             }
 885         }
 886     }
 887
 888     if ($table eq 'borrowers' && $letter->{content}) {
 889         if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
 890             my %attr;
 891             foreach (@$attributes) {
 892                 my $code = $_->{code};
 893                 my $val  = $_->{value_description} || $_->{value};
 894                 $val =~ s/\p{P}(?=$)//g if $val;
 895                 next unless $val gt '';
 896                 $attr{$code} ||= [];
 897                 push @{ $attr{$code} }, $val;
 898             }
 899             while ( my ($code, $val_ar) = each %attr ) {
 900                 my $replacefield = "<<borrower-attribute:$code>>";
 901                 my $replacedby   = join ',', @$val_ar;
 902                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 903             }
 904         }
 905     }
 906     return $letter;
 907 }
 908
 909 =head2 EnqueueLetter
 910
 911   my $success = EnqueueLetter( { letter => $letter,
 912         borrowernumber => '12', message_transport_type => 'email' } )
 913
 914 places a letter in the message_queue database table, which will
 915 eventually get processed (sent) by the process_message_queue.pl
 916 cronjob when it calls SendQueuedMessages.
 917
 918 return message_id on success
 919
 920 =cut
 921
 922 sub EnqueueLetter {
 923     my $params = shift or return;
 924
 925     return unless exists $params->{'letter'};
 926 #   return unless exists $params->{'borrowernumber'};
 927     return unless exists $params->{'message_transport_type'};
 928
 929     my $content = $params->{letter}->{content};
 930     $content =~ s/\s+//g if(defined $content);
 931     if ( not defined $content or $content eq '' ) {
 932         warn "Trying to add an empty message to the message queue" if $debug;
 933         return;
 934     }
 935
 936     # If we have any attachments we should encode then into the body.
 937     if ( $params->{'attachments'} ) {
 938         $params->{'letter'} = _add_attachments(
 939             {   letter      => $params->{'letter'},
 940                 attachments => $params->{'attachments'},
 941                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 942             }
 943         );
 944     }
 945
 946     my $dbh       = C4::Context->dbh();
 947     my $statement = << 'ENDSQL';
 948 INSERT INTO message_queue
 949 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 950 VALUES
 951 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 952 ENDSQL
 953
 954     my $sth    = $dbh->prepare($statement);
 955     my $result = $sth->execute(
 956         $params->{'borrowernumber'},              # borrowernumber
 957         $params->{'letter'}->{'title'},           # subject
 958         $params->{'letter'}->{'content'},         # content
 959         $params->{'letter'}->{'metadata'} || '',  # metadata
 960         $params->{'letter'}->{'code'}     || '',  # letter_code
 961         $params->{'message_transport_type'},      # message_transport_type
 962         'pending',                                # status
 963         $params->{'to_address'},                  # to_address
 964         $params->{'from_address'},                # from_address
 965         $params->{'letter'}->{'content-type'},    # content_type
 966     );
 967     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 968 }
 969
 970 =head2 SendQueuedMessages ([$hashref])
 971
 972   my $sent = SendQueuedMessages( { verbose => 1 } );
 973
 974 sends all of the 'pending' items in the message queue.
 975
 976 returns number of messages sent.
 977
 978 =cut
 979
 980 sub SendQueuedMessages {
 981     my $params = shift;
 982
 983     my $unsent_messages = _get_unsent_messages();
 984     MESSAGE: foreach my $message ( @$unsent_messages ) {
 985         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 986         warn sprintf( 'sending %s message to patron: %s',
 987                       $message->{'message_transport_type'},
 988                       $message->{'borrowernumber'} || 'Admin' )
 989           if $params->{'verbose'} or $debug;
 990         # This is just begging for subclassing
 991         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 992         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 993             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 994         }
 995         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 996             if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
 997                 my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 998                 my $sms_provider = Koha::SMS::Providers->find( $member->{'sms_provider_id'} );
 999                 $message->{to_address} .= '@' . $sms_provider->domain();
1000                 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1001             } else {
1002                 _send_message_by_sms( $message );
1003             }
1004         }
1005     }
1006     return scalar( @$unsent_messages );
1007 }
1008
1009 =head2 GetRSSMessages
1010
1011   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1012
1013 returns a listref of all queued RSS messages for a particular person.
1014
1015 =cut
1016
1017 sub GetRSSMessages {
1018     my $params = shift;
1019
1020     return unless $params;
1021     return unless ref $params;
1022     return unless $params->{'borrowernumber'};
1023
1024     return _get_unsent_messages( { message_transport_type => 'rss',
1025                                    limit                  => $params->{'limit'},
1026                                    borrowernumber         => $params->{'borrowernumber'}, } );
1027 }
1028
1029 =head2 GetPrintMessages
1030
1031   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1032
1033 Returns a arrayref of all queued print messages (optionally, for a particular
1034 person).
1035
1036 =cut
1037
1038 sub GetPrintMessages {
1039     my $params = shift || {};
1040
1041     return _get_unsent_messages( { message_transport_type => 'print',
1042                                    borrowernumber         => $params->{'borrowernumber'},
1043                                  } );
1044 }
1045
1046 =head2 GetQueuedMessages ([$hashref])
1047
1048   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1049
1050 fetches messages out of the message queue.
1051
1052 returns:
1053 list of hashes, each has represents a message in the message queue.
1054
1055 =cut
1056
1057 sub GetQueuedMessages {
1058     my $params = shift;
1059
1060     my $dbh = C4::Context->dbh();
1061     my $statement = << 'ENDSQL';
1062 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1063 FROM message_queue
1064 ENDSQL
1065
1066     my @query_params;
1067     my @whereclauses;
1068     if ( exists $params->{'borrowernumber'} ) {
1069         push @whereclauses, ' borrowernumber = ? ';
1070         push @query_params, $params->{'borrowernumber'};
1071     }
1072
1073     if ( @whereclauses ) {
1074         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1075     }
1076
1077     if ( defined $params->{'limit'} ) {
1078         $statement .= ' LIMIT ? ';
1079         push @query_params, $params->{'limit'};
1080     }
1081
1082     my $sth = $dbh->prepare( $statement );
1083     my $result = $sth->execute( @query_params );
1084     return $sth->fetchall_arrayref({});
1085 }
1086
1087 =head2 GetMessageTransportTypes
1088
1089   my @mtt = GetMessageTransportTypes();
1090
1091   returns an arrayref of transport types
1092
1093 =cut
1094
1095 sub GetMessageTransportTypes {
1096     my $dbh = C4::Context->dbh();
1097     my $mtts = $dbh->selectcol_arrayref("
1098         SELECT message_transport_type
1099         FROM message_transport_types
1100         ORDER BY message_transport_type
1101     ");
1102     return $mtts;
1103 }
1104
1105 =head2 GetMessage
1106
1107     my $message = C4::Letters::Message($message_id);
1108
1109 =cut
1110
1111 sub GetMessage {
1112     my ( $message_id ) = @_;
1113     return unless $message_id;
1114     my $dbh = C4::Context->dbh;
1115     return $dbh->selectrow_hashref(q|
1116         SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1117         FROM message_queue
1118         WHERE message_id = ?
1119     |, {}, $message_id );
1120 }
1121
1122 =head2 ResendMessage
1123
1124   Attempt to resend a message which has failed previously.
1125
1126   my $has_been_resent = C4::Letters::ResendMessage($message_id);
1127
1128   Updates the message to 'pending' status so that
1129   it will be resent later on.
1130
1131   returns 1 on success, 0 on failure, undef if no message was found
1132
1133 =cut
1134
1135 sub ResendMessage {
1136     my $message_id = shift;
1137     return unless $message_id;
1138
1139     my $message = GetMessage( $message_id );
1140     return unless $message;
1141     my $rv = 0;
1142     if ( $message->{status} ne 'pending' ) {
1143         $rv = C4::Letters::_set_message_status({
1144             message_id => $message_id,
1145             status => 'pending',
1146         });
1147         $rv = $rv > 0? 1: 0;
1148         # Clear destination email address to force address update
1149         _update_message_to_address( $message_id, undef ) if $rv &&
1150             $message->{message_transport_type} eq 'email';
1151     }
1152     return $rv;
1153 }
1154
1155 =head2 _add_attachements
1156
1157 named parameters:
1158 letter - the standard letter hashref
1159 attachments - listref of attachments. each attachment is a hashref of:
1160   type - the mime type, like 'text/plain'
1161   content - the actual attachment
1162   filename - the name of the attachment.
1163 message - a MIME::Lite object to attach these to.
1164
1165 returns your letter object, with the content updated.
1166
1167 =cut
1168
1169 sub _add_attachments {
1170     my $params = shift;
1171
1172     my $letter = $params->{'letter'};
1173     my $attachments = $params->{'attachments'};
1174     return $letter unless @$attachments;
1175     my $message = $params->{'message'};
1176
1177     # First, we have to put the body in as the first attachment
1178     $message->attach(
1179         Type => $letter->{'content-type'} || 'TEXT',
1180         Data => $letter->{'is_html'}
1181             ? _wrap_html($letter->{'content'}, $letter->{'title'})
1182             : $letter->{'content'},
1183     );
1184
1185     foreach my $attachment ( @$attachments ) {
1186         $message->attach(
1187             Type     => $attachment->{'type'},
1188             Data     => $attachment->{'content'},
1189             Filename => $attachment->{'filename'},
1190         );
1191     }
1192     # we're forcing list context here to get the header, not the count back from grep.
1193     ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1194     $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1195     $letter->{'content'} = $message->body_as_string;
1196
1197     return $letter;
1198
1199 }
1200
1201 sub _get_unsent_messages {
1202     my $params = shift;
1203
1204     my $dbh = C4::Context->dbh();
1205     my $statement = << 'ENDSQL';
1206 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code
1207   FROM message_queue mq
1208   LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1209  WHERE status = ?
1210 ENDSQL
1211
1212     my @query_params = ('pending');
1213     if ( ref $params ) {
1214         if ( $params->{'message_transport_type'} ) {
1215             $statement .= ' AND message_transport_type = ? ';
1216             push @query_params, $params->{'message_transport_type'};
1217         }
1218         if ( $params->{'borrowernumber'} ) {
1219             $statement .= ' AND borrowernumber = ? ';
1220             push @query_params, $params->{'borrowernumber'};
1221         }
1222         if ( $params->{'limit'} ) {
1223             $statement .= ' limit ? ';
1224             push @query_params, $params->{'limit'};
1225         }
1226     }
1227
1228     $debug and warn "_get_unsent_messages SQL: $statement";
1229     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1230     my $sth = $dbh->prepare( $statement );
1231     my $result = $sth->execute( @query_params );
1232     return $sth->fetchall_arrayref({});
1233 }
1234
1235 sub _send_message_by_email {
1236     my $message = shift or return;
1237     my ($username, $password, $method) = @_;
1238
1239     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
1240     my $to_address = $message->{'to_address'};
1241     unless ($to_address) {
1242         unless ($member) {
1243             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1244             _set_message_status( { message_id => $message->{'message_id'},
1245                                    status     => 'failed' } );
1246             return;
1247         }
1248         $to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} );
1249         unless ($to_address) {
1250             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1251             # warning too verbose for this more common case?
1252             _set_message_status( { message_id => $message->{'message_id'},
1253                                    status     => 'failed' } );
1254             return;
1255         }
1256     }
1257
1258     my $utf8   = decode('MIME-Header', $message->{'subject'} );
1259     $message->{subject}= encode('MIME-Header', $utf8);
1260     my $subject = encode('UTF-8', $message->{'subject'});
1261     my $content = encode('UTF-8', $message->{'content'});
1262     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1263     my $is_html = $content_type =~ m/html/io;
1264     my $branch_email = undef;
1265     my $branch_replyto = undef;
1266     my $branch_returnpath = undef;
1267     if ($member) {
1268         my $library = Koha::Libraries->find( $member->{branchcode} );
1269         $branch_email      = $library->branchemail;
1270         $branch_replyto    = $library->branchreplyto;
1271         $branch_returnpath = $library->branchreturnpath;
1272     }
1273     my $email = Koha::Email->new();
1274     my %sendmail_params = $email->create_message_headers(
1275         {
1276             to      => $to_address,
1277             from    => $message->{'from_address'} || $branch_email,
1278             replyto => $branch_replyto,
1279             sender  => $branch_returnpath,
1280             subject => $subject,
1281             message => $is_html ? _wrap_html( $content, $subject ) : $content,
1282             contenttype => $content_type
1283         }
1284     );
1285
1286     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1287     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
1288        $sendmail_params{ Bcc } = $bcc;
1289     }
1290
1291     _update_message_to_address($message->{'message_id'},$to_address) unless $message->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated
1292
1293     if ( sendmail( %sendmail_params ) ) {
1294         _set_message_status( { message_id => $message->{'message_id'},
1295                 status     => 'sent' } );
1296         return 1;
1297     } else {
1298         _set_message_status( { message_id => $message->{'message_id'},
1299                 status     => 'failed' } );
1300         carp $Mail::Sendmail::error;
1301         return;
1302     }
1303 }
1304
1305 sub _wrap_html {
1306     my ($content, $title) = @_;
1307
1308     my $css = C4::Context->preference("NoticeCSS") || '';
1309     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1310     return <<EOS;
1311 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1312     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1313 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1314 <head>
1315 <title>$title</title>
1316 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1317 $css
1318 </head>
1319 <body>
1320 $content
1321 </body>
1322 </html>
1323 EOS
1324 }
1325
1326 sub _is_duplicate {
1327     my ( $message ) = @_;
1328     my $dbh = C4::Context->dbh;
1329     my $count = $dbh->selectrow_array(q|
1330         SELECT COUNT(*)
1331         FROM message_queue
1332         WHERE message_transport_type = ?
1333         AND borrowernumber = ?
1334         AND letter_code = ?
1335         AND CAST(time_queued AS date) = CAST(NOW() AS date)
1336         AND status="sent"
1337         AND content = ?
1338     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1339     return $count;
1340 }
1341
1342 sub _send_message_by_sms {
1343     my $message = shift or return;
1344     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
1345
1346     unless ( $member->{smsalertnumber} ) {
1347         _set_message_status( { message_id => $message->{'message_id'},
1348                                status     => 'failed' } );
1349         return;
1350     }
1351
1352     if ( _is_duplicate( $message ) ) {
1353         _set_message_status( { message_id => $message->{'message_id'},
1354                                status     => 'failed' } );
1355         return;
1356     }
1357
1358     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
1359                                        message     => $message->{'content'},
1360                                      } );
1361     _set_message_status( { message_id => $message->{'message_id'},
1362                            status     => ($success ? 'sent' : 'failed') } );
1363     return $success;
1364 }
1365
1366 sub _update_message_to_address {
1367     my ($id, $to)= @_;
1368     my $dbh = C4::Context->dbh();
1369     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1370 }
1371
1372 sub _set_message_status {
1373     my $params = shift or return;
1374
1375     foreach my $required_parameter ( qw( message_id status ) ) {
1376         return unless exists $params->{ $required_parameter };
1377     }
1378
1379     my $dbh = C4::Context->dbh();
1380     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1381     my $sth = $dbh->prepare( $statement );
1382     my $result = $sth->execute( $params->{'status'},
1383                                 $params->{'message_id'} );
1384     return $result;
1385 }
1386
1387 sub _process_tt {
1388     my ( $params ) = @_;
1389
1390     my $content = $params->{content};
1391     my $tables = $params->{tables};
1392
1393     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1394     my $template           = Template->new(
1395         {
1396             EVAL_PERL    => 1,
1397             ABSOLUTE     => 1,
1398             PLUGIN_BASE  => 'Koha::Template::Plugin',
1399             COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
1400             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1401             FILTERS      => {},
1402             ENCODING     => 'UTF-8',
1403         }
1404     ) or die Template->error();
1405
1406     my $tt_params = _get_tt_params( $tables );
1407
1408     my $output;
1409     $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1410
1411     return $output;
1412 }
1413
1414 sub _get_tt_params {
1415     my ($tables) = @_;
1416
1417     my $params;
1418
1419     my $config = {
1420         biblio => {
1421             module   => 'Koha::Biblios',
1422             singular => 'biblio',
1423             plural   => 'biblios',
1424             pk       => 'biblionumber',
1425         },
1426         borrowers => {
1427             module   => 'Koha::Patrons',
1428             singular => 'borrower',
1429             plural   => 'borrowers',
1430             pk       => 'borrowernumber',
1431         },
1432         branches => {
1433             module   => 'Koha::Libraries',
1434             singular => 'branch',
1435             plural   => 'branches',
1436             pk       => 'branchcode',
1437         },
1438         items => {
1439             module   => 'Koha::Items',
1440             singular => 'item',
1441             plural   => 'items',
1442             pk       => 'itemnumber',
1443         },
1444         opac_news => {
1445             module   => 'Koha::News',
1446             singular => 'news',
1447             plural   => 'news',
1448             pk       => 'idnew',
1449         },
1450         reserves => {
1451             module   => 'Koha::Holds',
1452             singular => 'hold',
1453             plural   => 'holds',
1454             fk       => [ 'borrowernumber', 'biblionumber' ],
1455         },
1456         serial => {
1457             module   => 'Koha::Serials',
1458             singular => 'serial',
1459             plural   => 'serials',
1460             pk       => 'serialid',
1461         },
1462         subscription => {
1463             module   => 'Koha::Subscriptions',
1464             singular => 'subscription',
1465             plural   => 'subscriptions',
1466             pk       => 'subscriptionid',
1467         },
1468         suggestions => {
1469             module   => 'Koha::Suggestions',
1470             singular => 'suggestion',
1471             plural   => 'suggestions',
1472             pk       => 'suggestionid',
1473         },
1474         issues => {
1475             module   => 'Koha::Checkouts',
1476             singular => 'checkout',
1477             plural   => 'checkouts',
1478             fk       => 'itemnumber',
1479         },
1480         borrower_modifications => {
1481             module   => 'Koha::Patron::Modifications',
1482             singular => 'patron_modification',
1483             plural   => 'patron_modifications',
1484             fk       => 'verification_token',
1485         },
1486     };
1487
1488     foreach my $table ( keys %$tables ) {
1489         next unless $config->{$table};
1490
1491         my $ref = ref( $tables->{$table} ) || q{};
1492         my $module = $config->{$table}->{module};
1493
1494         if ( can_load( modules => { $module => undef } ) ) {
1495             my $pk = $config->{$table}->{pk};
1496             my $fk = $config->{$table}->{fk};
1497
1498             if ( $ref eq q{} || $ref eq 'HASH' ) {
1499                 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1500                 my $object;
1501                 if ( $fk ) { # Using a foreign key for lookup
1502                     if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1503                         my $search;
1504                         foreach my $key ( @$fk ) {
1505                             $search->{$key} = $id->{$key};
1506                         }
1507                         $object = $module->search( $search )->next();
1508                     } else { # Foreign key is single column
1509                         $object = $module->search( { $fk => $id } )->next();
1510                     }
1511                 } else { # using the table's primary key for lookup
1512                     $object = $module->find($id);
1513                 }
1514                 $params->{ $config->{$table}->{singular} } = $object;
1515             }
1516             else {    # $ref eq 'ARRAY'
1517                 my $object;
1518                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
1519                     $object = $module->search( { $pk => $tables->{$table} } )->next();
1520                 }
1521                 else {                                  # Params are mutliple foreign keys
1522                     my @values = @{ $tables->{$table} };
1523                     my @keys   = @{ $config->{$table}->{fk} };
1524                     my %params = map { $_ => shift(@values) } @keys;
1525                     $object = $module->search( \%params )->next();
1526                 }
1527                 $params->{ $config->{$table}->{singular} } = $object;
1528             }
1529         }
1530         else {
1531             croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1532         }
1533     }
1534
1535     $params->{today} = dt_from_string();
1536
1537     return $params;
1538 }
1539
1540
1541 1;
1542 __END__