misc/cronjobs/overduenotices-csv.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 # Description:
   9 #       This script runs send a mail with an attached file of all overdues
  10 #       that can be used for overdues claims, with your preffered word processor
  11 #       (OpenOffice.org hopefully ;-) )
  12
  13 # Revision History:
  14 #    1.0  2003/9/7: original version
  15 #-----------------------------------
  16 # Copyright 2003 Skemotah Solutions
  17 #           2007 Paul POULAIN
  18 #
  19 # This file is part of Koha.
  20 #
  21 # Koha is free software; you can redistribute it and/or modify it under the
  22 # terms of the GNU General Public License as published by the Free Software
  23 # Foundation; either version 2 of the License, or (at your option) any later
  24 # version.
  25 #
  26 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  27 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  28 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  29 #
  30 # You should have received a copy of the GNU General Public License along with
  31 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  32 # Suite 330, Boston, MA  02111-1307 USA
  33
  34 use strict;
  35 use C4::Context;
  36 use C4::Date;
  37 use Date::Manip;
  38 use Mail::Sendmail;  # comment out if not doing e-mail notices
  39 use Getopt::Long;
  40 use MIME::QuotedPrint;
  41 use MIME::Base64;
  42 use utf8;
  43
  44 my ($confirm, $nomail,$branch,$filename);
  45 GetOptions(
  46     'c'    => \$confirm,
  47         'n'     => \$nomail,
  48         'b:s' => \$branch,
  49         'o:s' => \$filename,
  50 );
  51 unless ($confirm) {
  52         print qq|
  53 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.
  54 You MUST edit this script for your library BEFORE you run it for the first time!
  55 See the comments in the script for directions on changing the script.
  56 This script has 2 parameters :
  57         -c to confirm and remove this help & warning
  58         -n to avoid sending any mail. Instead, all mail messages are printed on screen. Usefull for testing purposes.
  59
  60 Do you wish to continue? (y/n)
  61 |;
  62         chomp($_ = <STDIN>);
  63         exit unless (/^y/i);  # comment these lines out once you've made the changes
  64
  65 }
  66 #
  67 # BEGINNING OF PARAMETERS
  68 #
  69 my $mindays = 7; # the notice will be sent after mindays days (grace period)
  70 my $maxdays = 500; # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
  71 my $smtpserver = 'smtp.laposte.net'; # your smtp server (the server who sent mails)
  72 my $from = 'fromadress@toto'; # all the mails sent to the borrowers will appear coming from here.
  73 my $mailtitle = 'Relances'; # the title of the mails
  74 my $librarymail = 'tonadress@email'; # all notices without mail are sent (in 1 mail) to this mail address. They must then be managed manua lly.
  75 # this parameter (the last) is the text of the mail that is sent.
  76 # this text contains fields that are replaced by their value. Those fields must be written between brackets
  77 # The following fields are available :
  78 # <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode>
  79 my $mailtext = q("<firstname>";"<lastname>";"<address>";"<address2>";"<postcode>";"<city>";"<email>";"<itemcount>";<titles>);
  80 #
  81 # END OF PARAMETERS
  82 #
  83 my $result;
  84 $result= <<END_HEADER;
  85 Name;Surname;Adress1;Adress2;zipcode;city;Mail;Nbitems;1title;1author;1barcode;1issuedate;1returndate;2title;2author;2barcode;2issue_date;2return_date;3title;3author;3barcode;3issue_date;3return_date;4title;4author;4barcode;4issue_date;4return_date;5title;5author;5barcode;5issue_date;5return_date;6title;6author;6barcode;6issue_date;6return_date;7title;7author;7barcode;7issue_date;7return_date;8title;8author;8barcode;8issue_date;8return_date;9title;9author;9barcode;9issue_date;9return_date;10title;10author;10barcode;10issue_date;10return_date;
  86 END_HEADER
  87
  88 # set the e-mail server -- comment out if not doing e-mail notices
  89 # unshift @{$Mail::Sendmail::mailcfg{'smtp'}} , $smtpserver;
  90 #                                         set your own mail server name here
  91
  92 my $dbh = C4::Context->dbh;
  93 my $query = "SELECT COUNT(*), issues.borrowernumber,firstname,surname,address,address2,city,zipcode,email FROM issues,borrowers ,categories WHERE TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN $mindays and $maxdays AND issues.borrowernumber=borrowers.borrowernumber and borrowers.categorycode=categories.categorycode and (categories.overduenoticerequired = 1)";
  94 $query .= " AND borrowers.branchcode=".$dbh->quote($branch) if $branch;
  95 $query .=" GROUP BY issues.borrowernumber";
  96 my $sth = $dbh->prepare ($query);
  97
  98 warn "Q : $query";
  99 my $sth2 = $dbh->prepare("SELECT biblio.title,biblio.author,items.barcode, issues.timestamp, issues.date_due FROM issues,items,biblio WHERE items.itemnumber=issues.itemnumber and biblio.biblionumber=items.biblionumber AND issues.borrowernumber=? AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN $mindays and $maxdays");
 100
 101 $sth->execute;
 102 #
 103 # my $itemcount = 0;
 104 # my $row;
 105 my $count = 0;   # to keep track of how many notices are printed
 106 my $e_count = 0;   # and e-mailed
 107 my ($itemcount,$borrnum,$firstname,$lastname,$address1,$address2,$city,$postcode,$email);
 108
 109 while (($itemcount,$borrnum,$firstname,$lastname,$address1,$address2,$city,$postcode,$email) = $sth->fetchrow) {
 110                 my $notice = $mailtext;
 111                 $notice =~ s/\<firstname\>/$firstname/g if $firstname;
 112                 $notice =~ s/\<lastname\>/$lastname/g if $lastname;
 113                 $notice =~ s/\<address1\>/$address1/g if $address1;
 114                 $notice =~ s/\<address2\>/$address2/g if $address2;
 115                 $notice =~ s/\<email\>/$email/g if $email;
 116                 $notice =~ s/\<postcode\>/$postcode/g if $postcode;
 117                 $notice =~ s/\<city\>/$city/g if $city;
 118                 $notice =~ s/\<itemcount\>/$itemcount/g;
 119
 120                 $sth2->execute($borrnum);
 121                 my $titles="";
 122                 my ($title, $author, $barcode,$timestamp,$date_due);
 123                 while (($title, $author, $barcode,$timestamp,$date_due) = $sth2->fetchrow){
 124                         $titles .= '"'.($title?$title:"").'";"'.($author?$author:"").'";"'.($barcode?$barcode:"").'";"' ;
 125                         $titles .= ($timestamp?format_date(substr($timestamp,0,10)):"").'";"'.($date_due?format_date($date_due):"").'";' ;
 126                 }
 127                 $notice =~ s/\<titles\>/$titles/g;
 128                 $notice =~ s/(\<.*?\>)//g;
 129                 $sth2->finish;
 130                 $result.=$notice."\n";
 131                 $count++;
 132
 133 }
 134 $sth->finish;
 135 if ($nomail) {
 136     if ($filename){
 137         open OUTFILE, ">:utf8","$filename" or die "impossible d'ouvrir le fichier de relances";
 138         print OUTFILE $result;
 139         close OUTFILE;
 140     }
 141     else {
 142         binmode STDOUT, ":encoding(UTF-8)";
 143         print $result;
 144     }
 145 } else {
 146         my %mail = ( To      => 'mailto@mail.com',
 147                                         From    => 'mailfrom@mail.com',
 148                                         Subject => 'Koha overdues',
 149                 );
 150         my $boundary = "====" . time() . "====";
 151         $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
 152
 153         my $message = encode_qp("The file");
 154
 155         $mail{body} = encode_base64($result);
 156         open OUTFILE, ">:utf8","$filename" or die "impossible d'ouvrir le fichier de relances";
 157         print OUTFILE $result;
 158         close OUTFILE;
 159
 160         $boundary = '--'.$boundary;
 161         $mail{body} = <<END_OF_BODY;
 162 $boundary
 163 Content-Type: text/plain; charset="utf-8"
 164 Content-Transfer-Encoding: quoted-printable
 165
 166 $message
 167 $boundary
 168 Content-Type: application/octet-stream; name="$^X"
 169 Content-Transfer-Encoding: base64
 170 Content-Disposition: attachment; filename="$filename"
 171
 172 $mail{body}
 173 $boundary--
 174 END_OF_BODY
 175
 176         sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
 177
 178 }
 179
 180 #}