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