Letters.pm 58.8 KB
Newer Older
1 2 3 4 5 6
package C4::Letters;

# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
7 8 9 10
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
11
#
12 13 14 15
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
16
#
17 18
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19

20
use Modern::Perl;
21

22
use MIME::Lite;
tipaul's avatar
tipaul committed
23
use Mail::Sendmail;
24 25 26 27 28
use Date::Calc qw( Add_Delta_Days );
use Encode;
use Carp;
use Template;
use Module::Load::Conditional qw(can_load);
29

tipaul's avatar
tipaul committed
30
use C4::Members;
31
use C4::Members::Attributes qw(GetBorrowerAttributes);
tipaul's avatar
tipaul committed
32
use C4::Log;
33
use C4::SMS;
34
use C4::Debug;
35
use Koha::DateUtils;
36
use Koha::SMS::Providers;
37

38
use Koha::Email;
39
use Koha::Notice::Messages;
40
use Koha::DateUtils qw( format_sqldatetime dt_from_string );
41
use Koha::Patrons;
42
use Koha::Subscriptions;
43

44
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
45

46
BEGIN {
47 48 49
    require Exporter;
    @ISA = qw(Exporter);
    @EXPORT = qw(
50
        &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
51
    );
52
}
53 54 55 56 57 58 59 60 61 62 63 64 65

=head1 NAME

C4::Letters - Give functions for Letters management

=head1 SYNOPSIS

  use C4::Letters;

=head1 DESCRIPTION

  "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  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)
tipaul's avatar
tipaul committed
66

67 68
  Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.

69
=head2 GetLetters([$module])
70

71
  $letters = &GetLetters($module);
tipaul's avatar
tipaul committed
72
  returns informations about letters.
73
  if needed, $module filters for letters given module
74

75 76 77
  DEPRECATED - You must use Koha::Notice::Templates instead
  The group by clause is confusing and can lead to issues

78 79
=cut

80
sub GetLetters {
81 82
    my ($filters) = @_;
    my $module    = $filters->{module};
83
    my $code      = $filters->{code};
84
    my $branchcode = $filters->{branchcode};
85 86 87
    my $dbh       = C4::Context->dbh;
    my $letters   = $dbh->selectall_arrayref(
        q|
88
            SELECT code, module, name
89 90 91 92
            FROM letter
            WHERE 1
        |
          . ( $module ? q| AND module = ?| : q|| )
93
          . ( $code   ? q| AND code = ?|   : q|| )
94
          . ( defined $branchcode   ? q| AND branchcode = ?|   : q|| )
95
          . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
96
        , ( $module ? $module : () )
97
        , ( $code ? $code : () )
98
        , ( defined $branchcode ? $branchcode : () )
99
    );
100

101
    return $letters;
102 103
}

104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
=head2 GetLetterTemplates

    my $letter_templates = GetLetterTemplates(
        {
            module => 'circulation',
            code => 'my code',
            branchcode => 'CPL', # '' for default,
        }
    );

    Return a hashref of letter templates.

=cut

sub GetLetterTemplates {
    my ( $params ) = @_;

    my $module    = $params->{module};
    my $code      = $params->{code};
123
    my $branchcode = $params->{branchcode} // '';
124
    my $dbh       = C4::Context->dbh;
125
    my $letters   = $dbh->selectall_arrayref(
126
        q|
127
            SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
128 129 130 131 132
            FROM letter
            WHERE module = ?
            AND code = ?
            and branchcode = ?
        |
133
        , { Slice => {} }
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
        , $module, $code, $branchcode
    );

    return $letters;
}

=head2 GetLettersAvailableForALibrary

    my $letters = GetLettersAvailableForALibrary(
        {
            branchcode => 'CPL', # '' for default
            module => 'circulation',
        }
    );

    Return an arrayref of letters, sorted by name.
    If a specific letter exist for the given branchcode, it will be retrieve.
    Otherwise the default letter will be.

=cut

sub GetLettersAvailableForALibrary {
    my ($filters)  = @_;
    my $branchcode = $filters->{branchcode};
    my $module     = $filters->{module};

    croak "module should be provided" unless $module;

    my $dbh             = C4::Context->dbh;
    my $default_letters = $dbh->selectall_arrayref(
        q|
            SELECT module, code, branchcode, name
            FROM letter
            WHERE 1
        |
          . q| AND branchcode = ''|
          . ( $module ? q| AND module = ?| : q|| )
          . q| ORDER BY name|, { Slice => {} }
        , ( $module ? $module : () )
    );

    my $specific_letters;
    if ($branchcode) {
        $specific_letters = $dbh->selectall_arrayref(
            q|
                SELECT module, code, branchcode, name
                FROM letter
                WHERE 1
            |
              . q| AND branchcode = ?|
              . ( $module ? q| AND module = ?| : q|| )
              . q| ORDER BY name|, { Slice => {} }
            , $branchcode
            , ( $module ? $module : () )
        );
    }

    my %letters;
    for my $l (@$default_letters) {
        $letters{ $l->{code} } = $l;
    }
    for my $l (@$specific_letters) {
        # Overwrite the default letter with the specific one.
        $letters{ $l->{code} } = $l;
    }

    return [ map { $letters{$_} }
          sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
          keys %letters ];

}

206
sub getletter {
207
    my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
208
    $message_transport_type //= '%';
209 210
    $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );

211

