File Coverage

File:C4/Letters.pm
Coverage:9.7%

linestmtbrancondsubtimecode
1package 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 under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
13
13
13
19235
46
380
use strict;
21
13
13
13
99
89
1263
use warnings;
22
23
13
13
13
59878
404137
648
use MIME::Lite;
24
13
13
13
4915
328671
1717
use Mail::Sendmail;
25
26
13
13
13
836
153
4103
use C4::Members;
27
13
13
13
2186
115
3560
use C4::Branch;
28
13
13
13
141
95
1565
use C4::Log;
29
13
13
13
2630
47
454
use C4::SMS;
30
13
13
13
112
41
1286
use C4::Debug;
31
13
13
13
81
34
741
use Date::Calc qw( Add_Delta_Days );
32
13
13
13
71
28
1306
use Encode;
33
13
13
13
91
29
958
use Carp;
34
35
13
13
13
80
44
1568
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
36
37BEGIN {
38
13
76
        require Exporter;
39        # set the version for version checking
40
13
63
        $VERSION = 3.01;
41
13
1041
        @ISA = qw(Exporter);
42
13
78833
        @EXPORT = qw(
43        &GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts GetPrintMessages
44        );
45}
46
47 - 93
=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)

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

=head2 GetLetters([$category])

  $letters = &GetLetters($category);
  returns informations about letters.
  if needed, $category filters for letters given category
  Create a letter selector with the following code

=head3 in PERL SCRIPT

my $letters = GetLetters($cat);
my @letterloop;
foreach my $thisletter (keys %$letters) {
    my $selected = 1 if $thisletter eq $letter;
    my %row =(
        value => $thisletter,
        selected => $selected,
        lettername => $letters->{$thisletter},
    );
    push @letterloop, \%row;
}
$template->param(LETTERLOOP => \@letterloop);

=head3 in TEMPLATE

    <select name="letter">
        <option value="">Default</option>
    <!-- TMPL_LOOP name="LETTERLOOP" -->
        <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
    <!-- /TMPL_LOOP -->
    </select>

=cut
94
95sub GetLetters (;$) {
96
97    # returns a reference to a hash of references to ALL letters...
98
0
    my $cat = shift;
99
0
    my %letters;
100
0
    my $dbh = C4::Context->dbh;
101
0
    my $sth;
102
0
    if (defined $cat) {
103
0
        my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name";
104
0
        $sth = $dbh->prepare($query);
105
0
        $sth->execute($cat);
106    }
107    else {
108
0
        my $query = "SELECT * FROM letter ORDER BY name";
109
0
        $sth = $dbh->prepare($query);
110
0
        $sth->execute;
111    }
112
0
    while ( my $letter = $sth->fetchrow_hashref ) {
113
0
        $letters{ $letter->{'code'} } = $letter->{'name'};
114    }
115
0
    return \%letters;
116}
117
118sub getletter ($$) {
119
0
    my ( $module, $code ) = @_;
120
0
    my $dbh = C4::Context->dbh;
121
0
    my $sth = $dbh->prepare("select * from letter where module=? and code=?");
122
0
    $sth->execute( $module, $code );
123
0
    my $line = $sth->fetchrow_hashref;
124
0
    return $line;
125}
126
127 - 136
=head2 addalert ($borrowernumber, $type, $externalid)

    parameters : 
    - $borrowernumber : the number of the borrower subscribing to the alert
    - $type : the type of alert.
    - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
    
    create an alert and return the alertid (primary key)

