C4/Letters.pm

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