212 213 214
    my $only_my_library = C4::Context->only_my_library;
    if ( $only_my_library and $branchcode ) {
        $branchcode = C4::Context::mybranch();
215
    }
216
    $branchcode //= '';
217

218
    my $dbh = C4::Context->dbh;
219 220 221
    my $sth = $dbh->prepare(q{
        SELECT *
        FROM letter
222 223
        WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
        AND message_transport_type LIKE ?
224
        AND lang =?
225 226
        ORDER BY branchcode DESC LIMIT 1
    });
227
    $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
228 229 230 231
    my $line = $sth->fetchrow_hashref
      or return;
    $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
    return { %$line };
tipaul's avatar
tipaul committed
232 233
}

234

235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
=head2 DelLetter

    DelLetter(
        {
            branchcode => 'CPL',
            module => 'circulation',
            code => 'my code',
            [ mtt => 'email', ]
        }
    );

    Delete the letter. The mtt parameter is facultative.
    If not given, all templates mathing the other parameters will be removed.

=cut

sub DelLetter {
    my ($params)   = @_;
    my $branchcode = $params->{branchcode};
    my $module     = $params->{module};
    my $code       = $params->{code};
    my $mtt        = $params->{mtt};
257
    my $lang       = $params->{lang};
258 259 260 261 262 263
    my $dbh        = C4::Context->dbh;
    $dbh->do(q|
        DELETE FROM letter
        WHERE branchcode = ?
          AND module = ?
          AND code = ?
264 265 266 267
    |
    . ( $mtt ? q| AND message_transport_type = ?| : q|| )
    . ( $lang? q| AND lang = ?| : q|| )
    , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
268 269
}

tipaul's avatar
tipaul committed
270 271
=head2 SendAlerts

272
    my $err = &SendAlerts($type, $externalid, $letter_code);
tipaul's avatar
tipaul committed
273

274 275 276 277 278 279 280 281 282 283 284 285 286
    Parameters:
      - $type : the type of alert
      - $externalid : the id of the "object" to query
      - $letter_code : the notice template to use

    C<&SendAlerts> sends an email notice directly to a patron or a vendor.

    Currently it supports ($type):
      - claim serial issues (claimissues)
      - claim acquisition orders (claimacquisition)
      - send acquisition orders to the vendor (orderacquisition)
      - notify patrons about newly received serial issues (issue)
      - notify patrons when their account is created (members)
tipaul's avatar
tipaul committed
287

288 289 290
    Returns undef or { error => 'message } on failure.
    Returns true on success.

tipaul's avatar
tipaul committed
291 292
=cut

tipaul's avatar
tipaul committed
293
sub SendAlerts {
294
    my ( $type, $externalid, $letter_code ) = @_;
295 296 297 298
    my $dbh = C4::Context->dbh;
    if ( $type eq 'issue' ) {

        # prepare the letter...
299
        # search the subscriptionid
300 301
        my $sth =
          $dbh->prepare(
302
            "SELECT subscriptionid FROM serial WHERE serialid=?");
303
        $sth->execute($externalid);
304
        my ($subscriptionid) = $sth->fetchrow
305 306
          or warn( "No subscription for '$externalid'" ),
             return;
307

308 309 310 311 312 313 314 315 316
        # search the biblionumber
        $sth =
          $dbh->prepare(
            "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
        $sth->execute($subscriptionid);
        my ($biblionumber) = $sth->fetchrow
          or warn( "No biblionumber for '$subscriptionid'" ),
             return;

317
        my %letter;
318 319 320 321
        # find the list of subscribers to notify
        my $subscription = Koha::Subscriptions->find( $subscriptionid );
        my $subscribers = $subscription->subscribers;
        while ( my $patron = $subscribers->next ) {
322
            my $email = $patron->email or next;
323

324
#                    warn "sending issues...";
325
            my $userenv = C4::Context->userenv;
326
            my $library = $patron->library;
327 328 329 330 331
            my $letter = GetPreparedLetter (
                module => 'serial',
                letter_code => $letter_code,
                branchcode => $userenv->{branch},
                tables => {
332
                    'branches'    => $library->branchcode,
333 334
                    'biblio'      => $biblionumber,
                    'biblioitems' => $biblionumber,
335
                    'borrowers'   => $patron->unblessed,
336 337
                    'subscription' => $subscriptionid,
                    'serial' => $externalid,
338 339 340
                },
                want_librarian => 1,
            ) or return;
341 342

            # ... then send mail
343 344 345 346
            my $message = Koha::Email->new();
            my %mail = $message->create_message_headers(
                {
                    to      => $email,
347 348 349
                    from    => $library->branchemail,
                    replyto => $library->branchreplyto,
                    sender  => $library->branchreturnpath,
350 351 352 353 354 355 356 357
                    subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
                    message => $letter->{'is_html'}
                                ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
                                              Encode::encode( "UTF-8", "" . $letter->{'title'} ))
                                : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
                    contenttype => $letter->{'is_html'}
                                    ? 'text/html; charset="utf-8"'
                                    : 'text/plain; charset="utf-8"',
358 359
                }
            );
360
            unless( Mail::Sendmail::sendmail(%mail) ) {
361 362 363
                carp $Mail::Sendmail::error;
                return { error => $Mail::Sendmail::error };
            }
364 365
        }
    }
366
    elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
367 368

        # prepare the letter...
369 370 371 372 373 374
        my $strsth;
        my $sthorders;
        my $dataorders;
        my $action;
        if ( $type eq 'claimacquisition') {
            $strsth = qq{
375
            SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
376 377 378
            FROM aqorders
            LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
379
            LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
380
            WHERE aqorders.ordernumber IN (
381 382 383 384 385
            };

            if (!@$externalid){
                carp "No order selected";
                return { error => "no_order_selected" };
386
            }
387
            $strsth .= join( ",", ('?') x @$externalid ) . ")";
388 389
            $action = "ACQUISITION CLAIM";
            $sthorders = $dbh->prepare($strsth);
390
            $sthorders->execute( @$externalid );
391 392 393 394 395
            $dataorders = $sthorders->fetchall_arrayref( {} );
        }

        if ($type eq 'claimissues') {
            $strsth = qq{
396 397
            SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*,
            aqbooksellers.id AS booksellerid
398 399 400 401 402
            FROM serial
            LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
            LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
            LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
            WHERE serial.serialid IN (
403
            };
404

405 406 407 408 409
            if (!@$externalid){
                carp "No Order selected";
                return { error => "no_order_selected" };
            }

410
            $strsth .= join( ",", ('?') x @$externalid ) . ")";
411 412
            $action = "CLAIM ISSUE";
            $sthorders = $dbh->prepare($strsth);
413
            $sthorders->execute( @$externalid );
414
            $dataorders = $sthorders->fetchall_arrayref( {} );
415 416
        }

417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436
        if ( $type eq 'orderacquisition') {
            $strsth = qq{
            SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
            FROM aqorders
            LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
            LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
            WHERE aqbasket.basketno = ?
            AND orderstatus IN ('new','ordered')
            };

            if (!$externalid){
                carp "No basketnumber given";
                return { error => "no_basketno" };
            }
            $action = "ACQUISITION ORDER";
            $sthorders = $dbh->prepare($strsth);
            $sthorders->execute($externalid);
            $dataorders = $sthorders->fetchall_arrayref( {} );
        }
437 438 439 440 441

        my $sthbookseller =
          $dbh->prepare("select * from aqbooksellers where id=?");
        $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
        my $databookseller = $sthbookseller->fetchrow_hashref;
442 443 444

        my $addressee =  $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';

445 446 447 448
        my $sthcontact =
          $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
        $sthcontact->execute( $dataorders->[0]->{booksellerid} );
        my $datacontact = $sthcontact->fetchrow_hashref;
449 450

        my @email;
451
        my @cc;
452
        push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
453
        push @email, $datacontact->{email}           if ( $datacontact && $datacontact->{email} );
454 455
        unless (@email) {
            warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
456
            return { error => "no_email" };
457
        }
458 459 460 461
        my $addlcontact;
        while ($addlcontact = $sthcontact->fetchrow_hashref) {
            push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
        }
462 463

        my $userenv = C4::Context->userenv;
464 465 466 467 468 469 470
        my $letter = GetPreparedLetter (
            module => $type,
            letter_code => $letter_code,
            branchcode => $userenv->{branch},
            tables => {
                'branches'    => $userenv->{branch},
                'aqbooksellers' => $databookseller,
471
                'aqcontacts'    => $datacontact,
472 473 474
            },
            repeat => $dataorders,
            want_librarian => 1,
475
        ) or return { error => "no_letter" };
476

477 478 479
        # Remove the order tag
        $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;

tipaul's avatar
tipaul committed
480
        # ... then send mail
481
        my $library = Koha::Libraries->find( $userenv->{branch} );
482
        my %mail = (
483
            To => join( ',', @email),
484
            Cc             => join( ',', @cc),
485
            From           => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'),
486 487 488 489 490 491 492 493
            Subject        => Encode::encode( "UTF-8", "" . $letter->{title} ),
            Message => $letter->{'is_html'}
                            ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
                                          Encode::encode( "UTF-8", "" . $letter->{'title'} ))
                            : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
            'Content-Type' => $letter->{'is_html'}
                                ? 'text/html; charset="utf-8"'
                                : 'text/plain; charset="utf-8"',
494
        );
495

496 497 498 499 500 501 502 503
        if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
            $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
              if C4::Context->preference('ReplytoDefault');
            $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
              if C4::Context->preference('ReturnpathDefault');
            $mail{'Bcc'} = $userenv->{emailaddress}
              if C4::Context->preference("ClaimsBccCopy");
        }
504

505
        unless ( Mail::Sendmail::sendmail(%mail) ) {
506 507 508
            carp $Mail::Sendmail::error;
            return { error => $Mail::Sendmail::error };
        }
509

510 511
        logaction(
            "ACQUISITION",
512
            $action,
513 514
            undef,
            "To="
515
                . join( ',', @email )
516 517 518 519 520
                . " Title="
                . $letter->{title}
                . " Content="
                . $letter->{content}
        ) if C4::Context->preference("LetterLog");
521
    }
522
   # send an "account details" notice to a newly created user
523
    elsif ( $type eq 'members' ) {
524
        my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
525 526 527 528 529
        my $letter = GetPreparedLetter (
            module => 'members',
            letter_code => $letter_code,
            branchcode => $externalid->{'branchcode'},
            tables => {
530
                'branches'    => $library,
531 532 533 534 535
                'borrowers' => $externalid->{'borrowernumber'},
            },
            substitute => { 'borrowers.password' => $externalid->{'password'} },
            want_librarian => 1,
        ) or return;
536
        return { error => "no_email" } unless $externalid->{'emailaddr'};
537 538 539 540
        my $email = Koha::Email->new();
        my %mail  = $email->create_message_headers(
            {
                to      => $externalid->{'emailaddr'},
541 542 543
                from    => $library->{branchemail},
                replyto => $library->{branchreplyto},
                sender  => $library->{branchreturnpath},
544 545 546 547 548 549 550 551
                subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
                message => $letter->{'is_html'}
                            ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
                                          Encode::encode( "UTF-8", "" . $letter->{'title'}  ) )
                            : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
                contenttype => $letter->{'is_html'}
                                ? 'text/html; charset="utf-8"'
                                : 'text/plain; charset="utf-8"',
552
            }
553
        );
554
        unless( Mail::Sendmail::sendmail(%mail) ) {
555 556 557
            carp $Mail::Sendmail::error;
            return { error => $Mail::Sendmail::error };
        }
558
    }
559 560 561

    # If we come here, return an OK status
    return 1;
tipaul's avatar
tipaul committed
562 563
}

