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