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