564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583
=head2 GetPreparedLetter( %params )

    %params hash:
      module => letter module, mandatory
      letter_code => letter code, mandatory
      branchcode => for letter selection, if missing default system letter taken
      tables => a hashref with table names as keys. Values are either:
        - a scalar - primary key value
        - an arrayref - primary key values
        - a hashref - full record
      substitute => custom substitution key/value pairs
      repeat => records to be substituted on consecutive lines:
        - an arrayref - tries to guess what needs substituting by
          taking remaining << >> tokensr; not recommended
        - a hashref token => @tables - replaces <token> << >> << >> </token>
          subtemplate for each @tables row; table is a hashref as above
      want_librarian => boolean,  if set to true triggers librarian details
        substitution from the userenv
    Return value:
      letter fields hashref (title & content useful)
tipaul's avatar
tipaul committed
584

tipaul's avatar
tipaul committed
585
=cut
tipaul's avatar
tipaul committed
586

587 588 589
sub GetPreparedLetter {
    my %params = @_;

590
    my $letter = $params{letter};
591 592

    unless ( $letter ) {
593 594 595 596 597 598 599 600 601 602 603 604 605
        my $module      = $params{module} or croak "No module";
        my $letter_code = $params{letter_code} or croak "No letter_code";
        my $branchcode  = $params{branchcode} || '';
        my $mtt         = $params{message_transport_type} || 'email';
        my $lang        = $params{lang} || 'default';

        $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );

        unless ( $letter ) {
            $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
                or warn( "No $module $letter_code letter transported by " . $mtt ),
                    return;
        }
606
    }
