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    returndate IS NULL
 149         AND    TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN ? and ? ");
 150     my $rqoverduerules = $dbh->prepare("SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ");
 151     $rqoverduerules->execute($branchcode);
 152         my $outfile = 'overdues_' . ($mybranch || $branchcode || 'default');
 153         open (OUTFILE, ">$outfile") or die "Cannot write file $outfile : $!";
 154     while (my $data=$rqoverduerules->fetchrow_hashref){
 155         for (my $i=1; $i<=3; $i++) {
 156             # Two actions:
 157             # A- Send a letter
 158             # B- Debar
 159                         $debug and print STDERR "branch '$branchcode', pass $i\n";
 160             my $mindays = $data->{"delay$i"}; # the notice will be sent after mindays days (grace period)
 161             my $maxdays = ($data->{"delay".($i+1)}?
 162                            $data->{"delay".($i+1)}
 163                             :($MAX?$MAX:365)); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
 164             # LETTER parameters
 165             my $from = $emailaddress; # all mail sent will appear to be coming from here.
 166             my $mailtitle = ($choice) ? 'Issue status' : 'Overdue'; # the title of the mails
 167             my $librarymail = $emailaddress; # all notices w/o mail are sent (in 1 mail) to this address. They must then be managed manually.
 168             my $letter = $data->{"letter$i"} if $data->{"letter$i"};
 169                         unless ($letter) {
 170                                 warn "No letter$i code for branch '$branchcode'";
 171                                 next;
 172                         }
 173                         $letter_sth->execute($letter);
 174             my ($mailtext)=$letter_sth->fetchrow;
 175                         unless ($mailtext) {
 176                                 warn "Message '$letter' content not found";
 177                                 next;
 178                         }
 179             # $mailtext is the text of the mail that is sent.
 180             # this text contains fields that are replaced by their value. Those fields must be written between brackets
 181             # The following fields are available :
 182             # <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode>
 183                         #
 184             # END OF PARAMETERS
 185
 186             my $strsth = "
 187         SELECT COUNT(*), issues.borrowernumber,firstname,surname,address,address2,city,zipcode, email, MIN(date_due) as longest_issue
 188         FROM   issues,borrowers,categories
 189         WHERE  returndate IS NULL
 190         AND    issues.borrowernumber=borrowers.borrowernumber
 191         AND    borrowers.categorycode=categories.categorycode ";
 192             $strsth .= "\n\tAND    issues.branchcode='$branchcode' " if ($branchcode);
 193             $strsth .= "\n\tAND    borrowers.categorycode='".$data->{categorycode}."' " if ($data->{categorycode});
 194             $strsth .= "\n\tAND    categories.overduenoticerequired=1
 195         GROUP BY issues.borrowernumber HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN ? and ? ";
 196             my $sth = $dbh->prepare($strsth);
 197             $sth->execute($mindays, $maxdays);
 198             $debug and warn $strsth . "\n\n ($mindays, $maxdays)\nreturns " .  $sth->rows . " rows";
 199             my $count = 0;              # to keep track of how many notices are printed
 200             my $e_count = 0;    # and e-mailed
 201             my $date = C4::Dates->new()->output;
 202             my ($itemcount,$borrowernumber,$firstname,$lastname,$address1,$address2,$city,$postcode,$email);
 203             while (($itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email) = $sth->fetchrow) {
 204                 if ($data->{"debarred$i"}){
 205                     #action taken is debarring
 206                     $rqdebarring->execute($borrowernumber);
 207                     print STDERR "debarring $borrowernumber $firstname $lastname\n";
 208                 }
 209                                 # for whatever reason, some of the template text is "double nested" with tags like:
 210                                 #   <<branches.branchname>><<borrowers.firstname>>
 211                                 # So we use the + operators below.
 212                 if ($letter){
 213                     my $notice .= $mailtext;
 214                                         $notice =~ s/[<]+itemcount[>]+/$itemcount/g               if ($itemcount);
 215                                         $notice =~ s/[<]+(borrowers\.)?firstname[>]+/$firstname/g if ($firstname);
 216                                         $notice =~ s/[<]+(borrowers\.)?surname[>]+/$lastname/g    if ($lastname);
 217                                         $notice =~ s/[<]+lastname[>]+/$lastname/g                 if ($lastname);
 218                                         $notice =~ s/[<]+address1[>]+/$address1/g                 if ($address1);
 219                                         $notice =~ s/[<]+address2[>]+/$address2/g                 if ($address2);
 220                                         $notice =~ s/[<]+city[>]+/$city/g                         if ($city);
 221                                         $notice =~ s/[<]+postcode[>]+/$postcode/g                 if ($postcode);
 222                                         $notice =~ s/[<]+date[>]+/$date/g                         if ($date);
 223                                         $notice =~ s/[<]+bib[>]+/$branchname/g                    if ($branchname);
 224                                         $notice =~ s/[<]+(branches\.)branchname[>]+/$mybranch/g   if ($mybranch);
 225                                         $notice =~ s/[<]+(branches\.)branchname[>]+/$branchname/g if ($branchname);
 226
 227                     $sth2->execute($borrowernumber, $mindays, $maxdays);
 228                     my $titles="";
 229                     while (my ($title, $author, $barcode,$issuedate) = $sth2->fetchrow){
 230                         $titles .= join "\t", format_date($issuedate), ($barcode?$barcode:""), ($title?$title:""), ($author?$author:"") . "\n";
 231                     }
 232                     $notice =~ s/\<titles\>/$titles/g;
 233                                         my @misses = grep {/./} map {/^([^>]*)[>]+/; ($1 || '');} split /\</, $notice;
 234                                         (@misses) and warn "The following terms were not matched/replaced: \n\t" . join "\n\t", @misses;
 235                     $notice =~ s/\<[^<>]*?\>//g;        # Now that we've warned about them, remove them.
 236                     $notice =~ s/\<[^<>]*?\>//g;        # 2nd pass for the double nesting.
 237                     $sth2->finish;
 238                     if ($email) {   # or you might check for borrowers.preferredcont
 239                         if ($nomail) {
 240                             print "   TO   => $email\n";
 241                             print "  FROM  => $emailaddress\n";
 242                             print "SUBJECT => $mailtitle\n";
 243                             print "MESSAGE => $notice\n";
 244                         } else {
 245                             my %mail = ( To     => $email,
 246                                         From    => $emailaddress,
 247                                         Subject => $mailtitle,
 248                                         Message => $notice,
 249                                     );
 250                             sendmail(%mail);
 251                         }
 252                         $e_count++
 253                     } else {
 254                         print OUTFILE $notice;
 255                         $count++;
 256                     }
 257                 }
 258             }
 259             $sth->finish;
 260             # if some notices have to be printed & managed by the library, send them to library mail address.
 261             if ($count) {
 262                 open (ODUES, $outfile) or die "Cannot read file $outfile: $!";
 263                 my $notice = "$e_count overdue notices e-mailed\n"
 264                                         . "$count overdue notices in file for printing\n\n"
 265                                         . <ODUES>;
 266                 if ($nomail) {
 267                     print "   TO   => $email\n" if $email;
 268                     print "  FROM  => $emailaddress\n";
 269                     print "SUBJECT => Koha overdue\n";
 270                     print "MESSAGE => $notice\n";
 271                 } else {
 272                     my %mail = (To      => $emailaddress,
 273                                 From    => $emailaddress,
 274                                 Subject => 'Koha overdues',
 275                                 Message => $notice,
 276                             );
 277                     sendmail(%mail);
 278                 }
 279             }
 280         }
 281     }
 282         close OUTFILE;
 283 }