=cut
137
138sub addalert ($$$) {
139
0
    my ( $borrowernumber, $type, $externalid ) = @_;
140
0
    my $dbh = C4::Context->dbh;
141
0
    my $sth =
142      $dbh->prepare(
143        "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
144
0
    $sth->execute( $borrowernumber, $type, $externalid );
145
146    # get the alert number newly created and return it
147
0
    my $alertid = $dbh->{'mysql_insertid'};
148
0
    return $alertid;
149}
150
151 - 157
=head2 delalert ($alertid)

    parameters :
    - alertid : the alert id
    deletes the alert

=cut
158
159sub delalert ($) {
160
0
    my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway.
161
0
    $debug and warn "delalert: deleting alertid $alertid";
162
0
    my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
163
0
    $sth->execute($alertid);
164}
165
166 - 174
=head2 getalert ([$borrowernumber], [$type], [$externalid])

    parameters :
    - $borrowernumber : the number of the borrower subscribing to the alert
    - $type : the type of alert.
    - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
    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.

=cut
175
176sub getalert (;$$$) {
177
0
    my ( $borrowernumber, $type, $externalid ) = @_;
178
0
    my $dbh = C4::Context->dbh;
179
0
    my $query = "SELECT * FROM alert WHERE";
180
0
    my @bind;
181
0
    if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
182
0
        $query .= " borrowernumber=? AND ";
183
0
        push @bind, $borrowernumber;
184    }
185
0
    if ($type) {
186
0
        $query .= " type=? AND ";
187
0
        push @bind, $type;
188    }
189
0
    if ($externalid) {
190
0
        $query .= " externalid=? AND ";
191
0
        push @bind, $externalid;
192    }
193
0
    $query =~ s/ AND $//;
194
0
    my $sth = $dbh->prepare($query);
195
0
    $sth->execute(@bind);
196
0
    return $sth->fetchall_arrayref({});
197}
198
199 - 208
=head2 findrelatedto($type, $externalid)

	parameters :
	- $type : the type of alert
	- $externalid : the id of the "object" to query
	
	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.
	When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.

=cut
209
210# outmoded POD:
211# When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
212
213sub findrelatedto ($$) {
214
0
    my $type = shift or return undef;
215
0
    my $externalid = shift or return undef;
216
0
    my $q = ($type eq 'issue' ) ?
217"select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
218            ($type eq 'borrower') ?
219"select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
220
0
    unless ($q) {
221
0
        warn "findrelatedto(): Illegal type '$type'";
222
0
        return undef;
223    }
224
0
    my $sth = C4::Context->dbh->prepare($q);
225
0
    $sth->execute($externalid);
226
0
    my ($result) = $sth->fetchrow;
227
0
    return $result;
228}
229
230 - 239
=head2 SendAlerts

    parameters :
    - $type : the type of alert
    - $externalid : the id of the "object" to query
    - $letter : the letter to send.

    send an alert to all borrowers having put an alert on a given subject.

