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