607

608 609
    my $tables = $params{tables} || {};
    my $substitute = $params{substitute} || {};
610
    my $loops  = $params{loops} || {}; # loops is not supported for historical notices syntax
611
    my $repeat = $params{repeat};
612 613
    %$tables || %$substitute || $repeat || %$loops
      or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
614 615 616
         return;
    my $want_librarian = $params{want_librarian};

617
    if (%$substitute) {
618
        while ( my ($token, $val) = each %$substitute ) {
619 620 621 622
            if ( $token eq 'items.content' ) {
                $val =~ s|\n|<br/>|g if $letter->{is_html};
            }

623 624 625 626 627
            $letter->{title} =~ s/<<$token>>/$val/g;
            $letter->{content} =~ s/<<$token>>/$val/g;
       }
    }

628 629 630
    my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
    $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;

631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662
    if ($want_librarian) {
        # parsing librarian name
        my $userenv = C4::Context->userenv;
        $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
        $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
        $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
    }

    my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);

    if ($repeat) {
        if (ref ($repeat) eq 'ARRAY' ) {
            $repeat_no_enclosing_tags = $repeat;
        } else {
            $repeat_enclosing_tags = $repeat;
        }
    }

    if ($repeat_enclosing_tags) {
        while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
            if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
                my $subcontent = $1;
                my @lines = map {
                    my %subletter = ( title => '', content => $subcontent );
                    _substitute_tables( \%subletter, $_ );
                    $subletter{content};
                } @$tag_tables;
                $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
            }
        }
    }

663
    if (%$tables) {
664 665
        _substitute_tables( $letter, $tables );
    }
666

667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685
    if ($repeat_no_enclosing_tags) {
        if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
            my $line = $&;
            my $i = 1;
            my @lines = map {
                my $c = $line;
                $c =~ s/<<count>>/$i/go;
                foreach my $field ( keys %{$_} ) {
                    $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
                }
                $i++;
                $c;
            } @$repeat_no_enclosing_tags;

            my $replaceby = join( "\n", @lines );
            $letter->{content} =~ s/\Q$line\E/$replaceby/s;
        }
    }

686 687 688 689
    $letter->{content} = _process_tt(
        {
            content => $letter->{content},
            tables  => $tables,
690
            loops  => $loops,
691
            substitute => $substitute,
692 693 694
        }
    );

695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719
    $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers

    return $letter;
}

sub _substitute_tables {
    my ( $letter, $tables ) = @_;
    while ( my ($table, $param) = each %$tables ) {
        next unless $param;

        my $ref = ref $param;

        my $values;
        if ($ref && $ref eq 'HASH') {
            $values = $param;
        }
        else {
            my $sth = _parseletter_sth($table);
            unless ($sth) {
                warn "_parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
                return;
            }
            $sth->execute( $ref ? @$param : $param );

            $values = $sth->fetchrow_hashref;
720
            $sth->finish();
721 722 723 724 725 726 727
        }

        _parseletter ( $letter, $table, $values );
    }
}