=cut
240
241sub SendAlerts {
242
0
    my ( $type, $externalid, $letter ) = @_;
243
0
    my $dbh = C4::Context->dbh;
244
0
    my $strsth;
245
0
    if ( $type eq 'issue' ) {
246
247        # warn "sending issues...";
248
0
        my $letter = getletter( 'serial', $letter );
249
250        # prepare the letter...
251        # search the biblionumber
252
0
        my $sth =
253          $dbh->prepare(
254            "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
255
0
        $sth->execute($externalid);
256
0
        my ($biblionumber) = $sth->fetchrow;
257
258        # parsing branch info
259
0
        my $userenv = C4::Context->userenv;
260
0
        parseletter( $letter, 'branches', $userenv->{branch} );
261
262        # parsing librarian name
263
0
        $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
264
0
        $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
265
0
        $letter->{content} =~
266          s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
267
268        # parsing biblio information
269
0
        parseletter( $letter, 'biblio', $biblionumber );
270
0
        parseletter( $letter, 'biblioitems', $biblionumber );
271
272        # find the list of borrowers to alert
273
0
        my $alerts = getalert( '', 'issue', $externalid );
274
0
        foreach (@$alerts) {
275
276            # and parse borrower ...
277
0
            my $innerletter = $letter;
278
0
            my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
279
0
            parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
280
281            # ... then send mail
282
0
            if ( $borinfo->{email} ) {
283
0
                my %mail = (
284                    To => $borinfo->{email},
285                    From => $borinfo->{email},
286                    Subject => "" . $innerletter->{title},
287                    Message => "" . $innerletter->{content},
288                    'Content-Type' => 'text/plain; charset="utf8"',
289                    );
290
0
                sendmail(%mail) or carp $Mail::Sendmail::error;
291
292            }
293        }
294    }
295    elsif ( $type eq 'claimacquisition' ) {
296
297
0
        $letter = getletter( 'claimacquisition', $letter );
298
299        # prepare the letter...
300        # search the biblionumber
301
0
        $strsth = qq{
302            SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*
303            FROM aqorders
304            LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
305            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
306            LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber
307            LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
308            WHERE aqorders.ordernumber IN (
309        }
310          . join( ",", @$externalid ) . ")";
311    }
312    elsif ( $type eq 'claimissues' ) {
313
314
0
        $letter = getletter( 'claimissues', $letter );
315
316        # prepare the letter...
317        # search the biblionumber
318
0
        $strsth = qq{
319            SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*
320            FROM serial
321            LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
322            LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
323            LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
324            WHERE serial.serialid IN (
325        }
326          . join( ",", @$externalid ) . ")";
327    }
328
329
0
    if ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
330
0
        my $sthorders = $dbh->prepare($strsth);
331
0
        $sthorders->execute;
332
0
        my @fields = map {
333
0
            $sthorders->{mysql_table}[$_] . "." . $sthorders->{NAME}[$_] }
334
0
            (0 .. $#{$sthorders->{NAME}} ) ;
335
336
0
        my @orders_infos;
337
0
        while ( my $row = $sthorders->fetchrow_arrayref() ) {
338
0
            my %rec = ();
339
0
            @rec{@fields} = @$row;
340
0
            push @orders_infos, \%rec;
341        }
342
343        # parsing branch info
344
0
        my $userenv = C4::Context->userenv;
345
0
        parseletter( $letter, 'branches', $userenv->{branch} );
346
347        # parsing librarian name
348
0
        $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
349
0
        $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
350
0
        $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
351
352        # Get Fields remplacement
353
0
        my $order_format = $1 if ( $letter->{content} =~ m/(<order>.*<\/order>)/xms );
354
355        # Foreach field to remplace
356
0
        while ( $letter->{content} =~ m/<<([^>]*)>>/g ) {
357
0
            my $field = $1;
358
0
            my $value = $orders_infos[0]->{$field} || "";
359
0
            $value = sprintf("%.2f", $value) if $field =~ /price/;
360
0
            $letter->{content} =~ s/<<$field>>/$value/g;
361        }
362
363
0
        if ( $order_format ) {
364            # For each order
365
0
            foreach my $infos ( @orders_infos ) {
366
0
                my $order_content = $order_format;
367                # We replace by value
368
0
                while ( $order_content =~ m/<<([^>]*)>>/g ) {
369
0
                    my $field = $1;
370
0
                    my $value = $infos->{$field} || "";
371
0
                    $value = sprintf("%.2f", $value) if $field =~ /price/;
372
0
                    $order_content =~ s/(<<$field>>)/$value/g;
373                }
374
0
                $order_content =~ s/<\/{0,1}?order>//g;
375
0
                $letter->{content} =~ s/<order>.*<\/order>/$order_content\n$order_format/xms;
376            }
377
0
            $letter->{content} =~ s/<order>.*<\/order>//xms;
378        }
379
380
0
        my $innerletter = $letter;
381
382        # ... then send mail
383
0
        if ( $orders_infos[0]->{'aqbooksellers.bookselleremail'}
384            || $orders_infos[0]->{'aqbooksellers.contemail'} ) {
385
0
            my $to = $orders_infos[0]->{'aqbooksellers.bookselleremail'};
386
0
            $to .= ", " if $to;
387
0
            $to .= $orders_infos[0]->{'aqbooksellers.contemail'} || "";
388
0
            my %mail = (
389                To => $to,
390                From => $userenv->{emailaddress},
391                Subject => Encode::encode( "utf8", "" . $innerletter->{title} ),
392                Message => Encode::encode( "utf8", "" . $innerletter->{content} ),
393                'Content-Type' => 'text/plain; charset="utf8"',
394            );
395
0
            sendmail(%mail) or carp $Mail::Sendmail::error;
396
0
            warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}" if $debug;
397
0
            if ( C4::Context->preference("LetterLog") ) {
398
0
                logaction( "ACQUISITION", "Send Acquisition claim letter", "", "order list : " . join( ",", @$externalid ) . "\n$innerletter->{title}\n$innerletter->{content}" ) if $type eq 'claimacquisition';
399
0
                logaction( "ACQUISITION", "CLAIM ISSUE", undef, "To=" . $mail{To} . " Title=" . $innerletter->{title} . " Content=" . $innerletter->{content} ) if $type eq 'claimissues';
400            }
401        } else {
402
0
            return {error => "no_email" };
403        }
404
405
0
        warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}" if $debug;
406    }
407
408    # send an "account details" notice to a newly created user
409    elsif ( $type eq 'members' ) {
410        # must parse the password special, before it's hashed.
411
0
        $letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g;
412
413
0
        parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'});
414
0
        parseletter( $letter, 'branches', $externalid->{'branchcode'} );
415
416
0
        my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
417
0
        my %mail = (
418                To => $externalid->{'emailaddr'},
419                From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"),
420                Subject => $letter->{'title'},
421                Message => $letter->{'content'},
422                'Content-Type' => 'text/plain; charset="utf8"',
423        );
424
0
        sendmail(%mail) or carp $Mail::Sendmail::error;
425    }
426}
427
428 - 437
=head2 parseletter($letter, $table, $pk)

    parameters :
    - $letter : a hash to letter fields (title & content useful)
    - $table : the Koha table to parse.
    - $pk : the primary key to query on the $table table
    parse all fields from a table, and replace values in title & content with the appropriate value
    (not exported sub, used only internally)

=cut
438
439our %handles = ();
440our %columns = ();
441
442sub parseletter_sth {
443
0
    my $table = shift;
444
0
    unless ($table) {
445
0
        carp "ERROR: parseletter_sth() called without argument (table)";
446
0
        return;
447    }
448    # check cache first
449
0
    (defined $handles{$table}) and return $handles{$table};
450
0
    my $query =
451    ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
452    ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
453    ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
454    ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
455    ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
456    ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
457    ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
458    ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
459    ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : undef ;
460
0
    unless ($query) {
461
0
        warn "ERROR: No parseletter_sth query for table '$table'";
462
0
        return; # nothing to get
463    }
464
0
    unless ($handles{$table} = C4::Context->dbh->prepare($query)) {
465
0
        warn "ERROR: Failed to prepare query: '$query'";
466
0
        return;
467    }
468
0
    return $handles{$table}; # now cache is populated for that $table
469}
470
471sub parseletter {
472
0
    my ( $letter, $table, $pk, $pk2 ) = @_;
473
0
    unless ($letter) {
474
0
        carp "ERROR: parseletter() 1st argument 'letter' empty";
475
0
        return;
476    }
477
0
    my $sth = parseletter_sth($table);
478
0
    unless ($sth) {
479
0
        warn "parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
480
0
        return;
481    }
482
0
    if ( $pk2 ) {
483
0
        $sth->execute($pk, $pk2);
484    } else {
485
0
        $sth->execute($pk);
486    }
487
488
0
    my $values = $sth->fetchrow_hashref;
489
490    # TEMPORARY hack until the expirationdate column is added to reserves
491
0
    if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
492
0
        my @waitingdate = split /-/, $values->{'waitingdate'};
493
494
0
        $values->{'expirationdate'} = C4::Dates->new(
495            sprintf(
496                '%04d-%02d-%02d',
497                Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) )
498            ),
499            'iso'
500        )->output();
501    }
502
503
504    # and get all fields from the table
505
0
    my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
