--- /dev/null
+#!/usr/bin/perl -w
+#-----------------------------------
+# Script Name: overduenotices.pl
+# Script Version: 1.0
+# Date: 2003/9/7
+# Author: Stephen Hedges (shedges@skemotah.com)
+# modified by Paul Poulain (paul@koha-fr.org)
+# modified by Henri-Damien LAURENT (henridamien@koha-fr.org)
+# Description:
+# This script runs a Koha report of items using overduerules tables and letters tool management.
+# Revision History:
+# 1.0 2003/9/7: original version
+# 1.5 2006/2/28: Modifications for managing Letters and overduerules
+#-----------------------------------
+# Copyright 2003 Skemotah Solutions
+#
+# This file is part of Koha.
+#
+# 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 2 of the License, or (at your option) any later
+# version.
+#
+# 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.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use C4::Context;
+use C4::Date;
+use Mail::Sendmail; # comment out if not doing e-mail notices
+use Getopt::Long;
+use Data::Dumper;
+
+my ($confirm, $nomail, $mybranch, $myborcat,$myborcatout, $letter, $MAX, $choice);
+GetOptions(
+ 'c' => \$confirm,
+ 'n' => \$nomail,
+ 'max=s' => \$MAX,
+ 'all' => \$choice,
+);
+unless ($confirm) {
+ print qq|
+This script will send overdue notices by e-mail and prepare a file of\nnotices for printing if the borrower does not have e-mail.
+You MUST edit this script for your library BEFORE you run it for the first time!
+See the comments in the script for directions on changing the script.
+This script has 2 parameters :
+ -c to confirm and remove this help & warning
+ -n to avoid sending any mail. Instead, all mail messages are printed on screen. Usefull for testing purposes.
+ -branch <branchcode> to select overdues for ONE specific branch.
+ -borcat <borcatcode> to select overdues for one borrower category,
+ -borcatout <borcatcode> to exclude this borrower category from overdunotices,
+ -max <MAX> MAXIMUM day count before stopping to send overdue notice,
+ -file <filename> to enter a specific filename to be read for message.
+ -all to include ALL the items that reader borrowed.
+
+Do you wish to continue? (y/n)
+|;
+ chomp($_ = <STDIN>);
+ exit unless (/^(y|Y|o|O)/i); # comment these lines out once you've made the changes
+
+}
+#warn 'site '.$mybranch.' text '.$letter;
+my $dbh = C4::Context->dbh;
+my $rqoverduebranches=$dbh->prepare("SELECT DISTINCT branchcode from overduerules where delay1>0");
+$rqoverduebranches->execute;
+while (my ($branchcode)=$rqoverduebranches->fetchrow){
+ warn "branchcode : $branchcode";
+ my $branchname;
+ my $emailaddress;
+ if ($branchcode){
+ my $rqbranch=$dbh->prepare("SELECT * from branches where branchcode = ?");
+ $rqbranch->execute($branchcode);
+ my $data = $rqbranch->fetchrow_hashref;
+ $emailaddress = $data->{branchemail};
+ $branchname = $data->{branchname};
+ }
+ $emailaddress=C4::Context->preference('KohaAdminEmailAddress') unless ($emailaddress);
+
+ #print STDERR "$emailaddress\n";
+ #
+ # BEGINNING OF PARAMETERS
+ #
+ my $rqoverduerules=$dbh->prepare("SELECT * from overduerules where delay1>0 and branchcode = ?");
+ $rqoverduerules->execute($branchcode);
+ while (my $data=$rqoverduerules->fetchrow_hashref){
+ for (my $i=1; $i<=3;$i++){
+ #Two actions :
+ # A- Send a letter
+ # B- Debar
+ my $mindays = $data->{"delay$i"}; # the notice will be sent after mindays days (grace period)
+ my $rqdebarring=$dbh->prepare("UPDATE borrowers SET debarred=1 WHERE borrowernumber=?") if $data->{"debarred$i"};
+ my $maxdays = ($data->{"delay".($i+1)}?
+ $data->{"delay".($i+1)}
+ :($MAX?$MAX:365)); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
+ #LETTER parameters
+ my $smtpserver = 'smtp.wanadoo.fr'; # your smtp server (the server who sent mails)
+ my $from = $emailaddress; # all the mails sent to the borrowers will appear coming from here.
+ my $mailtitle = 'Overdue'; # the title of the mails
+ $mailtitle = 'Issue status' if ($choice); # the title of the mails
+ my $librarymail = $emailaddress; # all notices without mail are sent (in 1 mail) to this mail address. They must then be managed manually.
+ my $letter = $data->{"letter$i"} if $data->{"letter$i"};
+ # this parameter (the last) is the text of the mail that is sent.
+ # this text contains fields that are replaced by their value. Those fields must be written between brackets
+ # The following fields are available :
+ # <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode>
+ my $mailtext=$letter;
+ #
+ # END OF PARAMETERS
+ #
+ open OUTFILE, ">overdues" or die "Cannot open file overdues: $!";
+
+ # set the e-mail server -- comment out if not doing e-mail notices
+ unshift @{$Mail::Sendmail::mailcfg{'smtp'}} , $smtpserver;
+ # set your own mail server name here
+
+ my $strsth = "SELECT COUNT(*), issues.borrowernumber,firstname,surname,streetaddress,physstreet,city,zipcode, emailaddress, MIN(date_due) as longest_issue FROM issues,borrowers,categories WHERE returndate IS NULL AND issues.borrowernumber=borrowers.borrowernumber and borrowers.categorycode=categories.categorycode ";
+ $strsth .= " and issues.branchcode='".$branchcode."' " if ($branchcode);
+ $strsth .= " and borrowers.categorycode='".$data->{categorycode}."' " if ($data->{categorycode});
+ $strsth .= " and categories.overduenoticerequired=1 group by issues.borrowernumber HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN $mindays and $maxdays ";
+ my $sth = $dbh->prepare ($strsth);
+ warn "".$strsth;
+ my $sth2 = $dbh->prepare("SELECT biblio.title,biblio.author,items.barcode, issues.timestamp FROM issues,items,biblio WHERE items.itemnumber=issues.itemnumber and biblio.biblionumber=items.biblionumber AND issues.borrowernumber=? AND returndate IS NULL AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN $mindays and $maxdays");
+
+ $sth->execute;
+ #
+ # my $itemcount = 0;
+ # my $row;
+ my $count = 0; # to keep track of how many notices are printed
+ my $e_count = 0; # and e-mailed
+ my $date=format_date(localtime);
+ my ($itemcount,$borrnum,$firstname,$lastname,$address1,$address2,$city,$postcode,$email);
+
+ while (($itemcount,$borrnum,$firstname,$lastname,$address1,$address2,$city,$postcode,$email) = $sth->fetchrow) {
+ if ($data->{"debarred$i"}){
+ #action taken is debarring
+ $rqdebarring->execute($borrnum);
+ warn "debarring $borrnum $firstname $lastname";
+ }
+ # print STDERR "$itemcount,$borrnum,$firstname,$lastname,$address1,$address2,$city,$postcode,$email\n";
+ if ($letter){
+ my $notice .= $mailtext;
+ # print STDERR "$notice\n";
+ $notice =~ s/\<itemcount\>/$itemcount/g if ($itemcount);
+ $notice =~ s/\<firstname\>/$firstname/g if ($firstname);
+ $notice =~ s/\<lastname\>/$lastname/g if ($lastname);
+ $notice =~ s/\<address1\>/$address1/g if ($address1);
+ $notice =~ s/\<address2\>/$address2/g if ($address2);
+ $notice =~ s/\<city\>/$city/g if ($city);
+ $notice =~ s/\<postcode\>/$postcode/g if ($postcode);
+ $notice =~ s/\<date\>/$date/g if ($date);
+ $notice =~ s/\<bib\>/$branchname/g if ($branchname);
+
+ $sth2->execute($borrnum);
+ my $titles="";
+ my ($title, $author, $barcode, $issuedate);
+ while (($title, $author, $barcode,$issuedate) = $sth2->fetchrow){
+ $titles .= " ".format_date($issuedate)." ".($barcode?$barcode:"")." ".($title?$title:"")." ".($author?$author:"")."\n";
+ }
+ # print STDERR "$titles";
+ $notice =~ s/\<titles\>/$titles/g;
+ $sth2->finish;
+ # if not using e-mail notices, comment out the following lines
+ if ($email) { # or you might check for borrowers.preferredcont
+ if ($nomail) {
+ print "TO => $email\n";
+ print "FROM => $from\n";
+ print "SUBJECT => $mailtitle\n";
+ print "MESSAGE => $notice\n";
+ } else {
+ my %mail = ( To => $email,
+ From => $from,
+ Subject => $mailtitle,
+ Message => $notice,
+ );
+ sendmail(%mail);
+ }
+ $e_count++
+ } else {
+ print OUTFILE $notice;
+ $count++;
+ } # and comment this one out, too, if not using e-mail
+ }
+ }
+ $sth->finish;
+ close OUTFILE;
+ # if some notices have to be printed & managed by the library, send them to library mail address.
+ if ($count) {
+ open ODUES, "overdues" or die "Cannot open file overdues: $!";
+ my $notice = "$e_count overdue notices e-mailed\n";
+ $notice .= "$count overdue notices in file for printing\n\n";
+
+ $notice .= <ODUES>;
+ if ($nomail) {
+ print "TO => $email\n" if $email;
+ print "FROM => $from\n";
+ print "SUBJECT => Koha overdue\n";
+ print "MESSAGE => $notice\n";
+ } else {
+ my %mail = ( To => $email,
+ From => $from,
+ Subject => 'Koha overdues',
+ Message => $notice,
+ );
+ sendmail(%mail);
+ }
+ }
+ }
+ }
+}
\ No newline at end of file
projects / koha_gimpoz / commitdiff