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