Bug 6810: Send membership expiry reminder notices.

A new crontab based perl script to send membership expiry reminders. A
system preference controls the number of days in advance of membership
expiry that the notices will be sent on.

To Test:
1) Create a new Patron and set membership expiry date 14 days from the
   date of registration.
2) Check your systemprefence ( MemExpDayNotice to 14 days default value)
3) Manual testing Run ( perl membership_expiry.pl -h)
    It would give you various option:
    This script prepares for membership expiry reminders to be sent to
    patrons. It queues them in the message queue, which is processed by
    the process_message_queue.pl cronjob.
    See the comments in the script for directions on changing the script.
    This script has the following parameters :
     -c Confirm and remove this help & warning
     -n send No mail. Instead, all mail messages are printed on screen.
        Useful for testing purposes.
     -v verbose
    Do you wish to continue? (y/n)
4) Choose option for ex: perl membership_expiry.pl -c
5) Go to your koha database and check message_queue table you see some
   results.
6) Run (perl process_message_queue.pl) it will send email to those
   patron whose membership after 14 days from today.
7) Cron testing: (10   1 * * *  $KOHA_CRON_PATH/membership_expiry.pl -c)
8) Set your 15   * * * *  $KOHA_CRON_PATH/process_message_queue.pl
9) After running membership_expiry.pl, (process_message_queue.pl will
   send emails to those patron whose membership after 14 days from
   today).

Signed-off-by: Owen Leonard <oleonard@myacpl.org>
Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