506
0
    $columns->execute;
507
0
    while ( ( my $field ) = $columns->fetchrow_array ) {
508
0
        my $replacefield = "<<$table.$field>>";
509
0
        $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
510
0
        my $replacedby = $values->{$field} || '';
511
0
        ($letter->{title} ) and $letter->{title} =~ s/$replacefield/$replacedby/g;
512
0
        ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
513    }
514
0
    return $letter;
515}
516
517 - 528
=head2 EnqueueLetter

  my $success = EnqueueLetter( { letter => $letter, 
        borrowernumber => '12', message_transport_type => 'email' } )

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.

return true on success

=cut
529
530sub EnqueueLetter ($) {
531
0
    my $params = shift or return undef;
532
533
0
    return unless exists $params->{'letter'};
534
0
    return unless exists $params->{'borrowernumber'};
535
0
    return unless exists $params->{'message_transport_type'};
536
537    # If we have any attachments we should encode then into the body.
538
0
    if ( $params->{'attachments'} ) {
539
0
        $params->{'letter'} = _add_attachments(
540            { letter => $params->{'letter'},
541                attachments => $params->{'attachments'},
542                message => MIME::Lite->new( Type => 'multipart/mixed' ),
543            }
544        );
545    }
546
547
0
    my $dbh = C4::Context->dbh();
548
0
    my $statement = << 'ENDSQL';
549INSERT INTO message_queue
550( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
551VALUES
552( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
553ENDSQL
554
555
0
    my $sth = $dbh->prepare($statement);
556
0
    my $result = $sth->execute(
557        $params->{'borrowernumber'}, # borrowernumber
558        $params->{'letter'}->{'title'}, # subject
559        $params->{'letter'}->{'content'}, # content
560        $params->{'letter'}->{'metadata'} || '', # metadata
561        $params->{'letter'}->{'code'} || '', # letter_code
562        $params->{'message_transport_type'}, # message_transport_type
563        'pending', # status
564        $params->{'to_address'}, # to_address
565        $params->{'from_address'}, # from_address
566        $params->{'letter'}->{'content-type'}, # content_type
567    );
568
0
    return $result;
569}
570
571 - 579
=head2 SendQueuedMessages ([$hashref]) 

  my $sent = SendQueuedMessages( { verbose => 1 } );

sends all of the 'pending' items in the message queue.

returns number of messages sent.

=cut
580
581sub SendQueuedMessages (;$) {
582
0
    my $params = shift;
583
584
0
    my $unsent_messages = _get_unsent_messages();
585
0
    MESSAGE: foreach my $message ( @$unsent_messages ) {
586        # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
587
0
        warn sprintf( 'sending %s message to patron: %s',
588                      $message->{'message_transport_type'},
589                      $message->{'borrowernumber'} || 'Admin' )
590          if $params->{'verbose'} or $debug;
591        # This is just begging for subclassing
592
0
        next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
593
0
        if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
594
0
            _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
595        }
596        elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
597
0
            _send_message_by_sms( $message );
598        }
599    }
600
0
    return scalar( @$unsent_messages );
601}
602
603 - 609
=head2 GetRSSMessages

  my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )

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

