View | Details | Raw Unified | Return to bug 2274
Collapse All | Expand All

(-)a/C4/Letters.pm (-13 / +17 lines)
Lines 532-549 sub EnqueueLetter { Link Here
532
    my $dbh = C4::Context->dbh();
532
    my $dbh = C4::Context->dbh();
533
    my $statement = << 'ENDSQL';
533
    my $statement = << 'ENDSQL';
534
INSERT INTO message_queue
534
INSERT INTO message_queue
535
( borrowernumber, subject, content, message_transport_type, status, time_queued )
535
( borrowernumber, subject, content, message_transport_type, status, time_queued, to_address, from_address )
536
VALUES
536
VALUES
537
( ?,              ?,       ?,       ?,                      ?,      NOW() )
537
( ?,              ?,       ?,       ?,                      ?,      NOW(),       ?,          ? )
538
ENDSQL
538
ENDSQL
539
539
540
    my $sth = $dbh->prepare( $statement );
540
    my $sth = $dbh->prepare( $statement );
541
    my $result = $sth->execute( $params->{'borrowernumber'},         # borrowernumber
541
    my $result = $sth->execute(
542
                                $params->{'letter'}->{'title'},      # subject
542
        $params->{'borrowernumber'},            # borrowernumber
543
                                $params->{'letter'}->{'content'},    # content
543
        $params->{'letter'}->{'title'},         # subject
544
                                $params->{'message_transport_type'}, # message_transport_type
544
        $params->{'letter'}->{'content'},       # content
545
                                'pending',                           # status
545
        $params->{'message_transport_type'},    # message_transport_type
546
                           );
546
        'pending',                              # status
547
        $params->{'to_address'},                # to_address
548
        $params->{'from_address'},              # from_address
549
    );
547
    return $result;
550
    return $result;
548
}
551
}
549
552
Lines 690-700 sub _send_message_by_email { Link Here
690
    my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
693
    my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
691
    return unless $member->{'email'};
694
    return unless $member->{'email'};
692
695
693
    my $success = sendmail( To      => $member->{'email'},
696
    my $success = sendmail(
694
                            From    => C4::Context->preference('KohaAdminEmailAddress'),
697
        To   => $message->{'to_address'}   || $member->{'email'},
695
                            Subject => $message->{'subject'},
698
        From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
696
                            Message => $message->{'content'},
699
        Subject => $message->{'subject'},
697
                       );
700
        Message => $message->{'content'},
701
    );
698
    if ( $success ) {
702
    if ( $success ) {
699
        # warn "OK. Log says:\n", $Mail::Sendmail::log;
703
        # warn "OK. Log says:\n", $Mail::Sendmail::log;
700
        _set_message_status( { message_id => $message->{'message_id'},
704
        _set_message_status( { message_id => $message->{'message_id'},
(-)a/C4/Members.pm (-2 / +42 lines)
Lines 594-603 sub GetMemberIssuesAndFines { Link Here
594
594
595
=head2 ModMember
595
=head2 ModMember
596
596
597
  &ModMember($borrowernumber);
597
=over 4
598
599
my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
598
600
599
Modify borrower's data.  All date fields should ALREADY be in ISO format.
601
Modify borrower's data.  All date fields should ALREADY be in ISO format.
600
602
603
return :
604
true on success, or false on failure
605
606
=back
607
601
=cut
608
=cut
602
609
603
#'
610
#'
Lines 647-653 sub ModMember { Link Here
647
    push @parameters, $data{'borrowernumber'};
654
    push @parameters, $data{'borrowernumber'};
648
    $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
655
    $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
649
    $sth = $dbh->prepare($query);
656
    $sth = $dbh->prepare($query);
650
    $sth->execute(@parameters);
657
    my $execute_success = $sth->execute(@parameters);
651
    $sth->finish;
658
    $sth->finish;
652
659
653
# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
660
# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
Lines 660-665 sub ModMember { Link Here
660
    }
667
    }
661
    logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})") 
668
    logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})") 
662
        if C4::Context->preference("BorrowersLog");
669
        if C4::Context->preference("BorrowersLog");
670
671
    return $execute_success;
663
}
672
}
664
673
665
674
Lines 2018-2023 sub GetBorrowersNamesAndLatestIssue { Link Here
2018
    my $results = $sth->fetchall_arrayref({});
2027
    my $results = $sth->fetchall_arrayref({});
2019
    return $results;
2028
    return $results;
2020
}
2029
}
2030
2031
=head2 DebarMember
2032
2033
=over 4
2034
2035
my $success = DebarMember( { borrowernumber => $borrowernumber } );
2036
2037
marks a Member as debarred, and therefore unable to checkout any more
2038
items.
2039
2040
return :
2041
true on success, false on failure
2042
2043
=back
2044
2045
=cut
2046
2047
sub DebarMember {
2048
    my $params = shift;
2049
2050
    return unless ref $params eq 'HASH';
2051
2052
    foreach my $required_parameter ( qw( borrowernumber ) ) {
2053
        return unless defined $params->{ $required_parameter };
2054
    }
2055
    
2056
    return ModMember( borrowernumber => $params->{'borrowernumber'},
2057
                      debarred       => 1 );
2058
    
2059
}
2060
2021
END { }    # module clean-up code here (global destructor)
2061
END { }    # module clean-up code here (global destructor)
2022
2062
2023
1;
2063
1;
(-)a/misc/cronjobs/overdue_notices.pl (+414 lines)
Line 0 Link Here
1
#!/usr/bin/perl -w
2
3
# Copyright 2008 Liblime
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 with
17
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18
# Suite 330, Boston, MA  02111-1307 USA
19
20
use strict;
21
use warnings;
22
23
BEGIN {
24
25
    # find Koha's Perl modules
26
    # test carefully before changing this
27
    use FindBin;
28
    eval { require "$FindBin::Bin/../kohalib.pl" };
29
}
30
31
use C4::Context;
32
use C4::Dates qw/format_date/;
33
use C4::Debug;
34
use C4::Letters;
35
36
use Getopt::Long;
37
use Pod::Usage;
38
use Text::CSV_XS;
39
40
=head1 NAME
41
42
overdue_notices.pl - prepare messages to be sent to patrons for overdue items
43
44
=head1 SYNOPSIS
45
46
overdue_notices.pl -c [ -n ] [ -branch MAIN ] [ -max 31 ]
47
48
 Options:
49
   -help                  brief help message
50
   -man                   full documentation
51
   -c                     Confirm that you have read the documentation
52
   -n                     No email will be sent
53
   -max    <days>         maximum days overdue to deal with
54
   -branch <branchname>   only deal with overdues from this branch.
55
   -csv    <filename>     populate CSV file
56
57
=head1 OPTIONS
58
59
=over 8
60
61
=item B<-help>
62
63
Print a brief help message and exits.
64
65
=item B<-man>
66
67
Prints the manual page and exits.
68
69
=item B<-c>
70
71
Confirms that you have read the documentation and want the script to actually do something
72
73
=item B<-n>
74
75
Do not send any email. The overdue notices are printed to standard out in this case.
76
77
=item B<-max>
78
79
Items older than max days are handled somewhere else, probably borrower suspended. Defaults to 365.
80
81
=item B<-branch>
82
83
select overdues for one specific branch
84
85
=item B<-csv>
86
87
populate CSV file with overdues information. If -n (no mail) is
88
selected, all overdues are put in file, otherwise, only overdues that
89
could not be emailed are sent.
90
91
=back
92
93
=head1 DESCRIPTION
94
95
This script will send overdue notices by e-mail and prepare a file of
96
notices for printing if the borrower does not have e-mail.
97
98
=cut
99
100
# These variables are set by command line options.
101
# They are initially set to default values.
102
my $help    = 0;
103
my $man     = 0;
104
my $confirm = 0;     # set to 1 to avoid the warning
105
my $nomail  = 0;
106
my $MAX     = 365;
107
my $mybranch;
108
my $csvfilename;
109
110
GetOptions(
111
    'help|?'   => \$help,
112
    'man'      => \$man,
113
    'c'        => \$confirm,
114
    'n'        => \$nomail,
115
    'max=s'    => \$MAX,
116
    'branch=s' => \$mybranch,
117
    'csv=s'    => \$csvfilename,
118
) or pod2usage(2);
119
pod2usage(1) if $help;
120
pod2usage( -verbose => 2 ) if $man;
121
122
unless ($confirm) {
123
    print <<'END_WARNING';
124
WARNING: You MUST edit this script for your library BEFORE you run it for the first time!
125
See the comments in the script for directions on changing the script.
126
127
Do you wish to continue? (y/[n])
128
END_WARNING
129
130
    chomp( $_ = <STDIN> );
131
    unless (/^\s*[yo]/i) {
132
        print "Exiting.\n";
133
        exit;
134
    }
135
}
136
137
my @branches    = get_branches_with_overdue_rules();
138
my $branchcount = scalar(@branches);
139
if ($branchcount) {
140
    my $branch_word = scalar @branches > 1 ? 'branches' : 'branch';
141
    print "Found $branchcount $branch_word with first message enabled: " . join( ', ', map { "'$_'" } @branches ), "\n";
142
} else {
143
    die 'No branches with active overduerules';
144
}
145
146
if ($mybranch) {
147
    warn "Branch $mybranch selected\n";
148
    if ( scalar grep { $mybranch eq $_ } @branches ) {
149
        @branches = ($mybranch);
150
    } else {
151
        warn "No active overduerules for branch '$mybranch'\n";
152
        ( scalar grep { '' eq $_ } @branches )
153
          or die "No active overduerules for DEFAULT either!";
154
        warn "Falling back on default rules for $mybranch\n";
155
        @branches = ('');
156
    }
157
}
158
159
my $dbh = C4::Context->dbh();
160
161
our $csv;       # the Text::CSV_XS object
162
our $csv_fh;    # the filehandle to the CSV file.
163
if ($csvfilename) {
164
    $csv = Text::CSV_XS->new( { binary => 1 } );
165
    open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!";
166
    if ( $csv->combine(qw(name surname address1 address2 zipcode city email itemcount itemsinfo)) ) {
167
        print $csv_fh $csv->string, "\n";
168
    } else {
169
        warn 'combine failed on argument: ' . $csv->error_input;
170
    }
171
172
}
173
174
foreach my $branchcode (@branches) {
175
176
    my $branch_details = C4::Branch::GetBranchDetail($branchcode);
177
    my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
178
179
    warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;
180
181
    my $sth2 = $dbh->prepare( <<'END_SQL' );
182
SELECT biblio.title, biblio.author, items.barcode, issues.timestamp
183
  FROM issues,items,biblio
184
  WHERE items.itemnumber=issues.itemnumber
185
    AND biblio.biblionumber   = items.biblionumber
186
    AND issues.borrowernumber = ?
187
    AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN ? and ?
188
END_SQL
189
190
    my $rqoverduerules = $dbh->prepare("SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ");
191
    $rqoverduerules->execute($branchcode);
192
    my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' );
193
    while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) {
194
      PERIOD: foreach my $i ( 1 .. 3 ) {
195
196
            $debug and warn "branch '$branchcode', pass $i\n";
197
            my $mindays = $overdue_rules->{"delay$i"};    # the notice will be sent after mindays days (grace period)
198
            my $maxdays = (
199
                  $overdue_rules->{ "delay" . ( $i + 1 ) }
200
                ? $overdue_rules->{ "delay" . ( $i + 1 ) }
201
                : ($MAX)
202
            );                                            # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
203
204
            my $letter;
205
            if ( $overdue_rules->{"letter$i"} ) {
206
                $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} );
207
                unless ($letter) {
208
                    warn "Message '$overdue_rules->{letter$i}' content not found";
209
                    next PERIOD;
210
                }
211
            } else {
212
                warn "No letter$i code for branch '$branchcode'";
213
                next PERIOD;
214
            }
215
216
            # $letter->{'content'} is the text of the mail that is sent.
217
            # this text contains fields that are replaced by their value. Those fields must be written between brackets
218
            # The following fields are available :
219
            # <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode>
220
221
            my $borrower_sql = <<'END_SQL';
222
SELECT COUNT(*), issues.borrowernumber, firstname, surname, address, address2, city, zipcode, email, MIN(date_due) as longest_issue
223
FROM   issues,borrowers,categories
224
WHERE  issues.borrowernumber=borrowers.borrowernumber
225
AND    borrowers.categorycode=categories.categorycode
226
END_SQL
227
            my @borrower_parameters;
228
            if ($branchcode) {
229
                $borrower_sql .= ' AND issues.branchcode=? ';
230
                push @borrower_parameters, $branchcode;
231
            }
232
            if ( $overdue_rules->{categorycode} ) {
233
                $borrower_sql .= ' AND borrowers.categorycode=? ';
234
                push @borrower_parameters, $overdue_rules->{categorycode};
235
            }
236
            $borrower_sql .= <<'END_SQL';
237
AND    categories.overduenoticerequired=1
238
GROUP BY issues.borrowernumber
239
HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN ? and ?
240
END_SQL
241
            push @borrower_parameters, $mindays, $maxdays;
242
            my $sth = $dbh->prepare($borrower_sql);
243
            $sth->execute(@borrower_parameters);
244
            $debug and warn $borrower_sql . "\n\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
245
            my $count   = 0;                          # to keep track of how many notices are printed
246
            my $e_count = 0;                          # and e-mailed
247
            my $date    = C4::Dates->new()->output;
248
249
            while ( my ( $itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) {
250
                if ( $overdue_rules->{"debarred$i"} ) {
251
252
                    #action taken is debarring
253
                    C4::Members::DebarMember( { borrowernumber => $borrowernumber } );
254
                    warn "debarring $borrowernumber $firstname $lastname\n";
255
                }
256
257
                $sth2->execute( $borrowernumber, $mindays, $maxdays );
258
                my $titles = "";
259
                while ( my ( $title, $author, $barcode, $issuedate ) = $sth2->fetchrow ) {
260
                    $titles .= join "\t", format_date($issuedate), ( $barcode ? $barcode : "" ), ( $title ? $title : "" ), ( $author ? $author : "" ) . "\n";
261
                }
262
                $sth2->finish;
263
264
                $letter = parse_letter(
265
                    {   letter         => $letter,
266
                        borrowernumber => $borrowernumber,
267
                        branchcode     => $branchcode,
268
                        substitute     => {
269
                            date   => $date,
270
                            bib    => $branch_details->{'branchname'},
271
                            titles => $titles
272
                        }
273
                    }
274
                );
275
276
                my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</, $letter->{'content'};
277
                if (@misses) {
278
                    warn "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses;
279
                }
280
                $letter->{'content'} =~ s/\<[^<>]*?\>//g;    # Now that we've warned about them, remove them.
281
                $letter->{'content'} =~ s/\<[^<>]*?\>//g;    # 2nd pass for the double nesting.
282
283
                if ($nomail) {
284
285
                    # print the mail to stdout
286
                    print_letter(
287
                        {   letter         => $letter,
288
                            borrowernumber => $borrowernumber,
289
                            firstname      => $firstname,
290
                            lastname       => $lastname,
291
                            address1       => $address1,
292
                            address2       => $address2,
293
                            city           => $city,
294
                            postcode       => $postcode,
295
                            email          => $email,
296
                            itemcount      => $itemcount,
297
                            titles         => $titles,
298
                            outputformat   => $csvfilename ? 'csv' : '',
299
                        }
300
                    );
301
                } else {
302
                    my $enqueue_parameters = {
303
                        letter                 => $letter,
304
                        borrowernumber         => $borrowernumber,
305
                        message_transport_type => 'email',
306
                        from_address           => $admin_email_address,
307
                    };
308
309
                    # If we don't have an email address for this patron, send it to the admin to deal with.
310
                    if ( !$email ) {
311
                        $enqueue_parameters->{'to_address'} = $admin_email_address;
312
                    }
313
                    C4::Letters::EnqueueLetter($enqueue_parameters);
314
                }
315
            }
316
            $sth->finish;
317
        }
318
    }
