2 #-----------------------------------
3 # Script Name: overduenotices.pl
6 # Author: Stephen Hedges (shedges@skemotah.com)
7 # modified by Paul Poulain (paul@koha-fr.org)
8 # modified by Henri-Damien LAURENT (henridamien@koha-fr.org)
10 # This script runs a Koha report of items using overduerules tables and letters tool management.
12 # 1.0 2003/9/7: original version
13 # 1.5 2006/2/28: Modifications for managing Letters and overduerules
14 # 2.01 2008/2/21: Overhaul, provide command line SMTP options, fix ouput
15 #-----------------------------------
16 # Copyright 2003 Skemotah Solutions
18 # This file is part of Koha.
20 # Koha is free software; you can redistribute it and/or modify it under the
21 # terms of the GNU General Public License as published by the Free Software
22 # Foundation; either version 2 of the License, or (at your option) any later
25 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
26 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
27 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
29 # You should have received a copy of the GNU General Public License along with
30 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
31 # Suite 330, Boston, MA 02111-1307 USA
35 # find Koha's Perl modules
36 # test carefully before changing this
38 eval { require "$FindBin::Bin/../kohalib.pl" };
42 use C4::Dates qw/format_date/;
44 use Mail::Sendmail; # comment out if not doing e-mail notices
49 This script will send overdue notices by e-mail and prepare a file of
50 notices for printing if the borrower does not have e-mail.
52 Optional script parameters :
53 -c to confirm and bypass this help & warning
54 -n no mail mode: avoid sending any mail. Instead, all mail messages are printed on screen. Useful for testing.
55 -branch <branchcode> to select overdues for ONE specific branch.
56 -borcat <borcatcode> to select overdues for ONE borrower category, NOT IMPLEMENTED
57 -borcatout <borcatcode> to exclude borrower category from overdunotices, NOT IMPLEMENTED
58 -max <MAX> MAXIMUM day count before stopping to send overdue notice,
59 -file <filename> to enter a specific filename to be read for message.
60 -all to include ALL the items that reader borrowed, not just overdues. NOT IMPLEMENTED ?
63 misc/cronjobs/overduenotices-30.pl -c -branch MAIN -s foobar.mail.com
69 my ($confirm, $nomail, $mybranch, $myborcat,$myborcatout, $letter, $MAX, $choice);
76 'smtp=s' => \$smtpserver,
77 'branch=s' => \$mybranch,
78 'borcat=s' => \$myborcat,
79 'borcatout=s' => \$myborcatout,
82 my $deathknell = "Parameter %s is not implemented. Remove this option and try again.";
83 $myborcat and die usage . sprintf($deathknell, "-borcat ($myborcat)");
84 $myborcatout and die usage . sprintf($deathknell, "-borcatout ($myborcatout)");
85 $choice and die usage . sprintf($deathknell, "-all");
87 # $confirm = 1; # uncomment to hardcode pre-confirmation
88 $smtpserver = ($smtpserver || 'smtp.wanadoo.fr'); # hardcode your smtp server (outgoing mail)
89 unshift @{$Mail::Sendmail::mailcfg{'smtp'}} , $smtpserver;
90 print STDERR ($nomail) ? "No Mail Mode\n" : "using SMTP: $smtpserver\n";
93 WARNING: You MUST edit this script for your library BEFORE you run it for the first time!
94 See the comments in the script for directions on changing the script.
96 | . &usage . "Do you wish to continue? (y/[n]) ";
98 unless (/^\s*[yo]/i) {
104 my $dbh = C4::Context->dbh;
105 my $rqoverduebranches=$dbh->prepare("SELECT DISTINCT branchcode FROM overduerules WHERE delay1 IS NOT NULL");
106 $rqoverduebranches->execute;
107 my @branches = map {shift @$_} @{$rqoverduebranches->fetchall_arrayref};
108 $rqoverduebranches->finish;
110 my $branchcount = scalar(@branches);
111 print "Found $branchcount branch(es) with first message enabled: " . join(' ', map {"\'$_\'"} @branches), "\n";
112 $branchcount or die "No branches with active overduerules";
115 print "Branch $mybranch selected\n";
116 if (scalar grep {$mybranch eq $_} @branches) {
117 @branches = ($mybranch);
119 print "No active overduerules for branch '$mybranch'\n";
120 (scalar grep {'' eq $_} @branches)
121 or die "No active overduerules for DEFAULT either!";
122 print "Falling back on default rules for $mybranch\n";
127 foreach my $branchcode (@branches) {
131 my $rqbranch=$dbh->prepare("SELECT branchemail,branchname FROM branches WHERE branchcode = ?");
132 $rqbranch->execute($mybranch || $branchcode);
133 ($emailaddress,$branchname) = $rqbranch->fetchrow;
135 $emailaddress = C4::Context->preference('KohaAdminEmailAddress') unless ($emailaddress);
137 print STDERR sprintf "branchcode : '%s' using %s\n", ($mybranch || $branchcode), $emailaddress;
139 # BEGINNING OF PARAMETERS
140 my $rqdebarring = $dbh->prepare("UPDATE borrowers SET debarred=1 WHERE borrowernumber=? ");
141 my $letter_sth = $dbh->prepare("SELECT content FROM letter WHERE code = ? ");
142 my $sth2 = $dbh->prepare("
143 SELECT biblio.title, biblio.author, items.barcode, issues.timestamp
144 FROM issues,items,biblio
145 WHERE items.itemnumber=issues.itemnumber
146 AND biblio.biblionumber=items.biblionumber
147 AND issues.borrowernumber=?
148 AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN ? and ? ");
149 my $rqoverduerules = $dbh->prepare("SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ");
150 $rqoverduerules->execute($branchcode);
151 my $outfile = 'overdues_' . ($mybranch || $branchcode || 'default');
152 open (OUTFILE, ">$outfile") or die "Cannot write file $outfile : $!";
153 while (my $data=$rqoverduerules->fetchrow_hashref){
154 for (my $i=1; $i<=3; $i++) {
158 $debug and print STDERR "branch '$branchcode', pass $i\n";
159 my $mindays = $data->{"delay$i"}; # the notice will be sent after mindays days (grace period)
160 my $maxdays = ($data->{"delay".($i+1)}?
161 $data->{"delay".($i+1)}
162 :($MAX?$MAX:365)); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
164 my $from = $emailaddress; # all mail sent will appear to be coming from here.
165 my $mailtitle = ($choice) ? 'Issue status' : 'Overdue'; # the title of the mails
166 my $librarymail = $emailaddress; # all notices w/o mail are sent (in 1 mail) to this address. They must then be managed manually.
167 my $letter = $data->{"letter$i"} if $data->{"letter$i"};
169 warn "No letter$i code for branch '$branchcode'";
172 $letter_sth->execute($letter);
173 my ($mailtext)=$letter_sth->fetchrow;
175 warn "Message '$letter' content not found";
178 # $mailtext is the text of the mail that is sent.
179 # this text contains fields that are replaced by their value. Those fields must be written between brackets
180 # The following fields are available :
181 # <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode>
186 SELECT COUNT(*), issues.borrowernumber,firstname,surname,address,address2,city,zipcode, email, MIN(date_due) as longest_issue
187 FROM issues,borrowers,categories
188 WHERE issues.borrowernumber=borrowers.borrowernumber
189 AND borrowers.categorycode=categories.categorycode ";
190 $strsth .= "\n\tAND issues.branchcode='$branchcode' " if ($branchcode);
191 $strsth .= "\n\tAND borrowers.categorycode='".$data->{categorycode}."' " if ($data->{categorycode});
192 $strsth .= "\n\tAND categories.overduenoticerequired=1
193 GROUP BY issues.borrowernumber HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN ? and ? ";
194 my $sth = $dbh->prepare($strsth);
195 $sth->execute($mindays, $maxdays);
196 $debug and warn $strsth . "\n\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
197 my $count = 0; # to keep track of how many notices are printed
198 my $e_count = 0; # and e-mailed
199 my $date = C4::Dates->new()->output;
200 my ($itemcount,$borrowernumber,$firstname,$lastname,$address1,$address2,$city,$postcode,$email);
201 while (($itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email) = $sth->fetchrow) {
202 if ($data->{"debarred$i"}){
203 #action taken is debarring
204 $rqdebarring->execute($borrowernumber);
205 print STDERR "debarring $borrowernumber $firstname $lastname\n";
207 # for whatever reason, some of the template text is "double nested" with tags like:
208 # <<branches.branchname>><<borrowers.firstname>>
209 # So we use the + operators below.
211 my $notice .= $mailtext;
212 $notice =~ s/[<]+itemcount[>]+/$itemcount/g if ($itemcount);
213 $notice =~ s/[<]+(borrowers\.)?firstname[>]+/$firstname/g if ($firstname);
214 $notice =~ s/[<]+(borrowers\.)?surname[>]+/$lastname/g if ($lastname);
215 $notice =~ s/[<]+lastname[>]+/$lastname/g if ($lastname);
216 $notice =~ s/[<]+address1[>]+/$address1/g if ($address1);
217 $notice =~ s/[<]+address2[>]+/$address2/g if ($address2);
218 $notice =~ s/[<]+city[>]+/$city/g if ($city);
219 $notice =~ s/[<]+postcode[>]+/$postcode/g if ($postcode);
220 $notice =~ s/[<]+date[>]+/$date/g if ($date);
221 $notice =~ s/[<]+bib[>]+/$branchname/g if ($branchname);
222 $notice =~ s/[<]+(branches\.)branchname[>]+/$mybranch/g if ($mybranch);
223 $notice =~ s/[<]+(branches\.)branchname[>]+/$branchname/g if ($branchname);
225 $sth2->execute($borrowernumber, $mindays, $maxdays);
227 while (my ($title, $author, $barcode,$issuedate) = $sth2->fetchrow){
228 $titles .= join "\t", format_date($issuedate), ($barcode?$barcode:""), ($title?$title:""), ($author?$author:"") . "\n";
230 $notice =~ s/\<titles\>/$titles/g;
231 my @misses = grep {/./} map {/^([^>]*)[>]+/; ($1 || '');} split /\</, $notice;
232 (@misses) and warn "The following terms were not matched/replaced: \n\t" . join "\n\t", @misses;
233 $notice =~ s/\<[^<>]*?\>//g; # Now that we've warned about them, remove them.
234 $notice =~ s/\<[^<>]*?\>//g; # 2nd pass for the double nesting.
236 if ($email) { # or you might check for borrowers.preferredcont
238 print " TO => $email\n";
239 print " FROM => $emailaddress\n";
240 print "SUBJECT => $mailtitle\n";
241 print "MESSAGE => $notice\n";
243 my %mail = ( To => $email,
244 From => $emailaddress,
245 Subject => $mailtitle,
252 print OUTFILE $notice;
258 # if some notices have to be printed & managed by the library, send them to library mail address.
260 open (ODUES, $outfile) or die "Cannot read file $outfile: $!";
261 my $notice = "$e_count overdue notices e-mailed\n"
262 . "$count overdue notices in file for printing\n\n"
265 print " TO => $email\n" if $email;
266 print " FROM => $emailaddress\n";
267 print "SUBJECT => Koha overdue\n";
268 print "MESSAGE => $notice\n";
270 my %mail = (To => $emailaddress,
271 From => $emailaddress,
272 Subject => 'Koha overdues',