C4/Letters.pm

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