#!/usr/bin/perl -w
use strict;


##################
#
#  advance notices / pre-overdues script
#
#  Knocked together by Dave Pattern <d.c.pattern@hud.ac.uk>
#  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 = <IN> ) 
    { 
        $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 = <IN> ) {
        $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 );
}