sub _parseletter_sth {
728
    my $table = shift;
729
    my $sth;
730
    unless ($table) {
731
        carp "ERROR: _parseletter_sth() called without argument (table)";
732 733
        return;
    }
734 735 736 737
    # NOTE: we used to check whether we had a statement handle cached in
    #       a %handles module-level variable. This was a dumb move and
    #       broke things for the rest of us. prepare_cached is a better
    #       way to cache statement handles anyway.
738
    my $query = 
739 740 741 742 743 744 745 746 747 748 749 750 751
    ($table eq 'biblio'       )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
    ($table eq 'biblioitems'  )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
    ($table eq 'items'        )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
    ($table eq 'issues'       )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
    ($table eq 'old_issues'   )    ? "SELECT * FROM $table WHERE     itemnumber = ? ORDER BY timestamp DESC LIMIT 1"  :
    ($table eq 'reserves'     )    ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?"             :
    ($table eq 'borrowers'    )    ? "SELECT * FROM $table WHERE borrowernumber = ?"                                  :
    ($table eq 'branches'     )    ? "SELECT * FROM $table WHERE     branchcode = ?"                                  :
    ($table eq 'suggestions'  )    ? "SELECT * FROM $table WHERE   suggestionid = ?"                                  :
    ($table eq 'aqbooksellers')    ? "SELECT * FROM $table WHERE             id = ?"                                  :
    ($table eq 'aqorders'     )    ? "SELECT * FROM $table WHERE    ordernumber = ?"                                  :
    ($table eq 'opac_news'    )    ? "SELECT * FROM $table WHERE          idnew = ?"                                  :
    ($table eq 'article_requests') ? "SELECT * FROM $table WHERE             id = ?"                                  :
752
    ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
753 754
    ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
    ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
755
    undef ;
756
    unless ($query) {
757
        warn "ERROR: No _parseletter_sth query for table '$table'";
758 759
        return;     # nothing to get
    }
760
    unless ($sth = C4::Context->dbh->prepare_cached($query)) {
761 762
        warn "ERROR: Failed to prepare query: '$query'";
        return;
763
    }
764
    return $sth;    # now cache is populated for that $table
765
}
766

767 768 769 770 771
=head2 _parseletter($letter, $table, $values)

    parameters :
    - $letter : a hash to letter fields (title & content useful)
    - $table : the Koha table to parse.
772
    - $values_in : table record hashref
773 774 775 776 777 778
    parse all fields from a table, and replace values in title & content with the appropriate value
    (not exported sub, used only internally)

=cut

sub _parseletter {
779 780 781 782
    my ( $letter, $table, $values_in ) = @_;

    # Work on a local copy of $values_in (passed by reference) to avoid side effects
    # in callers ( by changing / formatting values )
783
    my $values = $values_in ? { %$values_in } : {};
784

785
    if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
786
        $values->{'dateexpiry'} = output_pref({ str => $values->{dateexpiry}, dateonly => 1 });
787 788
    }

789
    if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
790
        $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
791
    }
792

793
    if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
794
        my $todaysdate = output_pref( DateTime->now() );
795 796
        $letter->{content} =~ s/<<today>>/$todaysdate/go;
    }
797

798
    while ( my ($field, $val) = each %$values ) {
799 800 801 802 803
        $val =~ s/\p{P}$// if $val && $table=~/biblio/;
            #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
            #Therefore adding the test on biblio. This includes biblioitems,
            #but excludes items. Removed unneeded global and lookahead.

804 805 806 807
        if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
            my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
            $val = $av->count ? $av->next->lib : '';
        }
808 809

        # Dates replacement
810
        my $replacedby   = defined ($val) ? $val : '';
811 812
        if (    $replacedby
            and not $replacedby =~ m|0000-00-00|
813
            and not $replacedby =~ m|9999-12-31|
814 815
            and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
        {
816
            # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
817
            my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
818 819 820 821 822 823 824 825 826
            my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;

            for my $letter_field ( qw( title content ) ) {
                my $filter_string_used = q{};
                if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
                    # We overwrite $dateonly if the filter exists and we have a time in the datetime
                    $filter_string_used = $1 || q{};
                    $dateonly = $1 unless $dateonly;
                }
827 828
                my $replacedby_date = eval {
                    output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
829 830 831
                };

                if ( $letter->{ $letter_field } ) {
832 833
                    $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
                    $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
834 835 836 837 838 839 840 841 842 843 844
                }
            }
        }
        # Other fields replacement
        else {
            for my $letter_field ( qw( title content ) ) {
                if ( $letter->{ $letter_field } ) {
                    $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
                    $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
                }
            }
845
        }
846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864
    }

    if ($table eq 'borrowers' && $letter->{content}) {
        if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
            my %attr;
            foreach (@$attributes) {
                my $code = $_->{code};
                my $val  = $_->{value_description} || $_->{value};
                $val =~ s/\p{P}(?=$)//g if $val;
                next unless $val gt '';
                $attr{$code} ||= [];
                push @{ $attr{$code} }, $val;
            }
            while ( my ($code, $val_ar) = each %attr ) {
                my $replacefield = "<<borrower-attribute:$code>>";
                my $replacedby   = join ',', @$val_ar;
                $letter->{content} =~ s/$replacefield/$replacedby/g;
            }
        }
