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