319
}
320
321
if ($csvfilename) {
322
    close $csv_fh;
323
}
324
325
=head1 INTERNAL METHODS
326
327
=head2 get_branches_with_overdue_rules
328
329
=cut
330
331
sub get_branches_with_overdue_rules {
332
    my $dbh               = C4::Context->dbh;
333
    my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL");
334
    $rqoverduebranches->execute;
335
    my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref };
336
    $rqoverduebranches->finish;
337
    return @branches;
338
}
339
340
=head2 parse_letter
341
342
343
344
=cut
345
346
sub parse_letter {
347
    my $params = shift;
348
    foreach my $required (qw( letter borrowernumber )) {
349
        return unless exists $params->{$required};
350
    }
351
352
    if ( $params->{'substitute'} ) {
353
        while ( my ( $key, $replacedby ) = each %{ $params->{'substitute'} } ) {
354
            my $replacefield = "<<$key>>";
355
356
            $params->{'letter'}->{title}   =~ s/$replacefield/$replacedby/g;
357
            $params->{'letter'}->{content} =~ s/$replacefield/$replacedby/g;
358
        }
359
    }
360
361
    C4::Letters::parseletter( $params->{'letter'}, 'borrowers', $params->{'borrowernumber'} );
362
363
    if ( $params->{'branchcode'} ) {
364
        C4::Letters::parseletter( $params->{'letter'}, 'branches', $params->{'branchcode'} );
365
    }
366
367
    if ( $params->{'biblionumber'} ) {
368
        C4::Letters::parseletter( $params->{'letter'}, 'biblio',      $params->{'biblionumber'} );
369
        C4::Letters::parseletter( $params->{'letter'}, 'biblioitems', $params->{'biblionumber'} );
370
    }
371
372
    return $params->{'letter'};
373
}
374
375
=head2 print_letter
376
377
required parameters:
378
  letter