=cut
610
611sub GetRSSMessages {
612
0
    my $params = shift;
613
614
0
    return unless $params;
615
0
    return unless ref $params;
616
0
    return unless $params->{'borrowernumber'};
617
618
0
    return _get_unsent_messages( { message_transport_type => 'rss',
619                                   limit => $params->{'limit'},
620                                   borrowernumber => $params->{'borrowernumber'}, } );
621}
622
623 - 630
=head2 GetPrintMessages

  my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )

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

=cut
631
632sub GetPrintMessages {
633
0
    my $params = shift || {};
634
635
0
    return _get_unsent_messages( { message_transport_type => 'print',
636                                   borrowernumber => $params->{'borrowernumber'}, } );
637}
638
639 - 648
=head2 GetQueuedMessages ([$hashref])

  my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );

fetches messages out of the message queue.

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

=cut
649
650sub GetQueuedMessages {
651
0
    my $params = shift;
652
653
0
    my $dbh = C4::Context->dbh();
654
0
    my $statement = << 'ENDSQL';
655SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
656FROM message_queue
657ENDSQL
658
659
0
    my @query_params;
660
0
    my @whereclauses;
661
0
    if ( exists $params->{'borrowernumber'} ) {
662
0
        push @whereclauses, ' borrowernumber = ? ';
663
0
        push @query_params, $params->{'borrowernumber'};
664    }
665
666
0
    if ( @whereclauses ) {
667
0
        $statement .= ' WHERE ' . join( 'AND', @whereclauses );
668    }
669
670
0
    if ( defined $params->{'limit'} ) {
671
0
        $statement .= ' LIMIT ? ';
672
0
        push @query_params, $params->{'limit'};
673    }
674
675
0
    my $sth = $dbh->prepare( $statement );
676
0
    my $result = $sth->execute( @query_params );
677
0
    return $sth->fetchall_arrayref({});
678}
679
680 - 692
=head2 _add_attachements

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.

returns your letter object, with the content updated.

