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