379
  borrowernumber
380
381
optional parameters:
382
  outputformat
383
384
=cut
385
386
sub print_letter {
387
    my $params = shift;
388
389
    return unless ref $params eq 'HASH';
390
391
    foreach my $required_parameter (qw( letter borrowernumber )) {
392
        return unless defined $params->{$required_parameter};
393
    }
394
395
    if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) {
396
        if ($csv->combine(
397
                $params->{'firstname'}, $params->{'lastname'}, $params->{'address1'},  $params->{'address2'}, $params->{'postcode'},
398
                $params->{'city'},      $params->{'email'},    $params->{'itemcount'}, $params->{'titles'}
399
            )
400
          ) {
401
            print $csv_fh $csv->string, "\n";
402
        } else {
403
            warn 'combine failed on argument: ' . $csv->error_input;
404
        }
405
    } else {
406
        print sprintf( 'To: "%s %s" <%s>', $params->{'firstname'}, $params->{'lastname'}, $params->{'email'} ), "\n";
407
        print "Subject: $params->{'letter'}->{'title'}\n\n";
408
        print "$params->{'letter'}->{'content'}\n";
409
410
        # print Data::Dumper->Dump( [ $params->{'borrowernumber'}, $params->{'letter'} ], [qw( borrowernumber letter )] );
411
    }
