#!/usr/bin/perl -w use strict; ################## # # advance notices / pre-overdues script # # Knocked together by Dave Pattern # If you spot any bugs, please let me know! # ############# # # version 1.00 - last updated 27/Sep/2005 # ######### # # (cc) 2005 # # http://creativecommons.org/licenses/by-nc-sa/2.5/ # ##### ### bring in the required modules use DBI; use Mail::Sender; ################## # I've used Mail::Sender (http://jenda.krynicky.cz/#Mail::Sender) to send the emails, # but you can probably use any of the other Perl modules for sending emails. # If you do use a different module, you'll need to change the sendEmail( ) section too. ########## ### initialise variables my $path = '.'; my $settingsFile = $ARGV[0] || 'settings.ini'; my %settings = readIniFile( $settingsFile ); my $sth = ''; my @row = ( ); my @sentlist = ( ); my $total = 0; my $max = 52; my $logfile = time( ); ################## # $path is a relative path to where files and logs are stored # %settings contains the settings to be used (by default, read from the "settings.ini" file # $sth and @row are used by the database modules # @sentlist is used to build the summary # $total stores the total number of emails sent # $max is the maximum number of characters to use for book titles, etc # $logfile is used to generate the file name of the log file ########## ### you can set up a list of email addresses to ignore if you want... my %bademails = ( ); open(IN,"$path/emails_ignore.txt"); while( my $e = ) { $e =~ s/[\r\n]//gi; $e = lc($e); $bademails{$e} = 1; } close(IN); ### $summary contains the text to appear in the summary email... my $summary = qq( ==================================== ADVANCE NOTICES - LOG FILE ====================================\n\n); ### open the connection to the Horizon database my $dbh = DBI->connect('dbi:ODBC:REPORTSMITH', 'report', 'abc123', { RaiseError => 1 }); ################## # I've used an ODBC connection for our script, but you can probably make use # of other DBD modules from CPAN, e.g. DBD::Sybase, DBD::Oracle, etc. # In the above line: # REPORTSMITH = the ODBC connection name # report = the database connection username # abc123 = the database connection password ########## ### I've included itype descriptions in our emails, so we need to bring in the descriptions... $sth = $dbh->prepare( 'select itype, descr from itype' ); $sth->execute( ); my %itypes = ( ); while ( @row = $sth->fetchrow_array ) { $itypes{uc($row[0])} = $row[1] } ### get today's date my $today = int ( time ( ) / (24 * 60 * 60) ); addSummary( "today is $today\n" ); ### work out due date my $due = $today + $settings{days_in_advance}; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime( $due * 60 * 60 * 24 ); $mday = substr("00$mday",-2); $mon = substr("JanFebMarAprMayJunJulAugSepOctNovDec", $mon*3, 3); $year += 1900; my $day = substr("Sunday Monday Tuesday WednesdayThursday Friday Saturday ", $wday*9, 9 ); $day =~ s/ //g; addSummary( "looking for due date $mday/$mon/$year ($due)\n\n" ); ### get details of items due back on the specific due date... my %users = ( ); $sth = $dbh->prepare(" select borrower#, item#, ibarcode, bib#, call_reconstructed, itype, location, collection from item where due_date = $due order by borrower# "); $sth->execute( ); while ( @row = $sth->fetchrow_array ) { my $b = shift( @row ); if( $b && lc($b) ne 'null' ) { if($users{$b}) { $users{$b} .= ':::'. join( "\t", @row ) } else { $users{$b} = join( "\t", @row ) } } } ################## # by this point, the %users hash is a list of item info per borrower ########## ################## # now we start cycling through each of the users to create the emails ########## ### cycle through each user... foreach my $b ( keys %users ) { my @items = split( /:::/, $users{$b} ); ################## # firstly, we pick up more details about each borrower... ########## $sth = $dbh->prepare(" select location, btype, name_reconstructed from borrower where borrower# = $b "); $sth->execute( ); @row = $sth->fetchrow_array; my $location = $row[0]; my $btype = $row[1]; my $name = $row[2]; $sth = $dbh->prepare(" select email_address from borrower_address where borrower# = $b and ord = 0 "); $sth->execute( ); @row = $sth->fetchrow_array; my $email = $row[0]; $sth = $dbh->prepare(" select bbarcode from borrower_barcode where borrower# = $b "); $sth->execute( ); @row = $sth->fetchrow_array; my $bbarcode = $row[0]; ################## # skip to the next user if this one's opted out... ########## { my $lowercaseEmail = lc( $email ); if( $bademails{$lowercaseEmail} ) { addSummary( "ignoring $email ($bbarcode/$b/".uc($btype).")\nreason: email invalid or user opted out\n\n" ); next; } } ################## # skip to the next user if there's no email address on their record... ########## unless( $email ) { addSummary( "ignoring $email ($bbarcode/$b/".uc($btype).")\nreason: no email address in Horizon\n\n" ); next; } ################## # next, check the btype inclusions and exceptions settings to see if we should skip this user... ########## my $continue = 0; if( $settings{btype_include} ) { my @inc = split( / /, lc($settings{btype_include}) ); foreach my $inc ( @inc ) { if( lc($btype) eq $inc ) { $continue = 1 } } } else { $continue = 1; if( $settings{btype_exclude} ) { my @exc = split( / /, lc($settings{btype_exclude}) ); foreach my $exc ( @exc ) { if( lc($btype) eq $exc ) { $continue = 0 } } } } unless( $continue ) { addSummary( "ignoring $email ($bbarcode/$b/".uc($btype).")\nreason: emails not sent to this btype\n\n" ); next; } ################## # so far so good, let's start creating the text of the email... ########## my $message = ''; my $user = qq($name ($bbarcode)); $message .= qq(------------------------------------------------------------\n); $message .= substr(" ", 0, int(( 60 - length($user)) / 2)) . $user; $message .= qq( \n); $message .= substr(" ", 0, int(( 60 - length($email)) / 2)) . $email; $message .= qq( \n); $message .= qq(------------------------------------------------------------\n\n); my $requestCount = 0; my $itemCount = 0; my $dump = ''; my @barcodes = ( ); ####### cycle through each item foreach (@items) { my @b = split(/\t/); my $item = $b[0]; my $barcode = uc($b[1]); my $bib = $b[2]; my $dewey = $b[3]; my $itype = $b[4]; my $location = $b[5]; my $collection = $b[6]; ################## # check the itype inclusions and exclusions to see if we should skip this item... ########## if( $settings{itype_include} || $settings{itype_exclude} ) { my $continue = 0; if( $settings{itype_include} ) { my @inc = split( / /, lc($settings{itype_include}) ); foreach my $inc ( @inc ) { if( lc($itype) eq $inc ) { $continue = 1 } } } else { $continue = 1; my @exc = split( / /, lc($settings{itype_exclude}) ); foreach my $exc ( @exc ) { if( lc($itype) eq $exc ) { $continue = 0 } } } unless( $continue ) { addSummary( "ignoring itype $itype for item $barcode\n\n" ); next; } } ################## # check the location inclusions and exclusions to see if we should skip this item... ########## if( $settings{location_include} || $settings{location_exclude} ) { my $continue = 0; if( $settings{location_include} ) { my @inc = split( / /, lc($settings{location_include}) ); foreach my $inc ( @inc ) { if( lc($location) eq $inc ) { $continue = 1 } } } else { $continue = 1; my @exc = split( / /, lc($settings{location_exclude}) ); foreach my $exc ( @exc ) { if( lc($location) eq $exc ) { $continue = 0 } } } unless( $continue ) { addSummary( "ignoring location $location for item $barcode\n\n" ); next; } } ################## # check the collection inclusions and exclusions to see if we should skip this item... ########## if( $settings{collection_include} || $settings{collection_exclude} ) { my $continue = 0; if( $settings{collection_include} ) { my @inc = split( / /, lc($settings{collection_include}) ); foreach my $inc ( @inc ) { if( lc($collection) eq $inc ) { $continue = 1 } } } else { $continue = 1; my @exc = split( / /, lc($settings{collection_exclude}) ); foreach my $exc ( @exc ) { if( lc($collection) eq $exc ) { $continue = 0 } } } unless( $continue ) { addSummary( "ignoring collection $collection for item $barcode\n\n" ); next; } } ################## # if we've got this far, then the item should be safe to include in the email... ########## $itemCount++; push @barcodes, $barcode; ################## # check to see if there are requests in this bib# # Huddersfield uses bib level requests, so you'll need to change this next section # if you use item level requests ########## $sth = $dbh->prepare("SELECT count(request#) FROM request where bib# = $bib"); $sth->execute( ); @row = $sth->fetchrow_array; my $reqs = $row[0]; ################## # get the title of the item and truncate it if it's too long... ########## $sth = $dbh->prepare( "SELECT processed, reconst from title where bib# = $bib" ); $sth->execute( ); my @row = $sth->fetchrow_array; my $title = reconstructTitle( $row[0], $row[1] ); if( length($title) > $max ) { $title = trunc($title); } ################## # add the title, barcode and itype to the email # if there are requests, include a "***" ########## my $extra = ' '; if($reqs) { $extra = ' ***'; $requestCount++; } $dump .= "$extra $title\n $barcode"; if($itypes{$itype} && $itype ne 'LNC' ) { $dump .= "\n $itypes{$itype}" } $dump .= "\n\n"; } ################## # check to make sure there was at least one item to # include in the email, and then generate the rest of the text ########## if( $itemCount ) { ### my $hipurl = generateHipUrl( $email, $b ); my $subject = qq(Library notice - items due back on $day ($mday/$mon/$year)); addSummary( "sending to $email ($bbarcode/$b/".uc($btype).")\n" ); open( LOG, ">>$path/logs/$logfile.txt" ); print LOG time( )."\t$bbarcode\t$b\t$email\t"; print LOG join('/', @barcodes) ."\n"; close( LOG ); foreach (@barcodes) { addSummary( "\t\t$_\n" ) } addSummary( "\n" ); ################## # add the intro and list of items to the message text... ########## if( $itemCount == 1 ) { $message .= qq(This is a courtesy notification to remind you that you have \n); $message .= qq(at least one item on loan that will be due back shortly. \n\n); $message .= qq(According to our records, the following item is due for \n); $message .= qq(return on $day ($mday/$mon/$year): \n\n\n); $message .= $dump; } else { $message .= qq(This is a courtesy notification to remind you that you have \n); $message .= qq(one or more items on loan that will be due back shortly. \n\n); $message .= qq(According to our records, the following items are due for \n); $message .= qq(return on $day ($mday/$mon/$year): \n\n\n); $message .= $dump; } ################## # add a warning about the requested item(s)... ########## if( $requestCount == 1) { $message .= qq(\n); $message .= qq(The item marked with "***" has been requested by another user \n); $message .= qq(and you may not be able to renew it. This item will need \n); $message .= qq(to be returned on or before the due date. \n\n); } elsif( $requestCount > 1) { $message .= qq(\n); $message .= qq(The items marked with *** have been requested by another \n); $message .= qq(user and you may not be able to renew them. These items \n); $message .= qq(will need to be returned on or before the due date. \n\n); } ################## # add a footer to the email... ########## $message .= qq(\nTo renew your items go to the Library Catalogue and select\n); $message .= qq('My Account' (http://webcat.hud.ac.uk), or telephone \n); $message .= qq(01484 472045 during normal opening hours. \n\n); ### $message .= qq(You can also access your Library account using this link: \n); ### $message .= qq($hipurl \n\n); $message .= qq(Although we have sent you a courtesy notification, please \n); $message .= qq(remember that it is your responsibility to ensure that your \n); $message .= qq(items are returned or renewed by the due date. \n\n); $message .= qq(------------------------------------------------------------\n); $message .= qq( THIS IS AN AUTOMATED EMAIL - PLEASE DO NOT REPLY\n); $message .= qq(------------------------------------------------------------\n); $total++; push @sentlist, $email; ################## # if we're in debug mode, send the final email to the debug address, # otherwise send it to the user ########## if( $settings{debug} eq 'y' ) { my @debug = split( / /, $settings{debug_email} ); foreach my $debug (@debug) { sendEmail( $debug, $subject, $message ); } } else { sendEmail( $email, $subject, $message ); } ################## # let's be nice to the email server and pause for a few # seconds after every 30 emails... ########## if( $total % 30 == 0 ) { print "sleeping\n"; sleep(5); } } } ################## # all done - just the email summary to send! ########## addSummary( "\n\n------------------------" ); addSummary( "\n\nsent $total emails\n\n" ); if( @sentlist ) { addSummary( "those emails were sent to:\n\n\t" . join( "\n\t", sort( @sentlist ) ) . "\n\n" ); } if( $settings{summary} eq 'y' ) { my @email = split( / /, $settings{summary_email} ); foreach my $email ( @email ) { sendEmail( $email, "notices for system date $today", $summary ); } } ################## # trunc( textString ) ########## # Truncates a string of text so that it fits nicely in a plain text email. #### sub trunc { my $title = shift; my @words = split(/ /, $title); my $cnt = 0; my $done = 0; my $ret = shift(@words); foreach my $w (@words) { unless($done) { if(length("$ret $w") > $max) { $ret .= '...'; $done = 1; } else { $ret .= " $w"; } } } return($ret); } ################## # sendEmail( emailAddress, emailSubject, emailMessage ) ########## # The main chunk of code for actually sending the email. # If you use anything other than the Mail::Sender module, # then you'll need to amend this section... #### sub sendEmail { my $email = shift; my $subject = shift; my $message = shift; $message =~ s/\n/\r\n/gi; open my $DEBUG, ">>$path/logs/$logfile debug.txt" or die "Can't open the debug file: $!\n"; my $sender = new Mail::Sender { smtp => $settings{smtp_server}, debug => $DEBUG, debug_level => 4, from => $settings{email_replyto}, }; if ($sender->MailMsg( { smtp => $settings{smtp_server}, from => $settings{email_replyto}, replyto => $settings{email_replyto}, to => $email, subject => $subject, msg => $message, } ) < 0) { print "not sent to $email\n"; open(OUT,">>$path/logs/$logfile bademails.txt"); print OUT "$email\n"; close(OUT); } else { } $sender->Close; close($DEBUG); } ################## # sendEmail( fileName ) ########## # Read the settings file and return the settings as a hash #### sub readIniFile { my $file = shift; my %ret = ( ); unless( open( IN, $file ) ) { die "unable to open INI file: $file\n"; } while( my $l = ) { $l =~ s/[\r\n]//gi; $l =~ s/\s/ /gi; while( $l =~ / / ) { $l =~ s/ / /gi } while( $l =~ /^ / ) { $l =~ s/^ //gi } while( $l =~ / $/ ) { $l =~ s/ $//gi } if( $l ) { my( $name, $value ) = split( / /, $l, 2 ); if( $name eq 'debug' || $name eq 'summary' ) { if( $value =~ /y/i ) { $value = 'y' } else { $value = 'n' } } $ret{$name} = $value; } } unless( $ret{'days_in_advance'} || $ret{'days_in_advance'} < 0 || $ret{'days_in_advance'} > 6 ) { die 'days_in_advance needs to be declared and in the range 1 to 6' } return( %ret ); } ################## # addSummary( text ) ########## # Append the summary text #### sub addSummary { my $str = shift; $summary .= $str; print $str; } ################## # generateHipUrl( emailAddress, borrowerNumber ) ########## # generate a secure URL to the user's HIP account #### sub generateHipUrl { my $email = shift; my $borr = shift; my $salt = '????'; use Digest::MD5 qw(md5_hex); my $md5 = md5_hex( $borr, $salt, $email ); return( 'https://library.hud.ac.uk/hip/'.$borr.substr($md5,0,22) ); } ################## # reconstructTitle( processed, reconst ) ########## # Reconstruct the item title. #### sub reconstructTitle { my $title = shift; my $recon = shift; my $final = $title; my $len = length( $recon ); my $pos = 0; ### IF RECONSTRUCT IS EMPTY, WE DON'T NEED TO DO ANYTHING... if( $recon =~ /^\s*$/ ) { return( $final ) } ### BEGIN CRAWLING THROUGH RECONSTRUCT... while( $pos < $len ) { $pos++; my $char = substr( $recon, $pos, 1 ); my $before = substr( $recon, $pos-1, 1 ); my $after = substr( $recon, $pos+1, 1 ); if( $char eq 'M' ) { my $after_string = substr( $recon, $pos + 2, ord( substr( $recon, $pos+1, 1 ) ) ); if( length( $after_string ) < ord( substr( $recon, $pos+1, 1 ) ) ) { $after_string = $after_string . " " } $final = substr( $final, 0, ord($before) -1 ) . $after_string . substr( $final, ord($before)-1, 255 ); $pos = $pos + ord( substr( $recon, $pos+1, 1 ) ); $pos = $pos + 2; } elsif( $char eq 'I' ) { my $after_string = $after; $final = substr( $final, 0, ord($before) -1 ) . $after_string . substr( $final, ord($before)-1, 255 ); $pos = $pos + 2; } elsif( $char eq '2' ) { my $after_string = substr( $recon, $pos+1, 1 ); $final = substr( $final, 0, ord($before) -1 ) . $after_string . substr( $final, ord($before)+1, 255 ); $pos = $pos + 2; } elsif( $char eq 'R' ) { my $after_string = substr( $recon, $pos+1, 1 ); $final = substr( $final, 0, ord($before) -1 ) . $after_string . substr( $final, ord($before), 255 ); $pos = $pos + 2; } elsif( $char eq 'P' ) { my $after_string = substr( $recon, $pos+1, 2 ); $final = substr( $final, 0, ord($before) -1 ) . $after_string . substr( $final, ord($before), 255 ); $pos = $pos + 3; } elsif( $char eq 'D' ) { $final = substr( $final, 0, ord($before) -1 ) . substr( $final, ( ord($before)-1 + ord($after) ), 255 ); $pos = $pos + 2; } elsif( $char eq 'E' ) { $final = substr( $final, 0, ord($before) -1 ) . substr( $final, ( ord($before) ), 255 ); $pos = $pos + 1; } ####### NOT SURE IF THIS IS RIGHT, BUT IT WORKS! elsif( $char eq 'C' ) { my $string = substr( $recon, $pos + 1, 255 ); $final = substr( $final, 0, ord($before) -1 ) . $string; $pos = $pos + 1000; } ####### GIVE UP IF IT'S AN UNKNOWN COMMAND... else { die "unknown $char at $pos\n" } } ### FINAL TIDY UP FOR DISPLAY ON WEB PAGE... $final =~ s/(\w) \/$/$1./gi; $final =~ s/ \/$//g; $final =~ s/ \:/\:/g; $final =~ tr/\000-\177//cd; $final =~ s/\.$//g; return( $final ); }