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 use Koha::DateUtils qw( format_sqldatetime );
  39
  40 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  41
  42 BEGIN {
  43     require Exporter;
  44     # set the version for version checking
  45     $VERSION = 3.07.00.049;
  46     @ISA = qw(Exporter);
  47     @EXPORT = qw(
  48         &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
  49     );
  50 }
  51
  52 =head1 NAME
  53
  54 C4::Letters - Give functions for Letters management
  55
  56 =head1 SYNOPSIS
  57
  58   use C4::Letters;
  59
  60 =head1 DESCRIPTION
  61
  62   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  63   late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
  64
  65   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  66
  67 =head2 GetLetters([$module])
  68
  69   $letters = &GetLetters($module);
  70   returns informations about letters.
  71   if needed, $module filters for letters given module
  72
  73 =cut
  74
  75 sub GetLetters {
  76     my ($filters) = @_;
  77     my $module    = $filters->{module};
  78     my $code      = $filters->{code};
  79     my $branchcode = $filters->{branchcode};
  80     my $dbh       = C4::Context->dbh;
  81     my $letters   = $dbh->selectall_arrayref(
  82         q|
  83             SELECT module, code, branchcode, name
  84             FROM letter
  85             WHERE 1
  86         |
  87           . ( $module ? q| AND module = ?| : q|| )
  88           . ( $code   ? q| AND code = ?|   : q|| )
  89           . ( defined $branchcode   ? q| AND branchcode = ?|   : q|| )
  90           . q| GROUP BY code ORDER BY name|, { Slice => {} }
  91         , ( $module ? $module : () )
  92         , ( $code ? $code : () )
  93         , ( defined $branchcode ? $branchcode : () )
  94     );
  95
  96     return $letters;
  97 }
  98
  99 =head2 GetLetterTemplates
 100
 101     my $letter_templates = GetLetterTemplates(
 102         {
 103             module => 'circulation',
 104             code => 'my code',
 105             branchcode => 'CPL', # '' for default,
 106         }
 107     );
 108
 109     Return a hashref of letter templates.
 110     The key will be the message transport type.
 111
 112 =cut
 113
 114 sub GetLetterTemplates {
 115     my ( $params ) = @_;
 116
 117     my $module    = $params->{module};
 118     my $code      = $params->{code};
 119     my $branchcode = $params->{branchcode} // '';
 120     my $dbh       = C4::Context->dbh;
 121     my $letters   = $dbh->selectall_hashref(
 122         q|
 123             SELECT module, code, branchcode, name, is_html, title, content, message_transport_type
 124             FROM letter
 125             WHERE module = ?
 126             AND code = ?
 127             and branchcode = ?
 128         |
 129         , 'message_transport_type'
 130         , undef
 131         , $module, $code, $branchcode
 132     );
 133
 134     return $letters;
 135 }
 136
 137 =head2 GetLettersAvailableForALibrary
 138
 139     my $letters = GetLettersAvailableForALibrary(
 140         {
 141             branchcode => 'CPL', # '' for default
 142             module => 'circulation',
 143         }
 144     );
 145
 146     Return an arrayref of letters, sorted by name.
 147     If a specific letter exist for the given branchcode, it will be retrieve.
 148     Otherwise the default letter will be.
 149
 150 =cut
 151
 152 sub GetLettersAvailableForALibrary {
 153     my ($filters)  = @_;
 154     my $branchcode = $filters->{branchcode};
 155     my $module     = $filters->{module};
 156
 157     croak "module should be provided" unless $module;
 158
 159     my $dbh             = C4::Context->dbh;
 160     my $default_letters = $dbh->selectall_arrayref(
 161         q|
 162             SELECT module, code, branchcode, name
 163             FROM letter
 164             WHERE 1
 165         |
 166           . q| AND branchcode = ''|
 167           . ( $module ? q| AND module = ?| : q|| )
 168           . q| ORDER BY name|, { Slice => {} }
 169         , ( $module ? $module : () )
 170     );
 171
 172     my $specific_letters;
 173     if ($branchcode) {
 174         $specific_letters = $dbh->selectall_arrayref(
 175             q|
 176                 SELECT module, code, branchcode, name
 177                 FROM letter
 178                 WHERE 1
 179             |
 180               . q| AND branchcode = ?|
 181               . ( $module ? q| AND module = ?| : q|| )
 182               . q| ORDER BY name|, { Slice => {} }
 183             , $branchcode
 184             , ( $module ? $module : () )
 185         );
 186     }
 187
 188     my %letters;
 189     for my $l (@$default_letters) {
 190         $letters{ $l->{code} } = $l;
 191     }
 192     for my $l (@$specific_letters) {
 193         # Overwrite the default letter with the specific one.
 194         $letters{ $l->{code} } = $l;
 195     }
 196
 197     return [ map { $letters{$_} }
 198           sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
 199           keys %letters ];
 200
 201 }
 202
 203 sub getletter {
 204     my ( $module, $code, $branchcode, $message_transport_type ) = @_;
 205     $message_transport_type //= '%';
 206
 207     if ( C4::Context->preference('IndependentBranches')
 208             and $branchcode
 209             and C4::Context->userenv ) {
 210
 211         $branchcode = C4::Context->userenv->{'branch'};
 212     }
 213     $branchcode //= '';
 214
 215     my $dbh = C4::Context->dbh;
 216     my $sth = $dbh->prepare(q{
 217         SELECT *
 218         FROM letter
 219         WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
 220         AND message_transport_type LIKE ?
 221         ORDER BY branchcode DESC LIMIT 1
 222     });
 223     $sth->execute( $module, $code, $branchcode, $message_transport_type );
 224     my $line = $sth->fetchrow_hashref
 225       or return;
 226     $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
 227     return { %$line };
 228 }
 229
 230
 231 =head2 DelLetter
 232
 233     DelLetter(
 234         {
 235             branchcode => 'CPL',
 236             module => 'circulation',
 237             code => 'my code',
 238             [ mtt => 'email', ]
 239         }
 240     );
 241
 242     Delete the letter. The mtt parameter is facultative.
 243     If not given, all templates mathing the other parameters will be removed.
 244
 245 =cut
 246
 247 sub DelLetter {
 248     my ($params)   = @_;
 249     my $branchcode = $params->{branchcode};
 250     my $module     = $params->{module};
 251     my $code       = $params->{code};
 252     my $mtt        = $params->{mtt};
 253     my $dbh        = C4::Context->dbh;
 254     $dbh->do(q|
 255         DELETE FROM letter
 256         WHERE branchcode = ?
 257           AND module = ?
 258           AND code = ?
 259     | . ( $mtt ? q| AND message_transport_type = ?| : q|| )
 260     , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ) );
 261 }
 262
 263 =head2 addalert ($borrowernumber, $type, $externalid)
 264
 265     parameters :
 266     - $borrowernumber : the number of the borrower subscribing to the alert
 267     - $type : the type of alert.
 268     - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 269
 270     create an alert and return the alertid (primary key)
 271
 272 =cut
 273
 274 sub addalert {
 275     my ( $borrowernumber, $type, $externalid ) = @_;
 276     my $dbh = C4::Context->dbh;
 277     my $sth =
 278       $dbh->prepare(
 279         "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
 280     $sth->execute( $borrowernumber, $type, $externalid );
 281
 282     # get the alert number newly created and return it
 283     my $alertid = $dbh->{'mysql_insertid'};
 284     return $alertid;
 285 }
 286
 287 =head2 delalert ($alertid)
 288
 289     parameters :
 290     - alertid : the alert id
 291     deletes the alert
 292
 293 =cut
 294
 295 sub delalert {
 296     my $alertid = shift or die "delalert() called without valid argument (alertid)";    # it's gonna die anyway.
 297     $debug and warn "delalert: deleting alertid $alertid";
 298     my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
 299     $sth->execute($alertid);
 300 }
 301
 302 =head2 getalert ([$borrowernumber], [$type], [$externalid])
 303
 304     parameters :
 305     - $borrowernumber : the number of the borrower subscribing to the alert
 306     - $type : the type of alert.
 307     - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 308     all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic.
 309
 310 =cut
 311
 312 sub getalert {
 313     my ( $borrowernumber, $type, $externalid ) = @_;
 314     my $dbh   = C4::Context->dbh;
 315     my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
 316     my @bind;
 317     if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
 318         $query .= " AND borrowernumber=?";
 319         push @bind, $borrowernumber;
 320     }
 321     if ($type) {
 322         $query .= " AND type=?";
 323         push @bind, $type;
 324     }
 325     if ($externalid) {
 326         $query .= " AND externalid=?";
 327         push @bind, $externalid;
 328     }
 329     my $sth = $dbh->prepare($query);
 330     $sth->execute(@bind);
 331     return $sth->fetchall_arrayref({});
 332 }
 333
 334 =head2 findrelatedto($type, $externalid)
 335
 336     parameters :
 337     - $type : the type of alert
 338     - $externalid : the id of the "object" to query
 339
 340     In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert.
 341     When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 342
 343 =cut
 344
 345 # outmoded POD:
 346 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 347
 348 sub findrelatedto {
 349     my $type       = shift or return;
 350     my $externalid = shift or return;
 351     my $q = ($type eq 'issue'   ) ?
 352 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
 353             ($type eq 'borrower') ?
 354 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
 355     unless ($q) {
 356         warn "findrelatedto(): Illegal type '$type'";
 357         return;
 358     }
 359     my $sth = C4::Context->dbh->prepare($q);
 360     $sth->execute($externalid);
 361     my ($result) = $sth->fetchrow;
 362     return $result;
 363 }
 364
 365 =head2 SendAlerts
 366
 367     parameters :
 368     - $type : the type of alert
 369     - $externalid : the id of the "object" to query
 370     - $letter_code : the letter to send.
 371
 372     send an alert to all borrowers having put an alert on a given subject.
 373
 374 =cut
 375
 376 sub SendAlerts {
 377     my ( $type, $externalid, $letter_code ) = @_;
 378     my $dbh = C4::Context->dbh;
 379     if ( $type eq 'issue' ) {
 380
 381         # prepare the letter...
 382         # search the subscriptionid
 383         my $sth =
 384           $dbh->prepare(
 385             "SELECT subscriptionid FROM serial WHERE serialid=?");
 386         $sth->execute($externalid);
 387         my ($subscriptionid) = $sth->fetchrow
 388           or warn( "No subscription for '$externalid'" ),
 389              return;
 390
 391         # search the biblionumber
 392         $sth =
 393           $dbh->prepare(
 394             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 395         $sth->execute($subscriptionid);
 396         my ($biblionumber) = $sth->fetchrow
 397           or warn( "No biblionumber for '$subscriptionid'" ),
 398              return;
 399
 400         my %letter;
 401         # find the list of borrowers to alert
 402         my $alerts = getalert( '', 'issue', $subscriptionid );
 403         foreach (@$alerts) {
 404             my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
 405             my $email = $borinfo->{email} or next;
 406
 407 #                    warn "sending issues...";
 408             my $userenv = C4::Context->userenv;
 409             my $branchdetails = GetBranchDetail($_->{'branchcode'});
 410             my $letter = GetPreparedLetter (
 411                 module => 'serial',
 412                 letter_code => $letter_code,
 413                 branchcode => $userenv->{branch},
 414                 tables => {
 415                     'branches'    => $_->{branchcode},
 416                     'biblio'      => $biblionumber,
 417                     'biblioitems' => $biblionumber,
 418                     'borrowers'   => $borinfo,
 419                     'subscription' => $subscriptionid,
 420                     'serial' => $externalid,
 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     ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
 763     ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
 764     undef ;
 765     unless ($query) {
 766         warn "ERROR: No _parseletter_sth query for table '$table'";
 767         return;     # nothing to get
 768     }
 769     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
 770         warn "ERROR: Failed to prepare query: '$query'";
 771         return;
 772     }
 773     return $sth;    # now cache is populated for that $table
 774 }
 775
 776 =head2 _parseletter($letter, $table, $values)
 777
 778     parameters :
 779     - $letter : a hash to letter fields (title & content useful)
 780     - $table : the Koha table to parse.
 781     - $values_in : table record hashref
 782     parse all fields from a table, and replace values in title & content with the appropriate value
 783     (not exported sub, used only internally)
 784
 785 =cut
 786
 787 sub _parseletter {
 788     my ( $letter, $table, $values_in ) = @_;
 789
 790     # Work on a local copy of $values_in (passed by reference) to avoid side effects
 791     # in callers ( by changing / formatting values )
 792     my $values = $values_in ? { %$values_in } : {};
 793
 794     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
 795         $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
 796     }
 797
 798     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 799         my @waitingdate = split /-/, $values->{'waitingdate'};
 800
 801         $values->{'expirationdate'} = '';
 802         if ( C4::Context->preference('ReservesMaxPickUpDelay') ) {
 803             my $dt = dt_from_string();
 804             $dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') );
 805             $values->{'expirationdate'} = output_pref( { dt => $dt, dateonly => 1 } );
 806         }
 807
 808         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
 809
 810     }
 811
 812     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
 813         my $todaysdate = output_pref( DateTime->now() );
 814         $letter->{content} =~ s/<<today>>/$todaysdate/go;
 815     }
 816
 817     while ( my ($field, $val) = each %$values ) {
 818         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
 819             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
 820             #Therefore adding the test on biblio. This includes biblioitems,
 821             #but excludes items. Removed unneeded global and lookahead.
 822
 823         $val = GetAuthorisedValueByCode ('ROADTYPE', $val, 0) if $table=~/^borrowers$/ && $field=~/^streettype$/;
 824
 825         # Dates replacement
 826         my $replacedby   = defined ($val) ? $val : '';
 827         if (    $replacedby
 828             and not $replacedby =~ m|0000-00-00|
 829             and not $replacedby =~ m|9999-12-31|
 830             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
 831         {
 832             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
 833             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
 834             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
 835
 836             for my $letter_field ( qw( title content ) ) {
 837                 my $filter_string_used = q{};
 838                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
 839                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
 840                     $filter_string_used = $1 || q{};
 841                     $dateonly = $1 unless $dateonly;
 842                 }
 843                 my $replacedby_date = eval {
 844                     output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
 845                 };
 846
 847                 if ( $letter->{ $letter_field } ) {
 848                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
 849                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
 850                 }
 851             }
 852         }
 853         # Other fields replacement
 854         else {
 855             for my $letter_field ( qw( title content ) ) {
 856                 if ( $letter->{ $letter_field } ) {
 857                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
 858                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
 859                 }
 860             }
 861         }
 862     }
 863
 864     if ($table eq 'borrowers' && $letter->{content}) {
 865         if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
 866             my %attr;
 867             foreach (@$attributes) {
 868                 my $code = $_->{code};
 869                 my $val  = $_->{value_description} || $_->{value};
 870                 $val =~ s/\p{P}(?=$)//g if $val;
 871                 next unless $val gt '';
 872                 $attr{$code} ||= [];
 873                 push @{ $attr{$code} }, $val;
 874             }
 875             while ( my ($code, $val_ar) = each %attr ) {
 876                 my $replacefield = "<<borrower-attribute:$code>>";
 877                 my $replacedby   = join ',', @$val_ar;
 878                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 879             }
 880         }
 881     }
 882     return $letter;
 883 }
 884
 885 =head2 EnqueueLetter
 886
 887   my $success = EnqueueLetter( { letter => $letter,
 888         borrowernumber => '12', message_transport_type => 'email' } )
 889
 890 places a letter in the message_queue database table, which will
 891 eventually get processed (sent) by the process_message_queue.pl
 892 cronjob when it calls SendQueuedMessages.
 893
 894 return message_id on success
 895
 896 =cut
 897
 898 sub EnqueueLetter {
 899     my $params = shift or return;
 900
 901     return unless exists $params->{'letter'};
 902 #   return unless exists $params->{'borrowernumber'};
 903     return unless exists $params->{'message_transport_type'};
 904
 905     my $content = $params->{letter}->{content};
 906     $content =~ s/\s+//g if(defined $content);
 907     if ( not defined $content or $content eq '' ) {
 908         warn "Trying to add an empty message to the message queue" if $debug;
 909         return;
 910     }
 911
 912     # If we have any attachments we should encode then into the body.
 913     if ( $params->{'attachments'} ) {
 914         $params->{'letter'} = _add_attachments(
 915             {   letter      => $params->{'letter'},
 916                 attachments => $params->{'attachments'},
 917                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 918             }
 919         );
 920     }
 921
 922     my $dbh       = C4::Context->dbh();
 923     my $statement = << 'ENDSQL';
 924 INSERT INTO message_queue
 925 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 926 VALUES
 927 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 928 ENDSQL
 929
 930     my $sth    = $dbh->prepare($statement);
 931     my $result = $sth->execute(
 932         $params->{'borrowernumber'},              # borrowernumber
 933         $params->{'letter'}->{'title'},           # subject
 934         $params->{'letter'}->{'content'},         # content
 935         $params->{'letter'}->{'metadata'} || '',  # metadata
 936         $params->{'letter'}->{'code'}     || '',  # letter_code
 937         $params->{'message_transport_type'},      # message_transport_type
 938         'pending',                                # status
 939         $params->{'to_address'},                  # to_address
 940         $params->{'from_address'},                # from_address
 941         $params->{'letter'}->{'content-type'},    # content_type
 942     );
 943     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 944 }
 945
 946 =head2 SendQueuedMessages ([$hashref])
 947
 948   my $sent = SendQueuedMessages( { verbose => 1 } );
 949
 950 sends all of the 'pending' items in the message queue.
 951
 952 returns number of messages sent.
 953
 954 =cut
 955
 956 sub SendQueuedMessages {
 957     my $params = shift;
 958
 959     my $unsent_messages = _get_unsent_messages();
 960     MESSAGE: foreach my $message ( @$unsent_messages ) {
 961         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 962         warn sprintf( 'sending %s message to patron: %s',
 963                       $message->{'message_transport_type'},
 964                       $message->{'borrowernumber'} || 'Admin' )
 965           if $params->{'verbose'} or $debug;
 966         # This is just begging for subclassing
 967         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 968         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 969             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 970         }
 971         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 972             _send_message_by_sms( $message );
 973         }
 974     }
 975     return scalar( @$unsent_messages );
 976 }
 977
 978 =head2 GetRSSMessages
 979
 980   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 981
 982 returns a listref of all queued RSS messages for a particular person.
 983
 984 =cut
 985
 986 sub GetRSSMessages {
 987     my $params = shift;
 988
 989     return unless $params;
 990     return unless ref $params;
 991     return unless $params->{'borrowernumber'};
 992
 993     return _get_unsent_messages( { message_transport_type => 'rss',
 994                                    limit                  => $params->{'limit'},
 995                                    borrowernumber         => $params->{'borrowernumber'}, } );
 996 }
 997
 998 =head2 GetPrintMessages
 999