diff --git a/C4/Letters.pm b/C4/Letters.pm
index 863da75..764f238 100644 (file)
--- a/C4/Letters.pm
+++ b/C4/Letters.pm
@@ -798,6 +798,18 @@ sub _parseletter_sth {
 sub _parseletter {
     my ( $letter, $table, $values ) = @_;
 
+    if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
+        my @dateexpiry = split /-/, $values->{'dateexpiry'};
+
+        $values->{'dateexpiry'} = C4::Dates->new(
+            sprintf(
+                '%04d-%02d-%02d',
+                Add_Delta_Days( @dateexpiry,0)
+            ),
+            'iso'
+        )->output();
+    }
+
     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
         my @waitingdate = split /-/, $values->{'waitingdate'};
 

diff --git a/C4/Members.pm b/C4/Members.pm
index 7ea9d9b..ebb8a1f 100644 (file)
--- a/C4/Members.pm
+++ b/C4/Members.pm
@@ -97,6 +97,7 @@ BEGIN {
         &GetBorrowersWithIssuesHistoryOlderThan
 
         &GetExpiryDate
+        &GetUpcomingMembershipExpires
 
         &AddMessage
         &DeleteMessage
@@ -1484,6 +1485,28 @@ sub GetExpiryDate {
     }
 }
 
+=head2 GetUpcomingMembershipExpires
+
+  my $upcoming_mem_expires = GetUpcomingMembershipExpires();
+
+=cut
+
+sub GetUpcomingMembershipExpires {
+    my $dbh = C4::Context->dbh;
+    my $days = C4::Context->preference("MembershipExpiryDaysNotice");
+    my $query = "
+        SELECT borrowers.*, categories.description,
+        branches.branchname, branches.branchemail FROM borrowers
+        LEFT JOIN branches on borrowers.branchcode = branches.branchcode
+        LEFT JOIN categories on borrowers.categorycode = categories.categorycode
+        WHERE dateexpiry = DATE_ADD(CURDATE(),INTERVAL $days DAY);
+    ";
+    my $sth = $dbh->prepare($query);
+    $sth->execute;
+    my $results = $sth->fetchall_arrayref({});
+    return $results;
+}
+
 =head2 GetborCatFromCatType
 
   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();

diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
index 9cc6c87..89e07b1 100644 (file)
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref
@@ -84,6 +84,11 @@ Patrons:
            class: integer
          - days beforehand.
      -
+         - Send a membership expiry notice that a patron is about to expire after
+         - pref: MembershipExpiryDaysNotice
+           class: integer
+         - days.
+     -
          - pref: patronimages
            choices:
                yes: Allow

diff --git a/misc/cronjobs/membership_expiry.pl b/misc/cronjobs/membership_expiry.pl
new file mode 100755 (executable)
index 0000000..2ed3d75
--- /dev/null
+++ b/misc/cronjobs/membership_expiry.pl
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+
+# This file is part of Koha.
+#
+# Copyright (C) 2013 Amit Gupta (amitddng135@gmail.com)
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+=head1 NAME
+
+membership_expires.pl - cron script to put membership expiry reminders into message queue
+
+=head1 SYNOPSIS
+
+./membership_expires.pl -c
+
+or, in crontab:
+
+0 1 * * * membership_expires.pl -c
+
+=cut
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Data::Dumper;
+BEGIN {
+    # find Koha's Perl modules
+    # test carefully before changing this
+    use FindBin;
+    eval { require "$FindBin::Bin/../kohalib.pl" };
+}
+
+use C4::Context;
+use C4::Letters;
+use C4::Dates qw/format_date/;
+
+# These are defaults for command line options.
+my $confirm;                              # -c: Confirm that the user has read and configured this script.
+my $nomail;                               # -n: No mail. Will not send any emails.
+my $verbose= 0;                           # -v: verbose
+
+GetOptions( 'c'              => \$confirm,
+            'n'              => \$nomail,
+            'v'              => \$verbose,
+       );
+
+
+my $usage = << 'ENDUSAGE';
+This script prepares for membership expiry reminders to be sent to
+patrons. It queues them in the message queue, which is processed by
+the process_message_queue.pl cronjob.
+See the comments in the script for directions on changing the script.
+This script has the following parameters :
+    -c Confirm and remove this help & warning
+    -n send No mail. Instead, all mail messages are printed on screen. Usefull for testing purposes.
+    -v verbose
+ENDUSAGE
+
+unless ($confirm) {
+    print $usage;
+    print "Do you wish to continue? (y/n)";
+    chomp($_ = <STDIN>);
+    exit unless (/^y/i);
+}
+
+my $admin_adress = C4::Context->preference('KohaAdminEmailAddress');
+warn 'getting upcoming membership expires' if $verbose;
+my $upcoming_mem_expires = C4::Members::GetUpcomingMembershipExpires();
+warn 'found ' . scalar( @$upcoming_mem_expires ) . ' issues' if $verbose;
+
+
+UPCOMINGMEMEXP: foreach my $recent ( @$upcoming_mem_expires ) {
+    my $from_address = $recent->{'branchemail'} || $admin_adress;
+    my $letter_type = 'MEMEXP';
+    my $letter = C4::Letters::getletter( 'members', $letter_type, $recent->{'branchcode'} );
+    die "no letter of type '$letter_type' found. Please see sample_notices.sql" unless $letter;
+
+    $letter = parse_letter({  letter    => $letter,
+                              borrowernumber => $recent->{'borrowernumber'},
+                              firstname => $recent->{'firstname'},
+                              categorycode  => $recent->{'categorycode'},
+                              branchcode => $recent->{'branchcode'},
+                          });
+    if ($letter) {
+        if ($nomail) {
+            print $letter->{'content'};
+        } else {
+             C4::Letters::EnqueueLetter( {  letter               => $letter,
+                                            borrowernumber       =>  $recent->{'borrowernumber'},
+                                            from_address           => $from_address,
+                                            message_transport_type => 'email',
+                                        } );
+         }
+       }
+    }
+
+
+=head1 METHODS
+
+=head2 parse_letter
+
+=cut
+
+sub parse_letter {
+    my $params = shift;
+    foreach my $required ( qw( letter borrowernumber ) ) {
+        return unless exists $params->{$required};
+    }
+    my $letter =  C4::Letters::GetPreparedLetter (
+            module => 'members',
+            letter_code => 'MEMEXP',
+            branchcode => $params->{'branchcode'},
+            tables => {'borrowers', $params->{'borrowernumber'},},
+    );
+}
+
+1;
+
+__END__