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