misc/cronjobs/overduenotices-30.pl

   1 #!/usr/bin/perl -w
   2 #-----------------------------------
   3 # Script Name: overduenotices.pl
   4 # Script Version: 1.0
   5 # Date:  2003/9/7
   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)
   9 # Description:
  10 #       This script runs a Koha report of items using overduerules tables and letters tool management.
  11 # Revision History:
  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
  17 #
  18 # This file is part of Koha.
  19 #
  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
  23 # version.
  24 #
  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.
  28 #
  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
  32
  33 use strict;
  34 BEGIN {
  35     # find Koha's Perl modules
  36     # test carefully before changing this
  37     use FindBin;
  38     eval { require "$FindBin::Bin/../kohalib.pl" };
  39 }
  40
  41 use C4::Context;
  42 use C4::Dates qw/format_date/;
  43 use C4::Debug;
  44 use Mail::Sendmail;  # comment out if not doing e-mail notices
  45 use Getopt::Long;
  46
  47 sub usage () {
  48         return <<EndOfUsage
  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.
  51
  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 ?
  61
  62 Example:
  63         misc/cronjobs/overduenotices-30.pl -c -branch MAIN -s foobar.mail.com
  64
  65 EndOfUsage
  66         ;
  67 }
  68
  69 my ($confirm, $nomail, $mybranch, $myborcat,$myborcatout, $letter, $MAX, $choice);
  70 my ($smtpserver);
  71 GetOptions(
  72     'all'         => \$choice,
  73     'c'           => \$confirm,
  74     'n'           => \$nomail,
  75     'max=s'           => \$MAX,
  76     'smtp=s'      => \$smtpserver,
  77         'branch=s'    => \$mybranch,
  78         'borcat=s'    => \$myborcat,
  79         'borcatout=s' => \$myborcatout,
  80 );
  81
  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");
  86
  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";
  91 unless ($confirm) {
  92         print qq|
  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.
  95
  96 |       . &usage . "Do you wish to continue? (y/[n]) ";
  97         chomp($_ = <STDIN>);
  98         unless (/^\s*[yo]/i) {
  99                 print "Exiting.\n";
 100                 exit;
 101         }
 102 }
 103
 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;
 109
 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";
 113
 114 if ($mybranch) {
 115         print "Branch $mybranch selected\n";
 116         if (scalar grep {$mybranch eq $_} @branches) {
 117                 @branches = ($mybranch);
 118         } else {
 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";
 123                 @branches = ('');
 124         }
 125 }
 126
 127 foreach my $branchcode (@branches) {
 128     my $branchname;
 129     my $emailaddress;
 130     if ($branchcode) {
 131         my $rqbranch=$dbh->prepare("SELECT branchemail,branchname FROM branches WHERE branchcode = ?");
 132         $rqbranch->execute($mybranch || $branchcode);
 133         ($emailaddress,$branchname) = $rqbranch->fetchrow;
 134     }
 135         $emailaddress = C4::Context->preference('KohaAdminEmailAddress') unless ($emailaddress);
 136
 137     print STDERR sprintf "branchcode : '%s' using %s\n", ($mybranch || $branchcode), $emailaddress;
 138
 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++) {
 155             # Two actions:
 156             # A- Send a letter
 157             # B- Debar
 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)
 163             # LETTER parameters
 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"};
 168                         unless ($letter) {
 169                                 warn "No letter$i code for branch '$branchcode'";
 170                                 next;
 171                         }
 172                         $letter_sth->execute($letter);
 173             my ($mailtext)=$letter_sth->fetchrow;
 174                         unless ($mailtext) {
 175                                 warn "Message '$letter' content not found";
 176                                 next;
 177                         }
 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>
 182                         #
 183             # END OF PARAMETERS
 184
 185             my $strsth = "
 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";
 206                 }
 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.
 210                 if ($letter){
 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);
 224
 225                     $sth2->execute($borrowernumber, $mindays, $maxdays);
 226                     my $titles="";
 227                     while (my ($title, $author, $barcode,$issuedate) = $sth2->fetchrow){
 228                         $titles .= join "\t", format_date($issuedate), ($barcode?$barcode:""), ($title?$title:""), ($author?$author:"") . "\n";
 229                     }
 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.
 235                     $sth2->finish;
 236                     if ($email) {   # or you might check for borrowers.preferredcont
 237                         if ($nomail) {
 238                             print "   TO   => $email\n";
 239                             print "  FROM  => $emailaddress\n";
 240                             print "SUBJECT => $mailtitle\n";
 241                             print "MESSAGE => $notice\n";
 242                         } else {
 243                             my %mail = ( To     => $email,
 244                                         From    => $emailaddress,
 245                                         Subject => $mailtitle,
 246                                         Message => $notice,
 247                                     );
 248                             sendmail(%mail);
 249                         }
 250                         $e_count++
 251                     } else {
 252                         print OUTFILE $notice;
 253                         $count++;
 254                     }
 255                 }
 256             }
 257             $sth->finish;
 258             # if some notices have to be printed & managed by the library, send them to library mail address.
 259             if ($count) {
 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"
 263                                         . <ODUES>;
 264                 if ($nomail) {
 265                     print "   TO   => $email\n" if $email;
 266                     print "  FROM  => $emailaddress\n";
 267                     print "SUBJECT => Koha overdue\n";
 268                     print "MESSAGE => $notice\n";
 269                 } else {
 270                     my %mail = (To      => $emailaddress,
 271                                 From    => $emailaddress,
 272                                 Subject => 'Koha overdues',
 273                                 Message => $notice,
 274                             );
 275                     sendmail(%mail);
 276                 }
 277             }
 278         }
 279     }
 280         close OUTFILE;
 281 }