412
413
}
414
(-)a/t/lib/KohaTest/Members/DebarMember.pm (-1 / +44 lines)
Line 0 Link Here
0
- 
1
package KohaTest::Members::DebarMember;
2
use base qw( KohaTest::Members );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
sub testing_class { 'C4::Members' };
11
12
13
sub simple_usage : Test( 6 ) {
14
    my $self = shift;
15
16
    ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
17
18
    my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
19
    ok(     exists $details->{'flags'},                  'member details has a "flags" attribute');
20
    isa_ok( $details->{'flags'},                 'HASH', 'the "flags" attribute is a hashref');
21
    ok(     ! $details->{'flags'}->{'DBARRED'},          'this member is NOT debarred' );
22
23
    # Now, let's debar this member and see what happens
24
    my $success = C4::Members::DebarMember( { borrowernumber => $self->{'memberid'} } );
25
26
    ok( $success, 'we were able to debar the member' );
27
    
28
    $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
29
    ok( $details->{'flags'}->{'DBARRED'},         'this member is debarred now' )
30
      or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) );
31
}
32
33
sub incorrect_usage : Test( 2 ) {
34
    my $self = shift;
35
36
    my $result = C4::Members::DebarMember();
37
    ok( ! defined $result, 'DebarMember returns undef when passed no parameters' );
38
39
    $result = C4::Members::DebarMember( $self->{'memberid'} );
40
    ok( ! defined $result, 'DebarMember returns undef when not passed a hashref' );
41
42
}
43
44
1;

Return to bug 2274