=cut
693
694sub _add_attachments {
695
0
    my $params = shift;
696
697
0
    return unless 'HASH' eq ref $params;
698
0
    foreach my $required_parameter (qw( letter attachments message )) {
699
0
        return unless exists $params->{$required_parameter};
700    }
701
0
0
    return $params->{'letter'} unless @{ $params->{'attachments'} };
702
703    # First, we have to put the body in as the first attachment
704
0
    $params->{'message'}->attach(
705        Type => 'TEXT',
706        Data => $params->{'letter'}->{'content'},
707    );
708
709
0
0
    foreach my $attachment ( @{ $params->{'attachments'} } ) {
710
0
        $params->{'message'}->attach(
711            Type => $attachment->{'type'},
712            Data => $attachment->{'content'},
713            Filename => $attachment->{'filename'},
714        );
715    }
716    # we're forcing list context here to get the header, not the count back from grep.
717
0
    ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
718
0
    $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
719
0
    $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
720
721
0
    return $params->{'letter'};
722
723}
724
725sub _get_unsent_messages (;$) {
726
0
    my $params = shift;
727
728
0
    my $dbh = C4::Context->dbh();
729
0
    my $statement = << 'ENDSQL';
730SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
731  FROM message_queue
732 WHERE status = ?
733ENDSQL
734
735
0
    my @query_params = ('pending');
736
0
    if ( ref $params ) {
737
0
        if ( $params->{'message_transport_type'} ) {
738
0
            $statement .= ' AND message_transport_type = ? ';
739
0
            push @query_params, $params->{'message_transport_type'};
740        }
741
0
        if ( $params->{'borrowernumber'} ) {
742
0
            $statement .= ' AND borrowernumber = ? ';
743
0
            push @query_params, $params->{'borrowernumber'};
744        }
745
0
        if ( $params->{'limit'} ) {
746
0
            $statement .= ' limit ? ';
747
0
            push @query_params, $params->{'limit'};
748        }
749    }
750
0
    $debug and warn "_get_unsent_messages SQL: $statement";
751
0
    $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
752
0
    my $sth = $dbh->prepare( $statement );
753
0
    my $result = $sth->execute( @query_params );
754
0
    return $sth->fetchall_arrayref({});
755}
756
757sub _send_message_by_email ($;$$$) {
758
0
    my $message = shift or return;
759
0
    my ($username, $password, $method) = @_;
760
761
0
    my $to_address = $message->{to_address};
762
0
    unless ($to_address) {
763
0
        my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
764
0
        unless ($member) {
765
0
            warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
766
0
            _set_message_status( { message_id => $message->{'message_id'},
767                                   status => 'failed' } );
768
0
            return;
769        }
770
0
        my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
771        # If the system preference is set to 'first valid' (value == OFF), look up email address
772
0
        if ($which_address eq 'OFF') {
773
0
            $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} );
774        } else {
775
0
            $to_address = $member->{$which_address};
776        }
777
0
        unless ($to_address) {
778            # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
779            # warning too verbose for this more common case?
780
0
            _set_message_status( { message_id => $message->{'message_id'},
781                                   status => 'failed' } );
782
0
            return;
783        }
784    }
785
786
0
    my $utf8 = decode('MIME-Header', $message->{'subject'} );
787
0
    $message->{subject}= encode('MIME-Header', $utf8);
788
0
    my $content = encode('utf8', $message->{'content'});
789
0
    my %sendmail_params = (
790        To => $to_address,
791        From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
792        Subject => encode('utf8', $message->{'subject'}),
793        charset => 'utf8',
794        Message => $content,
795        'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
796    );
797
0
    $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
798
0
    if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
799
0
       $sendmail_params{ Bcc } = $bcc;
800    }
801
802
0
    _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
803
0
    if ( sendmail( %sendmail_params ) ) {
804
0
        _set_message_status( { message_id => $message->{'message_id'},
805                status => 'sent' } );
806
0
        return 1;
807    } else {
808
0
        _set_message_status( { message_id => $message->{'message_id'},
809                status => 'failed' } );
810
0
        carp $Mail::Sendmail::error;
811
0
        return;
812    }
813}
814
815sub _send_message_by_sms ($) {
816
0
    my $message = shift or return undef;
817
0
    my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
818
0
    return unless $member->{'smsalertnumber'};
819
820
0
    my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
821                                       message => $message->{'content'},
822                                     } );
823
0
    _set_message_status( { message_id => $message->{'message_id'},
824                           status => ($success ? 'sent' : 'failed') } );
825
0
    return $success;
826}
827
828sub _update_message_to_address {
829
0
    my ($id, $to)= @_;
830
0
    my $dbh = C4::Context->dbh();
831
0
    $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
832}
833
834sub _set_message_status ($) {
835
0
    my $params = shift or return undef;
836
837
0
    foreach my $required_parameter ( qw( message_id status ) ) {
838
0
        return undef unless exists $params->{ $required_parameter };
839    }
840
841
0
    my $dbh = C4::Context->dbh();
842
0
    my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
843
0
    my $sth = $dbh->prepare( $statement );
844
0
    my $result = $sth->execute( $params->{'status'},
845                                $params->{'message_id'} );
846
0
    return $result;
847}
848
849
8501;