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