1000   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1001
1002 Returns a arrayref of all queued print messages (optionally, for a particular
1003 person).
1004
1005 =cut
1006
1007 sub GetPrintMessages {
1008     my $params = shift || {};
1009
1010     return _get_unsent_messages( { message_transport_type => 'print',
1011                                    borrowernumber         => $params->{'borrowernumber'},
1012                                  } );
1013 }
1014
1015 =head2 GetQueuedMessages ([$hashref])
1016
1017   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1018
1019 fetches messages out of the message queue.
1020
1021 returns:
1022 list of hashes, each has represents a message in the message queue.
1023
1024 =cut
1025
1026 sub GetQueuedMessages {
1027     my $params = shift;
1028
1029     my $dbh = C4::Context->dbh();
1030     my $statement = << 'ENDSQL';
1031 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1032 FROM message_queue
1033 ENDSQL
1034
1035     my @query_params;
1036     my @whereclauses;
1037     if ( exists $params->{'borrowernumber'} ) {
1038         push @whereclauses, ' borrowernumber = ? ';
1039         push @query_params, $params->{'borrowernumber'};
1040     }
1041
1042     if ( @whereclauses ) {
1043         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1044     }
1045
1046     if ( defined $params->{'limit'} ) {
1047         $statement .= ' LIMIT ? ';
1048         push @query_params, $params->{'limit'};
1049     }
1050
1051     my $sth = $dbh->prepare( $statement );
1052     my $result = $sth->execute( @query_params );
1053     return $sth->fetchall_arrayref({});
1054 }
1055
1056 =head2 GetMessageTransportTypes
1057
1058   my @mtt = GetMessageTransportTypes();
1059
1060   returns an arrayref of transport types
1061
1062 =cut
1063
1064 sub GetMessageTransportTypes {
1065     my $dbh = C4::Context->dbh();
1066     my $mtts = $dbh->selectcol_arrayref("
1067         SELECT message_transport_type
1068         FROM message_transport_types
1069         ORDER BY message_transport_type
1070     ");
1071     return $mtts;
1072 }
1073
1074 =head2 _add_attachements
1075
1076 named parameters:
1077 letter - the standard letter hashref
1078 attachments - listref of attachments. each attachment is a hashref of:
1079   type - the mime type, like 'text/plain'
1080   content - the actual attachment
1081   filename - the name of the attachment.
1082 message - a MIME::Lite object to attach these to.
1083
1084 returns your letter object, with the content updated.
1085
1086 =cut
1087
1088 sub _add_attachments {
1089     my $params = shift;
1090
1091     my $letter = $params->{'letter'};
1092     my $attachments = $params->{'attachments'};
1093     return $letter unless @$attachments;
1094     my $message = $params->{'message'};
1095
1096     # First, we have to put the body in as the first attachment
1097     $message->attach(
1098         Type => $letter->{'content-type'} || 'TEXT',
1099         Data => $letter->{'is_html'}
1100             ? _wrap_html($letter->{'content'}, $letter->{'title'})
1101             : $letter->{'content'},
1102     );
1103
1104     foreach my $attachment ( @$attachments ) {
1105         $message->attach(
1106             Type     => $attachment->{'type'},
1107             Data     => $attachment->{'content'},
1108             Filename => $attachment->{'filename'},
1109         );
1110     }
1111     # we're forcing list context here to get the header, not the count back from grep.
1112     ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1113     $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1114     $letter->{'content'} = $message->body_as_string;
1115
1116     return $letter;
1117
1118 }
1119
1120 sub _get_unsent_messages {
1121     my $params = shift;
1122
1123     my $dbh = C4::Context->dbh();
1124     my $statement = << 'ENDSQL';
1125 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
1126   FROM message_queue mq
1127   LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1128  WHERE status = ?
1129 ENDSQL
1130
1131     my @query_params = ('pending');
1132     if ( ref $params ) {
1133         if ( $params->{'message_transport_type'} ) {
1134             $statement .= ' AND message_transport_type = ? ';
1135             push @query_params, $params->{'message_transport_type'};
1136         }
1137         if ( $params->{'borrowernumber'} ) {
1138             $statement .= ' AND borrowernumber = ? ';
1139             push @query_params, $params->{'borrowernumber'};
1140         }
1141         if ( $params->{'limit'} ) {
1142             $statement .= ' limit ? ';
1143             push @query_params, $params->{'limit'};
1144         }
1145     }
1146
1147     $debug and warn "_get_unsent_messages SQL: $statement";
1148     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1149     my $sth = $dbh->prepare( $statement );
1150     my $result = $sth->execute( @query_params );
1151     return $sth->fetchall_arrayref({});
1152 }
1153
1154 sub _send_message_by_email {
1155     my $message = shift or return;
1156     my ($username, $password, $method) = @_;
1157
1158     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
1159     my $to_address = $message->{'to_address'};
1160     unless ($to_address) {
1161         unless ($member) {
1162             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1163             _set_message_status( { message_id => $message->{'message_id'},
1164                                    status     => 'failed' } );
1165             return;
1166         }
1167         $to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} );
1168         unless ($to_address) {
1169             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1170             # warning too verbose for this more common case?
1171             _set_message_status( { message_id => $message->{'message_id'},
1172                                    status     => 'failed' } );
1173             return;
1174         }
1175     }
1176
1177     my $utf8   = decode('MIME-Header', $message->{'subject'} );
1178     $message->{subject}= encode('MIME-Header', $utf8);
1179     my $subject = encode('UTF-8', $message->{'subject'});
1180     my $content = encode('UTF-8', $message->{'content'});
1181     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1182     my $is_html = $content_type =~ m/html/io;
1183     my $branch_email = undef;
1184     my $branch_replyto = undef;
1185     my $branch_returnpath = undef;
1186     if ($member){
1187         my $branchdetail = GetBranchDetail( $member->{'branchcode'} );
1188         $branch_email = $branchdetail->{'branchemail'};
1189         $branch_replyto = $branchdetail->{'branchreplyto'};
1190         $branch_returnpath = $branchdetail->{'branchreturnpath'};
1191     }
1192     my $email = Koha::Email->new();
1193     my %sendmail_params = $email->create_message_headers(
1194         {
1195             to      => $to_address,
1196             from    => $message->{'from_address'} || $branch_email,
1197             replyto => $branch_replyto,
1198             sender  => $branch_returnpath,
1199             subject => $subject,
1200             message => $is_html ? _wrap_html( $content, $subject ) : $content,
1201             contenttype => $content_type
1202         }
1203     );
1204
1205     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1206     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
1207        $sendmail_params{ Bcc } = $bcc;
1208     }
1209
1210     _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
1211     if ( sendmail( %sendmail_params ) ) {
1212         _set_message_status( { message_id => $message->{'message_id'},
1213                 status     => 'sent' } );
1214         return 1;
1215     } else {
1216         _set_message_status( { message_id => $message->{'message_id'},
1217                 status     => 'failed' } );
1218         carp $Mail::Sendmail::error;
1219         return;
1220     }
1221 }
1222
1223 sub _wrap_html {
1224     my ($content, $title) = @_;
1225
1226     my $css = C4::Context->preference("NoticeCSS") || '';
1227     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1228     return <<EOS;
1229 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1230     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1231 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1232 <head>
1233 <title>$title</title>
1234 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1235 $css
1236 </head>
1237 <body>
1238 $content
1239 </body>
1240 </html>
1241 EOS
1242 }
1243
1244 sub _is_duplicate {
1245     my ( $message ) = @_;
1246     my $dbh = C4::Context->dbh;
1247     my $count = $dbh->selectrow_array(q|
1248         SELECT COUNT(*)
1249         FROM message_queue
1250         WHERE message_transport_type = ?
1251         AND borrowernumber = ?
1252         AND letter_code = ?
1253         AND CAST(time_queued AS date) = CAST(NOW() AS date)
1254         AND status="sent"
1255         AND content = ?
1256     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1257     return $count;
1258 }
1259
1260 sub _send_message_by_sms {
1261     my $message = shift or return;
1262     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
1263
1264     unless ( $member->{smsalertnumber} ) {
1265         _set_message_status( { message_id => $message->{'message_id'},
1266                                status     => 'failed' } );
1267         return;
1268     }
1269
1270     if ( _is_duplicate( $message ) ) {
1271         _set_message_status( { message_id => $message->{'message_id'},
1272                                status     => 'failed' } );
1273         return;
1274     }
1275
1276     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
1277                                        message     => $message->{'content'},
1278                                      } );
1279     _set_message_status( { message_id => $message->{'message_id'},
1280                            status     => ($success ? 'sent' : 'failed') } );
1281     return $success;
1282 }
1283
1284 sub _update_message_to_address {
1285     my ($id, $to)= @_;
1286     my $dbh = C4::Context->dbh();
1287     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1288 }
1289
1290 sub _set_message_status {
1291     my $params = shift or return;
1292
1293     foreach my $required_parameter ( qw( message_id status ) ) {
1294         return unless exists $params->{ $required_parameter };
1295     }
1296
1297     my $dbh = C4::Context->dbh();
1298     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1299     my $sth = $dbh->prepare( $statement );
1300     my $result = $sth->execute( $params->{'status'},
1301                                 $params->{'message_id'} );
1302     return $result;
1303 }
1304
1305
1306 1;
1307 __END__