865
    }
866
    return $letter;
tipaul's avatar
tipaul committed
867 868
}

869 870
=head2 EnqueueLetter

Andrew Elwell's avatar
Andrew Elwell committed
871 872
  my $success = EnqueueLetter( { letter => $letter, 
        borrowernumber => '12', message_transport_type => 'email' } )
873 874 875 876 877

places a letter in the message_queue database table, which will
eventually get processed (sent) by the process_message_queue.pl
cronjob when it calls SendQueuedMessages.

878
return message_id on success
879 880 881

=cut

882 883
sub EnqueueLetter {
    my $params = shift or return;
884 885

    return unless exists $params->{'letter'};
886
#   return unless exists $params->{'borrowernumber'};
887
    return unless exists $params->{'message_transport_type'};
888

889 890 891 892 893 894 895
    my $content = $params->{letter}->{content};
    $content =~ s/\s+//g if(defined $content);
    if ( not defined $content or $content eq '' ) {
        warn "Trying to add an empty message to the message queue" if $debug;
        return;
    }

896 897 898 899 900 901 902 903 904 905 906
    # If we have any attachments we should encode then into the body.
    if ( $params->{'attachments'} ) {
        $params->{'letter'} = _add_attachments(
            {   letter      => $params->{'letter'},
                attachments => $params->{'attachments'},
                message     => MIME::Lite->new( Type => 'multipart/mixed' ),
            }
        );
    }

    my $dbh       = C4::Context->dbh();
907 908
    my $statement = << 'ENDSQL';
INSERT INTO message_queue
John Beppu's avatar
John Beppu committed
909
( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
910
VALUES
John Beppu's avatar
John Beppu committed
911
( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
912 913
ENDSQL

914 915 916 917 918
    my $sth    = $dbh->prepare($statement);
    my $result = $sth->execute(
        $params->{'borrowernumber'},              # borrowernumber
        $params->{'letter'}->{'title'},           # subject
        $params->{'letter'}->{'content'},         # content
John Beppu's avatar
John Beppu committed
919 920
        $params->{'letter'}->{'metadata'} || '',  # metadata
        $params->{'letter'}->{'code'}     || '',  # letter_code
921 922 923 924 925 926
        $params->{'message_transport_type'},      # message_transport_type
        'pending',                                # status
        $params->{'to_address'},                  # to_address
        $params->{'from_address'},                # from_address
        $params->{'letter'}->{'content-type'},    # content_type
    );
927
    return $dbh->last_insert_id(undef,undef,'message_queue', undef);
928 929
}

930
=head2 SendQueuedMessages ([$hashref]) 
931

932 933 934 935
    my $sent = SendQueuedMessages({
        letter_code => $letter_code,
        borrowernumber => $who_letter_is_for,
        limit => 50,
936 937
        verbose => 1,
        type => 'sms',
938 939 940 941
    });

Sends all of the 'pending' items in the message queue, unless
parameters are passed.
942

943 944 945 946 947 948
The letter_code, borrowernumber and limit parameters are used
to build a parameter set for _get_unsent_messages, thus limiting
which pending messages will be processed. They are all optional.

The verbose parameter can be used to generate debugging output.
It is also optional.
949

950
Returns number of messages sent.
951 952 953

=cut

954
sub SendQueuedMessages {
955 956
    my $params = shift;

957 958 959 960
    my $which_unsent_messages  = {
        'limit'          => $params->{'limit'} // 0,
        'borrowernumber' => $params->{'borrowernumber'} // q{},
        'letter_code'    => $params->{'letter_code'} // q{},
961
        'type'           => $params->{'type'} // q{},
962 963
    };
    my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
964
    MESSAGE: foreach my $message ( @$unsent_messages ) {
965 966
        my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
        # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
967 968
        $message_object->make_column_dirty('status');
        return unless $message_object->store;
969

970
        # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
971 972 973
        warn sprintf( 'sending %s message to patron: %s',
                      $message->{'message_transport_type'},
                      $message->{'borrowernumber'} || 'Admin' )
974
          if $params->{'verbose'} or $debug;
975
        # This is just begging for subclassing
976
        next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
977
        if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
978
            _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
979
        }
980
        elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
981
            if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
982 983
                my $patron = Koha::Patrons->find( $message->{borrowernumber} );
                my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
984 985
                unless ( $sms_provider ) {
                    warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
986 987 988
                    _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
                    next MESSAGE;
                }
989
                unless ( $patron->smsalertnumber ) {
990 991
                    _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
                    warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
992 993
                    next MESSAGE;
                }
994
                $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
995
                $message->{to_address} .= '@' . $sms_provider->domain();
996
                _update_message_to_address($message->{'message_id'},$message->{to_address});
997 998 999 1000
                _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
            } else {
                _send_message_by_sms( $message );
            }
1001 1002 1003 1004 1005
        }
    }
    return scalar( @$unsent_messages );
}

1006 1007
=head2 GetRSSMessages

Andrew Elwell's avatar
Andrew Elwell committed
1008
  my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025

returns a listref of all queued RSS messages for a particular person.

=cut

