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
  26 use C4::Koha qw(GetAuthorisedValueByCode);
  27 use C4::Members;
  28 use C4::Members::Attributes qw(GetBorrowerAttributes);
  29 use C4::Branch;
  30 use C4::Log;
  31 use C4::SMS;
  32 use C4::Debug;
  33 use Koha::DateUtils;
  34 use Koha::SMS::Providers;
  35
  36 use Date::Calc qw( Add_Delta_Days );
  37 use Encode;
  38 use Carp;
  39 use Koha::Email;
  40 use Koha::DateUtils qw( format_sqldatetime );
  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";
 316     my @bind;
 317     if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
 318         $query .= " borrowernumber=? AND ";
 319         push @bind, $borrowernumber;
 320     }
 321     if ($type) {
 322         $query .= " type=? AND ";
 323         push @bind, $type;
 324     }
 325     if ($externalid) {
 326         $query .= " externalid=? AND ";
 327         push @bind, $externalid;
 328     }
 329     $query =~ s/ AND $//;
 330     my $sth = $dbh->prepare($query);
 331     $sth->execute(@bind);
 332     return $sth->fetchall_arrayref({});
 333 }
 334
 335 =head2 findrelatedto($type, $externalid)
 336
 337     parameters :
 338     - $type : the type of alert
 339     - $externalid : the id of the "object" to query
 340
 341     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.
 342     When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 343
 344 =cut
 345
 346 # outmoded POD:
 347 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 348
 349 sub findrelatedto {
 350     my $type       = shift or return;
 351     my $externalid = shift or return;
 352     my $q = ($type eq 'issue'   ) ?
 353 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
 354             ($type eq 'borrower') ?
 355 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
 356     unless ($q) {
 357         warn "findrelatedto(): Illegal type '$type'";
 358         return;
 359     }
 360     my $sth = C4::Context->dbh->prepare($q);
 361     $sth->execute($externalid);
 362     my ($result) = $sth->fetchrow;
 363     return $result;
 364 }
 365
 366 =head2 SendAlerts
 367
 368     parameters :
 369     - $type : the type of alert
 370     - $externalid : the id of the "object" to query
 371     - $letter_code : the letter to send.
 372
 373     send an alert to all borrowers having put an alert on a given subject.
 374
 375 =cut
 376
 377 sub SendAlerts {
 378     my ( $type, $externalid, $letter_code ) = @_;
 379     my $dbh = C4::Context->dbh;
 380     if ( $type eq 'issue' ) {
 381
 382         # prepare the letter...
 383         # search the subscriptionid
 384         my $sth =
 385           $dbh->prepare(
 386             "SELECT subscriptionid FROM serial WHERE serialid=?");
 387         $sth->execute($externalid);
 388         my ($subscriptionid) = $sth->fetchrow
 389           or warn( "No subscription for '$externalid'" ),
 390              return;
 391
 392         # search the biblionumber
 393         $sth =
 394           $dbh->prepare(
 395             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 396         $sth->execute($subscriptionid);
 397         my ($biblionumber) = $sth->fetchrow
 398           or warn( "No biblionumber for '$subscriptionid'" ),
 399              return;
 400
 401         my %letter;
 402         # find the list of borrowers to alert
 403         my $alerts = getalert( '', 'issue', $subscriptionid );
 404         foreach (@$alerts) {
 405             my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
 406             my $email = $borinfo->{email} or next;
 407
 408 #                    warn "sending issues...";
 409             my $userenv = C4::Context->userenv;
 410             my $library = Koha::Libraries->find( $_->{branchcode} );
 411             my $letter = GetPreparedLetter (
 412                 module => 'serial',
 413                 letter_code => $letter_code,
 414                 branchcode => $userenv->{branch},
 415                 tables => {
 416                     'branches'    => $_->{branchcode},
 417                     'biblio'      => $biblionumber,
 418                     'biblioitems' => $biblionumber,
 419                     'borrowers'   => $borinfo,
 420                     'subscription' => $subscriptionid,
 421                     'serial' => $externalid,
 422                 },
 423                 want_librarian => 1,
 424             ) or return;
 425
 426             # ... then send mail
 427             my $message = Koha::Email->new();
 428             my %mail = $message->create_message_headers(
 429                 {
 430                     to      => $email,
 431                     from    => $library->branchemail,
 432                     replyto => $library->branchreplyto,
 433                     sender  => $library->branchreturnpath,
 434                     subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
 435                     message => $letter->{'is_html'}
 436                                 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
 437                                               Encode::encode( "UTF-8", "" . $letter->{'title'} ))
 438                                 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
 439                     contenttype => $letter->{'is_html'}
 440                                     ? 'text/html; charset="utf-8"'
 441                                     : 'text/plain; charset="utf-8"',
 442                 }
 443             );
 444             sendmail(%mail) or carp $Mail::Sendmail::error;
 445         }
 446     }
 447     elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
 448
 449         # prepare the letter...
 450         # search the biblionumber
 451         my $strsth =  $type eq 'claimacquisition'
 452             ? qq{
 453             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
 454             FROM aqorders
 455             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 456             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 457             LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
 458             WHERE aqorders.ordernumber IN (
 459             }
 460             : qq{
 461             SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*,
 462             aqbooksellers.id AS booksellerid
 463             FROM serial
 464             LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
 465             LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
 466             LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 467             WHERE serial.serialid IN (
 468             };
 469
 470         if (!@$externalid){
 471             carp "No Order seleted";
 472             return { error => "no_order_seleted" };
 473         }
 474
 475         $strsth .= join( ",", @$externalid ) . ")";
 476         my $sthorders = $dbh->prepare($strsth);
 477         $sthorders->execute;
 478         my $dataorders = $sthorders->fetchall_arrayref( {} );
 479
 480         my $sthbookseller =
 481           $dbh->prepare("select * from aqbooksellers where id=?");
 482         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 483         my $databookseller = $sthbookseller->fetchrow_hashref;
 484         my $addressee =  $type eq 'claimacquisition' ? 'acqprimary' : 'serialsprimary';
 485         my $sthcontact =
 486           $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
 487         $sthcontact->execute( $dataorders->[0]->{booksellerid} );
 488         my $datacontact = $sthcontact->fetchrow_hashref;
 489
 490         my @email;
 491         my @cc;
 492         push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
 493         push @email, $datacontact->{email}           if ( $datacontact && $datacontact->{email} );
 494         unless (@email) {
 495             warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
 496             return { error => "no_email" };
 497         }
 498         my $addlcontact;
 499         while ($addlcontact = $sthcontact->fetchrow_hashref) {
 500             push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
 501         }
 502
 503         my $userenv = C4::Context->userenv;
 504         my $letter = GetPreparedLetter (
 505             module => $type,
 506             letter_code => $letter_code,
 507             branchcode => $userenv->{branch},
 508             tables => {
 509                 'branches'    => $userenv->{branch},
 510                 'aqbooksellers' => $databookseller,
 511                 'aqcontacts'    => $datacontact,
 512             },
 513             repeat => $dataorders,
 514             want_librarian => 1,
 515         ) or return;
 516
 517         # Remove the order tag
 518         $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
 519
 520         # ... then send mail
 521         my %mail = (
 522             To => join( ',', @email),
 523             Cc             => join( ',', @cc),
 524             From           => $userenv->{emailaddress},
 525             Subject        => Encode::encode( "UTF-8", "" . $letter->{title} ),
 526             Message => $letter->{'is_html'}
 527                             ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
 528                                           Encode::encode( "UTF-8", "" . $letter->{'title'} ))
 529                             : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
 530             'Content-Type' => $letter->{'is_html'}
 531                                 ? 'text/html; charset="utf-8"'
 532                                 : 'text/plain; charset="utf-8"',
 533         );
 534
 535         $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
 536           if C4::Context->preference('ReplytoDefault');
 537         $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
 538           if C4::Context->preference('ReturnpathDefault');
 539         $mail{'Bcc'} = $userenv->{emailaddress}
 540           if C4::Context->preference("ClaimsBccCopy");
 541
 542         unless ( sendmail(%mail) ) {
 543             carp $Mail::Sendmail::error;
 544             return { error => $Mail::Sendmail::error };
 545         }
 546
 547         logaction(
 548             "ACQUISITION",
 549             $type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM",
 550             undef,
 551             "To="
 552                 . join( ',', @email )
 553                 . " Title="
 554                 . $letter->{title}
 555                 . " Content="
 556                 . $letter->{content}
 557         ) if C4::Context->preference("LetterLog");
 558     }
 559    # send an "account details" notice to a newly created user
 560     elsif ( $type eq 'members' ) {
 561         my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
 562         my $letter = GetPreparedLetter (
 563             module => 'members',
 564             letter_code => $letter_code,
 565             branchcode => $externalid->{'branchcode'},
 566             tables => {
 567                 'branches'    => $library,
 568                 'borrowers' => $externalid->{'borrowernumber'},
 569             },
 570             substitute => { 'borrowers.password' => $externalid->{'password'} },
 571             want_librarian => 1,
 572         ) or return;
 573         return { error => "no_email" } unless $externalid->{'emailaddr'};
 574         my $email = Koha::Email->new();
 575         my %mail  = $email->create_message_headers(
 576             {
 577                 to      => $externalid->{'emailaddr'},
 578                 from    => $library->{branchemail},
 579                 replyto => $library->{branchreplyto},
 580                 sender  => $library->{branchreturnpath},
 581                 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
 582                 message => $letter->{'is_html'}
 583                             ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
 584                                           Encode::encode( "UTF-8", "" . $letter->{'title'}  ) )
 585                             : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
 586                 contenttype => $letter->{'is_html'}
 587                                 ? 'text/html; charset="utf-8"'
 588                                 : 'text/plain; charset="utf-8"',
 589             }
 590         );
 591         sendmail(%mail) or carp $Mail::Sendmail::error;
 592     }
 593 }
 594
 595 =head2 GetPreparedLetter( %params )
 596
 597     %params hash:
 598       module => letter module, mandatory
 599       letter_code => letter code, mandatory
 600       branchcode => for letter selection, if missing default system letter taken
 601       tables => a hashref with table names as keys. Values are either:
 602         - a scalar - primary key value
 603         - an arrayref - primary key values
 604         - a hashref - full record
 605       substitute => custom substitution key/value pairs
 606       repeat => records to be substituted on consecutive lines:
 607         - an arrayref - tries to guess what needs substituting by
 608           taking remaining << >> tokensr; not recommended
 609         - a hashref token => @tables - replaces <token> << >> << >> </token>
 610           subtemplate for each @tables row; table is a hashref as above
 611       want_librarian => boolean,  if set to true triggers librarian details
 612         substitution from the userenv
 613     Return value:
 614       letter fields hashref (title & content useful)
 615
 616 =cut
 617
 618 sub GetPreparedLetter {
 619     my %params = @_;
 620
 621     my $module      = $params{module} or croak "No module";
 622     my $letter_code = $params{letter_code} or croak "No letter_code";
 623     my $branchcode  = $params{branchcode} || '';
 624     my $mtt         = $params{message_transport_type} || 'email';
 625
 626     my $letter = getletter( $module, $letter_code, $branchcode, $mtt )
 627         or warn( "No $module $letter_code letter transported by " . $mtt ),
 628             return;
 629
 630     my $tables = $params{tables};
 631     my $substitute = $params{substitute};
 632     my $repeat = $params{repeat};
 633     $tables || $substitute || $repeat
 634       or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ),
 635          return;
 636     my $want_librarian = $params{want_librarian};
 637
 638     if ($substitute) {
 639         while ( my ($token, $val) = each %$substitute ) {
 640             if ( $token eq 'items.content' ) {
 641                 $val =~ s|\n|<br/>|g if $letter->{is_html};
 642             }
 643
 644             $letter->{title} =~ s/<<$token>>/$val/g;
 645             $letter->{content} =~ s/<<$token>>/$val/g;
 646        }
 647     }
 648
 649     my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
 650     $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
 651
 652     if ($want_librarian) {
 653         # parsing librarian name
 654         my $userenv = C4::Context->userenv;
 655         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
 656         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
 657         $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
 658     }
 659
 660     my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
 661
 662     if ($repeat) {
 663         if (ref ($repeat) eq 'ARRAY' ) {
 664             $repeat_no_enclosing_tags = $repeat;
 665         } else {
 666             $repeat_enclosing_tags = $repeat;
 667         }
 668     }
 669
 670     if ($repeat_enclosing_tags) {
 671         while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
 672             if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
 673                 my $subcontent = $1;
 674                 my @lines = map {
 675                     my %subletter = ( title => '', content => $subcontent );
 676                     _substitute_tables( \%subletter, $_ );
 677                     $subletter{content};
 678                 } @$tag_tables;
 679                 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
 680             }
 681         }
 682     }
 683
 684     if ($tables) {
 685         _substitute_tables( $letter, $tables );
 686     }
 687
 688     if ($repeat_no_enclosing_tags) {
 689         if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
 690             my $line = $&;
 691             my $i = 1;
 692             my @lines = map {
 693                 my $c = $line;
 694                 $c =~ s/<<count>>/$i/go;
 695                 foreach my $field ( keys %{$_} ) {
 696                     $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
 697                 }
 698                 $i++;
 699                 $c;
 700             } @$repeat_no_enclosing_tags;
 701
 702             my $replaceby = join( "\n", @lines );
 703             $letter->{content} =~ s/\Q$line\E/$replaceby/s;
 704         }
 705     }
 706
 707     $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
 708 #   $letter->{content} =~ s/<<[^>]*>>//go;
 709
 710     return $letter;
 711 }
 712
 713 sub _substitute_tables {
 714     my ( $letter, $tables ) = @_;
 715     while ( my ($table, $param) = each %$tables ) {
 716         next unless $param;
 717
 718         my $ref = ref $param;
 719
 720         my $values;
 721         if ($ref && $ref eq 'HASH') {
 722             $values = $param;
 723         }
 724         else {
 725             my $sth = _parseletter_sth($table);
 726             unless ($sth) {
 727                 warn "_parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 728                 return;
 729             }
 730             $sth->execute( $ref ? @$param : $param );
 731
 732             $values = $sth->fetchrow_hashref;
 733             $sth->finish();
 734         }
 735
 736         _parseletter ( $letter, $table, $values );
 737     }
 738 }
 739
 740 sub _parseletter_sth {
 741     my $table = shift;
 742     my $sth;
 743     unless ($table) {
 744         carp "ERROR: _parseletter_sth() called without argument (table)";
 745         return;
 746     }
 747     # NOTE: we used to check whether we had a statement handle cached in
 748     #       a %handles module-level variable. This was a dumb move and
 749     #       broke things for the rest of us. prepare_cached is a better
 750     #       way to cache statement handles anyway.
 751     my $query =
 752     ($table eq 'biblio'       ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
 753     ($table eq 'biblioitems'  ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
 754     ($table eq 'items'        ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 755     ($table eq 'issues'       ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
 756     ($table eq 'old_issues'   ) ? "SELECT * FROM $table WHERE     itemnumber = ? ORDER BY timestamp DESC LIMIT 1"  :
 757     ($table eq 'reserves'     ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?"             :
 758     ($table eq 'borrowers'    ) ? "SELECT * FROM $table WHERE borrowernumber = ?"                                  :
 759     ($table eq 'branches'     ) ? "SELECT * FROM $table WHERE     branchcode = ?"                                  :
 760     ($table eq 'suggestions'  ) ? "SELECT * FROM $table WHERE   suggestionid = ?"                                  :
 761     ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                                  :
 762     ($table eq 'aqorders'     ) ? "SELECT * FROM $table WHERE    ordernumber = ?"                                  :
 763     ($table eq 'opac_news'    ) ? "SELECT * FROM $table WHERE          idnew = ?"                                  :
 764     ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
 765     ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
 766     ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
 767     undef ;
 768     unless ($query) {
 769         warn "ERROR: No _parseletter_sth query for table '$table'";
 770         return;     # nothing to get
 771     }
 772     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
 773         warn "ERROR: Failed to prepare query: '$query'";
 774         return;
 775     }
 776     return $sth;    # now cache is populated for that $table
 777 }
 778
 779 =head2 _parseletter($letter, $table, $values)
 780
 781     parameters :
 782     - $letter : a hash to letter fields (title & content useful)
 783     - $table : the Koha table to parse.
 784     - $values_in : table record hashref
 785     parse all fields from a table, and replace values in title & content with the appropriate value
 786     (not exported sub, used only internally)
 787
 788 =cut
 789
 790 sub _parseletter {
 791     my ( $letter, $table, $values_in ) = @_;
 792
 793     # Work on a local copy of $values_in (passed by reference) to avoid side effects
 794     # in callers ( by changing / formatting values )
 795     my $values = $values_in ? { %$values_in } : {};
 796
 797     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
 798         $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
 799     }
 800
 801     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 802         my @waitingdate = split /-/, $values->{'waitingdate'};
 803
 804         $values->{'expirationdate'} = '';
 805         if ( C4::Context->preference('ReservesMaxPickUpDelay') ) {
 806             my $dt = dt_from_string();
 807             $dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') );
 808             $values->{'expirationdate'} = output_pref( { dt => $dt, dateonly => 1 } );
 809         }
 810
 811         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
 812
 813     }
 814
 815     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
 816         my $todaysdate = output_pref( DateTime->now() );
 817         $letter->{content} =~ s/<<today>>/$todaysdate/go;
 818     }
 819
 820     while ( my ($field, $val) = each %$values ) {
 821         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
 822             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
 823             #Therefore adding the test on biblio. This includes biblioitems,
 824             #but excludes items. Removed unneeded global and lookahead.
 825
 826         $val = GetAuthorisedValueByCode ('ROADTYPE', $val, 0) if $table=~/^borrowers$/ && $field=~/^streettype$/;
 827
 828         # Dates replacement
 829         my $replacedby   = defined ($val) ? $val : '';
 830         if (    $replacedby
 831             and not $replacedby =~ m|0000-00-00|
 832             and not $replacedby =~ m|9999-12-31|
 833             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
 834         {
 835             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
 836             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
 837             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
 838
 839             for my $letter_field ( qw( title content ) ) {
 840                 my $filter_string_used = q{};
 841                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
 842                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
 843                     $filter_string_used = $1 || q{};
 844                     $dateonly = $1 unless $dateonly;
 845                 }
 846                 my $replacedby_date = eval {
 847                     output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
 848                 };
 849
 850                 if ( $letter->{ $letter_field } ) {
 851                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
 852                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
 853                 }
 854             }
 855         }
 856         # Other fields replacement
 857         else {
 858             for my $letter_field ( qw( title content ) ) {
 859                 if ( $letter->{ $letter_field } ) {
 860                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
 861                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
 862                 }
 863             }
 864         }
 865     }
 866
 867     if ($table eq 'borrowers' && $letter->{content}) {
 868         if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
 869             my %attr;
 870             foreach (@$attributes) {
 871                 my $code = $_->{code};
 872                 my $val  = $_->{value_description} || $_->{value};
 873                 $val =~ s/\p{P}(?=$)//g if $val;
 874                 next unless $val gt '';
 875                 $attr{$code} ||= [];
 876                 push @{ $attr{$code} }, $val;
 877             }
 878             while ( my ($code, $val_ar) = each %attr ) {
 879                 my $replacefield = "<<borrower-attribute:$code>>";
 880                 my $replacedby   = join ',', @$val_ar;
 881                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 882             }
 883         }
 884     }
 885     return $letter;
 886 }
 887
 888 =head2 EnqueueLetter
 889
 890   my $success = EnqueueLetter( { letter => $letter,
 891         borrowernumber => '12', message_transport_type => 'email' } )
 892
 893 places a letter in the message_queue database table, which will
 894 eventually get processed (sent) by the process_message_queue.pl
 895 cronjob when it calls SendQueuedMessages.
 896
 897 return message_id on success
 898
 899 =cut
 900
 901 sub EnqueueLetter {
 902     my $params = shift or return;
 903
 904     return unless exists $params->{'letter'};
 905 #   return unless exists $params->{'borrowernumber'};
 906     return unless exists $params->{'message_transport_type'};
 907
 908     my $content = $params->{letter}->{content};
 909     $content =~ s/\s+//g if(defined $content);
 910     if ( not defined $content or $content eq '' ) {
 911         warn "Trying to add an empty message to the message queue" if $debug;
 912         return;
 913     }
 914
 915     # If we have any attachments we should encode then into the body.
 916     if ( $params->{'attachments'} ) {
 917         $params->{'letter'} = _add_attachments(
 918             {   letter      => $params->{'letter'},
 919                 attachments => $params->{'attachments'},
 920                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 921             }
 922         );
 923     }
 924
 925     my $dbh       = C4::Context->dbh();
 926     my $statement = << 'ENDSQL';
 927 INSERT INTO message_queue
 928 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 929 VALUES
 930 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 931 ENDSQL
 932
 933     my $sth    = $dbh->prepare($statement);
 934     my $result = $sth->execute(
 935         $params->{'borrowernumber'},              # borrowernumber
 936         $params->{'letter'}->{'title'},           # subject
 937         $params->{'letter'}->{'content'},         # content
 938         $params->{'letter'}->{'metadata'} || '',  # metadata
 939         $params->{'letter'}->{'code'}     || '',  # letter_code
 940         $params->{'message_transport_type'},      # message_transport_type
 941         'pending',                                # status
 942         $params->{'to_address'},                  # to_address
 943         $params->{'from_address'},                # from_address
 944         $params->{'letter'}->{'content-type'},    # content_type
 945     );
 946     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 947 }
 948
 949 =head2 SendQueuedMessages ([$hashref])
 950
 951   my $sent = SendQueuedMessages( { verbose => 1 } );
 952
 953 sends all of the 'pending' items in the message queue.
 954
 955 returns number of messages sent.
 956
 957 =cut
 958
 959 sub SendQueuedMessages {
 960     my $params = shift;
 961
 962     my $unsent_messages = _get_unsent_messages();
 963     MESSAGE: foreach my $message ( @$unsent_messages ) {
 964         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 965         warn sprintf( 'sending %s message to patron: %s',
 966                       $message->{'message_transport_type'},
 967                       $message->{'borrowernumber'} || 'Admin' )
 968           if $params->{'verbose'} or $debug;
 969         # This is just begging for subclassing
 970         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 971         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 972             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 973         }
 974         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 975             if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
 976                 my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 977                 my $sms_provider = Koha::SMS::Providers->find( $member->{'sms_provider_id'} );
 978                 $message->{to_address} .= '@' . $sms_provider->domain();
 979                 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 980             } else {
 981                 _send_message_by_sms( $message );
 982             }
 983         }
 984     }
 985     return scalar( @$unsent_messages );
 986 }
 987
 988 =head2 GetRSSMessages
 989
 990   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 991
 992 returns a listref of all queued RSS messages for a particular person.
 993
 994 =cut
 995
 996 sub GetRSSMessages {
 997     my $params = shift;
 998
 999     return unless $params;
1000     return unless ref $params;
1001     return unless $params->{'borrowernumber'};
1002
1003     return _get_unsent_messages( { message_transport_type => 'rss',
1004                                    limit                  => $params->{'limit'},
1005                                    borrowernumber         => $params->{'borrowernumber'}, } );
1006 }
1007
1008 =head2 GetPrintMessages
1009
1010   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1011
1012 Returns a arrayref of all queued print messages (optionally, for a particular
1013 person).
1014
1015 =cut
1016
1017 sub GetPrintMessages {
1018     my $params = shift || {};
1019
1020     return _get_unsent_messages( { message_transport_type => 'print',
1021                                    borrowernumber         => $params->{'borrowernumber'},
1022                                  } );
1023 }
1024
1025 =head2 GetQueuedMessages ([$hashref])
1026
1027   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1028
1029 fetches messages out of the message queue.
1030
1031 returns:
1032 list of hashes, each has represents a message in the message queue.
1033
1034 =cut
1035
1036 sub GetQueuedMessages {
1037     my $params = shift;
1038
1039     my $dbh = C4::Context->dbh();
1040     my $statement = << 'ENDSQL';
1041 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1042 FROM message_queue
1043 ENDSQL
1044
1045     my @query_params;
1046     my @whereclauses;
1047     if ( exists $params->{'borrowernumber'} ) {
1048         push @whereclauses, ' borrowernumber = ? ';
1049         push @query_params, $params->{'borrowernumber'};
1050     }
1051
1052     if ( @whereclauses ) {
1053         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1054     }
1055
1056     if ( defined $params->{'limit'} ) {
1057         $statement .= ' LIMIT ? ';
1058         push @query_params, $params->{'limit'};
1059     }
1060
1061     my $sth = $dbh->prepare( $statement );
1062     my $result = $sth->execute( @query_params );
1063     return $sth->fetchall_arrayref({});
1064 }
1065
1066 =head2 GetMessageTransportTypes
1067
1068   my @mtt = GetMessageTransportTypes();
1069
1070   returns an arrayref of transport types
1071
1072 =cut
1073
1074 sub GetMessageTransportTypes {
1075     my $dbh = C4::Context->dbh();
1076     my $mtts = $dbh->selectcol_arrayref("
1077         SELECT message_transport_type
1078         FROM message_transport_types
1079         ORDER BY message_transport_type
1080     ");
1081     return $mtts;
1082 }
1083
1084 =head2 GetMessage
1085
1086     my $message = C4::Letters::Message($message_id);
1087
1088 =cut
1089
1090 sub GetMessage {
1091     my ( $message_id ) = @_;
1092     return unless $message_id;
1093     my $dbh = C4::Context->dbh;
1094     return $dbh->selectrow_hashref(q|
1095         SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1096         FROM message_queue
1097         WHERE message_id = ?
1098     |, {}, $message_id );
1099 }
1100
1101 =head2 ResendMessage
1102
1103   Attempt to resend a message which has failed previously.
1104
1105   my $has_been_resent = C4::Letters::ResendMessage($message_id);
1106
1107   Updates the message to 'pending' status so that
1108   it will be resent later on.
1109
1110   returns 1 on success, 0 on failure, undef if no message was found
1111
1112 =cut
1113
1114 sub ResendMessage {
1115     my $message_id = shift;
1116     return unless $message_id;
1117
1118     my $message = GetMessage( $message_id );
1119     return unless $message;
1120     my $rv = 0;
1121     if ( $message->{status} ne 'pending' ) {
1122         $rv = C4::Letters::_set_message_status({
1123             message_id => $message_id,
1124             status => 'pending',
1125         });
1126         $rv = $rv > 0? 1: 0;
1127         # Clear destination email address to force address update
1128         _update_message_to_address( $message_id, undef ) if $rv &&
1129             $message->{message_transport_type} eq 'email';
1130     }
1131     return $rv;
1132 }
1133
1134 =head2 _add_attachements
1135
1136 named parameters:
1137 letter - the standard letter hashref
1138 attachments - listref of attachments. each attachment is a hashref of:
1139   type - the mime type, like 'text/plain'
1140   content - the actual attachment
1141   filename - the name of the attachment.
1142 message - a MIME::Lite object to attach these to.
1143
1144 returns your letter object, with the content updated.
1145
1146 =cut
1147
1148 sub _add_attachments {
1149     my $params = shift;
1150
1151     my $letter = $params->{'letter'};
1152     my $attachments = $params->{'attachments'};
1153     return $letter unless @$attachments;
1154     my $message = $params->{'message'};
1155
1156     # First, we have to put the body in as the first attachment
1157     $message->attach(
1158         Type => $letter->{'content-type'} || 'TEXT',
1159         Data => $letter->{'is_html'}
1160             ? _wrap_html($letter->{'content'}, $letter->{'title'})
1161             : $letter->{'content'},
1162     );
1163
1164     foreach my $attachment ( @$attachments ) {
1165         $message->attach(
1166             Type     => $attachment->{'type'},
1167             Data     => $attachment->{'content'},
1168             Filename => $attachment->{'filename'},
1169         );
1170     }
1171     # we're forcing list context here to get the header, not the count back from grep.
1172     ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1173     $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1174     $letter->{'content'} = $message->body_as_string;
1175
1176     return $letter;
1177
1178 }
1179
1180 sub _get_unsent_messages {
1181     my $params = shift;
1182
1183     my $dbh = C4::Context->dbh();
1184     my $statement = << 'ENDSQL';
1185 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
1186   FROM message_queue mq
1187   LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1188  WHERE status = ?
1189 ENDSQL
1190
1191     my @query_params = ('pending');
1192     if ( ref $params ) {
1193         if ( $params->{'message_transport_type'} ) {
1194             $statement .= ' AND message_transport_type = ? ';
1195             push @query_params, $params->{'message_transport_type'};
1196         }
1197         if ( $params->{'borrowernumber'} ) {
1198             $statement .= ' AND borrowernumber = ? ';
1199             push @query_params, $params->{'borrowernumber'};
1200         }
1201         if ( $params->{'limit'} ) {
1202             $statement .= ' limit ? ';
1203             push @query_params, $params->{'limit'};
1204         }
1205     }
1206
1207     $debug and warn "_get_unsent_messages SQL: $statement";
1208     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1209     my $sth = $dbh->prepare( $statement );
1210     my $result = $sth->execute( @query_params );
1211     return $sth->fetchall_arrayref({});
1212 }
1213
1214 sub _send_message_by_email {
1215     my $message = shift or return;
1216     my ($username, $password, $method) = @_;
1217
1218     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
1219     my $to_address = $message->{'to_address'};
1220     unless ($to_address) {
1221         unless ($member) {
1222             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1223             _set_message_status( { message_id => $message->{'message_id'},
1224                                    status     => 'failed' } );
1225             return;
1226         }
1227         $to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} );
1228         unless ($to_address) {
1229             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1230             # warning too verbose for this more common case?
1231             _set_message_status( { message_id => $message->{'message_id'},
1232                                    status     => 'failed' } );
1233             return;
1234         }
1235     }
1236
1237     my $utf8   = decode('MIME-Header', $message->{'subject'} );
1238     $message->{subject}= encode('MIME-Header', $utf8);
1239     my $subject = encode('UTF-8', $message->{'subject'});
1240     my $content = encode('UTF-8', $message->{'content'});
1241     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1242     my $is_html = $content_type =~ m/html/io;
1243     my $branch_email = undef;
1244     my $branch_replyto = undef;
1245     my $branch_returnpath = undef;
1246     if ($member) {
1247         my $library = Koha::Libraries->find( $member->{branchcode} );
1248         $branch_email      = $library->branchemail;
1249         $branch_replyto    = $library->branchreplyto;
1250         $branch_returnpath = $library->branchreturnpath;
1251     }
1252     my $email = Koha::Email->new();
1253     my %sendmail_params = $email->create_message_headers(
1254         {
1255             to      => $to_address,
1256             from    => $message->{'from_address'} || $branch_email,
1257             replyto => $branch_replyto,
1258             sender  => $branch_returnpath,
1259             subject => $subject,
1260             message => $is_html ? _wrap_html( $content, $subject ) : $content,
1261             contenttype => $content_type
1262         }
1263     );
1264
1265     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1266     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
1267        $sendmail_params{ Bcc } = $bcc;
1268     }
1269
1270     _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
1271
1272     if ( sendmail( %sendmail_params ) ) {
1273         _set_message_status( { message_id => $message->{'message_id'},
1274                 status     => 'sent' } );
1275         return 1;
1276     } else {
1277         _set_message_status( { message_id => $message->{'message_id'},
1278                 status     => 'failed' } );
1279         carp $Mail::Sendmail::error;
1280         return;
1281     }
1282 }
1283
1284 sub _wrap_html {
1285     my ($content, $title) = @_;
1286
1287     my $css = C4::Context->preference("NoticeCSS") || '';
1288     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1289     return <<EOS;
1290 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1291     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1292 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1293 <head>
1294 <title>$title</title>
1295 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1296 $css
1297 </head>
1298 <body>
1299 $content
1300 </body>
1301 </html>
1302 EOS
1303 }
1304
1305 sub _is_duplicate {
1306     my ( $message ) = @_;
1307     my $dbh = C4::Context->dbh;
1308     my $count = $dbh->selectrow_array(q|
1309         SELECT COUNT(*)
1310         FROM message_queue
1311         WHERE message_transport_type = ?
1312         AND borrowernumber = ?
1313         AND letter_code = ?
1314         AND CAST(time_queued AS date) = CAST(NOW() AS date)
1315         AND status="sent"
1316         AND content = ?
1317     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1318     return $count;
1319 }
1320
1321 sub _send_message_by_sms {
1322     my $message = shift or return;
1323     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
1324
1325     unless ( $member->{smsalertnumber} ) {
1326         _set_message_status( { message_id => $message->{'message_id'},
1327                                status     => 'failed' } );
1328         return;
1329     }
1330
1331     if ( _is_duplicate( $message ) ) {
1332         _set_message_status( { message_id => $message->{'message_id'},
1333                                status     => 'failed' } );
1334         return;
1335     }
1336
1337     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
1338                                        message     => $message->{'content'},
1339                                      } );
1340     _set_message_status( { message_id => $message->{'message_id'},
1341                            status     => ($success ? 'sent' : 'failed') } );
1342     return $success;
1343 }
1344
1345 sub _update_message_to_address {
1346     my ($id, $to)= @_;
1347     my $dbh = C4::Context->dbh();
1348     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1349 }
1350
1351 sub _set_message_status {
1352     my $params = shift or return;
1353
1354     foreach my $required_parameter ( qw( message_id status ) ) {
1355         return unless exists $params->{ $required_parameter };
1356     }
1357
1358     my $dbh = C4::Context->dbh();
1359     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1360     my $sth = $dbh->prepare( $statement );
1361     my $result = $sth->execute( $params->{'status'},
1362                                 $params->{'message_id'} );
1363     return $result;
1364 }
1365
1366
1367 1;
1368 __END__