sub GetRSSMessages {
    my $params = shift;

    return unless $params;
    return unless ref $params;
    return unless $params->{'borrowernumber'};
    
    return _get_unsent_messages( { message_transport_type => 'rss',
                                   limit                  => $params->{'limit'},
                                   borrowernumber         => $params->{'borrowernumber'}, } );
}

1026 1027
=head2 GetPrintMessages

Andrew Elwell's avatar
Andrew Elwell committed
1028
  my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1029 1030 1031 1032 1033 1034 1035 1036 1037 1038

Returns a arrayref of all queued print messages (optionally, for a particular
person).

=cut

sub GetPrintMessages {
    my $params = shift || {};
    
    return _get_unsent_messages( { message_transport_type => 'print',
1039 1040
                                   borrowernumber         => $params->{'borrowernumber'},
                                 } );
1041 1042
}

1043
=head2 GetQueuedMessages ([$hashref])
1044

Andrew Elwell's avatar
Andrew Elwell committed
1045
  my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080

fetches messages out of the message queue.

returns:
list of hashes, each has represents a message in the message queue.

=cut

sub GetQueuedMessages {
    my $params = shift;

    my $dbh = C4::Context->dbh();
    my $statement = << 'ENDSQL';
SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
FROM message_queue
ENDSQL

    my @query_params;
    my @whereclauses;
    if ( exists $params->{'borrowernumber'} ) {
        push @whereclauses, ' borrowernumber = ? ';
        push @query_params, $params->{'borrowernumber'};
    }

    if ( @whereclauses ) {
        $statement .= ' WHERE ' . join( 'AND', @whereclauses );
    }

    if ( defined $params->{'limit'} ) {
        $statement .= ' LIMIT ? ';
        push @query_params, $params->{'limit'};
    }

    my $sth = $dbh->prepare( $statement );
    my $result = $sth->execute( @query_params );
1081
    return $sth->fetchall_arrayref({});
1082 1083
}

1084 1085 1086 1087
=head2 GetMessageTransportTypes

  my @mtt = GetMessageTransportTypes();

1088
  returns an arrayref of transport types
1089 1090 1091 1092 1093

=cut

sub GetMessageTransportTypes {
    my $dbh = C4::Context->dbh();
1094
    my $mtts = $dbh->selectcol_arrayref("
1095 1096 1097 1098
        SELECT message_transport_type
        FROM message_transport_types
        ORDER BY message_transport_type
    ");
1099
    return $mtts;
1100 1101
}

1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118
=head2 GetMessage

    my $message = C4::Letters::Message($message_id);

=cut

sub GetMessage {
    my ( $message_id ) = @_;
    return unless $message_id;
    my $dbh = C4::Context->dbh;
    return $dbh->selectrow_hashref(q|
        SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
        FROM message_queue
        WHERE message_id = ?
    |, {}, $message_id );
}

1119 1120
=head2 ResendMessage

1121
  Attempt to resend a message which has failed previously.
1122

1123
  my $has_been_resent = C4::Letters::ResendMessage($message_id);
1124 1125 1126 1127

  Updates the message to 'pending' status so that
  it will be resent later on.

1128
  returns 1 on success, 0 on failure, undef if no message was found
1129 1130 1131 1132 1133

=cut

sub ResendMessage {
    my $message_id = shift;
1134 1135 1136 1137
    return unless $message_id;

    my $message = GetMessage( $message_id );
    return unless $message;
1138
    my $rv = 0;
1139
    if ( $message->{status} ne 'pending' ) {
1140 1141 1142 1143 1144 1145 1146 1147
        $rv = C4::Letters::_set_message_status({
            message_id => $message_id,
            status => 'pending',
        });
        $rv = $rv > 0? 1: 0;
        # Clear destination email address to force address update
        _update_message_to_address( $message_id, undef ) if $rv &&
            $message->{message_transport_type} eq 'email';
1148
    }
1149
    return $rv;
1150 1151
}

1152 1153
=head2 _add_attachements

1154 1155 1156 1157 1158 1159 1160
  named parameters:
  letter - the standard letter hashref
  attachments - listref of attachments. each attachment is a hashref of:
    type - the mime type, like 'text/plain'
    content - the actual attachment
    filename - the name of the attachment.
  message - a MIME::Lite object to attach these to.
1161

1162
  returns your letter object, with the content updated.
1163 1164 1165 1166 1167 1168

=cut

sub _add_attachments {
    my $params = shift;

1169 1170 1171 1172
    my $letter = $params->{'letter'};
    my $attachments = $params->{'attachments'};
    return $letter unless @$attachments;
    my $message = $params->{'message'};
1173 1174

    # First, we have to put the body in as the first attachment
1175 1176 1177
    $message->attach(
        Type => $letter->{'content-type'} || 'TEXT',
        Data => $letter->{'is_html'}
1178 1179
            ? _wrap_html($letter->{'content'}, $letter->{'title'})
            : $letter->{'content'},
1180 1181
    );

1182 1183
    foreach my $attachment ( @$attachments ) {
        $message->attach(
1184 1185 1186 1187 1188 1189
            Type     => $attachment->{'type'},
            Data     => $attachment->{'content'},
            Filename => $attachment->{'filename'},
        );
    }
    # we're forcing list context here to get the header, not the count back from grep.
1190 1191 1192
    ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
    $letter->{'content-type'} =~ s/^Content-Type:\s+//;
    $letter->{'content'} = $message->body_as_string;
1193

1194
    return $letter;
1195 1196 1197

}

1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211
=head2 _get_unsent_messages

  This function's parameter hash reference takes the following
  optional named parameters:
   message_transport_type: method of message sending (e.g. email, sms, etc.)
   borrowernumber        : who the message is to be sent
   letter_code           : type of message being sent (e.g. PASSWORD_RESET)
   limit                 : maximum number of messages to send

  This function returns an array of matching hash referenced rows from
  message_queue with some borrower information added.

=cut

1212
sub _get_unsent_messages {
1213
    my $params = shift;
1214 1215

    my $dbh = C4::Context->dbh();
1216 1217 1218 1219 1220 1221
    my $statement = qq{
        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
        FROM message_queue mq
        LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
        WHERE status = ?
    };
1222

1223
    my @query_params = ('pending');
1224 1225
    if ( ref $params ) {
        if ( $params->{'message_transport_type'} ) {
1226
            $statement .= ' AND mq.message_transport_type = ? ';
1227 1228 1229
            push @query_params, $params->{'message_transport_type'};
        }
        if ( $params->{'borrowernumber'} ) {
1230
            $statement .= ' AND mq.borrowernumber = ? ';
1231 1232
            push @query_params, $params->{'borrowernumber'};
        }
1233 1234 1235 1236
        if ( $params->{'letter_code'} ) {
            $statement .= ' AND mq.letter_code = ? ';
            push @query_params, $params->{'letter_code'};
        }
1237 1238 1239 1240
        if ( $params->{'type'} ) {
            $statement .= ' AND message_transport_type = ? ';
            push @query_params, $params->{'type'};
        }
1241 1242 1243 1244 1245
        if ( $params->{'limit'} ) {
            $statement .= ' limit ? ';
            push @query_params, $params->{'limit'};
        }
    }
1246

1247 1248
    $debug and warn "_get_unsent_messages SQL: $statement";
    $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1249
    my $sth = $dbh->prepare( $statement );
1250
    my $result = $sth->execute( @query_params );
1251
    return $sth->fetchall_arrayref({});
1252 1253
}

1254
sub _send_message_by_email {
1255
    my $message = shift or return;
1256
    my ($username, $password, $method) = @_;
1257

1258
    my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1259
    my $to_address = $message->{'to_address'};
1260
    unless ($to_address) {
1261
        unless ($patron) {
1262 1263 1264 1265 1266
            warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
            _set_message_status( { message_id => $message->{'message_id'},
                                   status     => 'failed' } );
            return;
        }
1267
        $to_address = $patron->notice_email_address;
1268
        unless ($to_address) {  
1269 1270 1271 1272 1273 1274 1275
            # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
            # warning too verbose for this more common case?
            _set_message_status( { message_id => $message->{'message_id'},
                                   status     => 'failed' } );
            return;
        }
    }
1276

1277 1278
    my $utf8   = decode('MIME-Header', $message->{'subject'} );
    $message->{subject}= encode('MIME-Header', $utf8);
1279 1280
    my $subject = encode('UTF-8', $message->{'subject'});
    my $content = encode('UTF-8', $message->{'content'});
1281 1282
    my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
    my $is_html = $content_type =~ m/html/io;
1283 1284 1285
    my $branch_email = undef;
    my $branch_replyto = undef;
    my $branch_returnpath = undef;
1286 1287
    if ($patron) {
        my $library = $patron->library;
1288 1289 1290
        $branch_email      = $library->branchemail;
        $branch_replyto    = $library->branchreplyto;
        $branch_returnpath = $library->branchreturnpath;
1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302
    }
    my $email = Koha::Email->new();
    my %sendmail_params = $email->create_message_headers(
        {
            to      => $to_address,
            from    => $message->{'from_address'} || $branch_email,
            replyto => $branch_replyto,
            sender  => $branch_returnpath,
            subject => $subject,
            message => $is_html ? _wrap_html( $content, $subject ) : $content,
            contenttype => $content_type
        }
1303
    );
1304

1305
    $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1306
    if ( my $bcc = C4::Context->preference('NoticeBcc') ) {
1307 1308
       $sendmail_params{ Bcc } = $bcc;
    }
1309

Marcel de Rooy's avatar
Marcel de Rooy committed
1310
    _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
1311

1312
    if ( Mail::Sendmail::sendmail( %sendmail_params ) ) {
1313
        _set_message_status( { message_id => $message->{'message_id'},
1314 1315
                status     => 'sent' } );
        return 1;
1316 1317
    } else {
        _set_message_status( { message_id => $message->{'message_id'},
1318 1319
                status     => 'failed' } );
        carp $Mail::Sendmail::error;
1320 1321 1322 1323
        return;
    }
}

1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344
sub _wrap_html {
    my ($content, $title) = @_;

    my $css = C4::Context->preference("NoticeCSS") || '';
    $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
    return <<EOS;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$title</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
$css
</head>
<body>
$content
</body>
</html>
EOS
}

1345 1346 1347 1348 1349 1350 1351 1352 1353
sub _is_duplicate {
    my ( $message ) = @_;
    my $dbh = C4::Context->dbh;
    my $count = $dbh->selectrow_array(q|
        SELECT COUNT(*)
        FROM message_queue
        WHERE message_transport_type = ?
        AND borrowernumber = ?
        AND letter_code = ?
1354
        AND CAST(time_queued AS date) = CAST(NOW() AS date)
1355
        AND status="sent"
1356 1357
        AND content = ?
    |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );