View | Details | Raw Unified | Return to bug 6810
Collapse All | Expand All

(-)a/C4/Letters.pm (+12 lines)
Lines 798-803 sub _parseletter_sth { Link Here
798
sub _parseletter {
798
sub _parseletter {
799
    my ( $letter, $table, $values ) = @_;
799
    my ( $letter, $table, $values ) = @_;
800
800
801
    if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
802
        my @dateexpiry = split /-/, $values->{'dateexpiry'};
803
804
        $values->{'dateexpiry'} = C4::Dates->new(
805
            sprintf(
806
                '%04d-%02d-%02d',
807
                Add_Delta_Days( @dateexpiry,0)
808
            ),
809
            'iso'
810
        )->output();
811
    }
812
801
    if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
813
    if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
802
        my @waitingdate = split /-/, $values->{'waitingdate'};
814
        my @waitingdate = split /-/, $values->{'waitingdate'};
803
815
(-)a/C4/Members.pm (+23 lines)
Lines 97-102 BEGIN { Link Here
97
        &GetBorrowersWithIssuesHistoryOlderThan
97
        &GetBorrowersWithIssuesHistoryOlderThan
98
98
99
        &GetExpiryDate
99
        &GetExpiryDate
100
        &GetUpcomingMembershipExpires
100
101
101
        &AddMessage
102
        &AddMessage
102
        &DeleteMessage
103
        &DeleteMessage
Lines 1486-1491 sub GetExpiryDate { Link Here
1486
    }
1487
    }
1487
}
1488
}
1488
1489
1490
=head2 GetUpcomingMembershipExpires
1491
1492
  my $upcoming_mem_expires = GetUpcomingMembershipExpires();
1493
1494
=cut
1495
1496
sub GetUpcomingMembershipExpires {
1497
    my $dbh = C4::Context->dbh;
1498
    my $days = C4::Context->preference("MembershipExpiryDaysNotice");
1499
    my $query = "
1500
        SELECT borrowers.*, categories.description,
1501
        branches.branchname, branches.branchemail FROM borrowers
1502
        LEFT JOIN branches on borrowers.branchcode = branches.branchcode
1503
        LEFT JOIN categories on borrowers.categorycode = categories.categorycode
1504
        WHERE dateexpiry = DATE_ADD(CURDATE(),INTERVAL $days DAY);
1505
    ";
1506
    my $sth = $dbh->prepare($query);
1507
    $sth->execute;
1508
    my $results = $sth->fetchall_arrayref({});
1509
    return $results;
1510
}
1511
1489
=head2 GetborCatFromCatType
1512
=head2 GetborCatFromCatType
1490
1513
1491
  ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1514
  ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/patrons.pref (+5 lines)
Lines 84-89 Patrons: Link Here
84
           class: integer
84
           class: integer
85
         - days beforehand.
85
         - days beforehand.
86
     -
86
     -
87
         - Send a membership expiry notice that a patron is about to expire after
88
         - pref: MembershipExpiryDaysNotice
89
           class: integer
90
         - days.
91
     -
87
         - pref: patronimages
92
         - pref: patronimages
88
           choices:
93
           choices:
89
               yes: Allow
94
               yes: Allow
(-)a/misc/cronjobs/membership_expiry.pl (-1 / +131 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright (C) 2013 Amit Gupta (amitddng135@gmail.com)
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
=head1 NAME
21
22
membership_expires.pl - cron script to put membership expiry reminders into message queue
23
24
=head1 SYNOPSIS
25
26
./membership_expires.pl -c
27
28
or, in crontab:
29
30
0 1 * * * membership_expires.pl -c
31
32
=cut
33
34
use strict;
35
use warnings;
36
use Getopt::Long;
37
use Data::Dumper;
38
BEGIN {
39
    # find Koha's Perl modules
40
    # test carefully before changing this
41
    use FindBin;
42
    eval { require "$FindBin::Bin/../kohalib.pl" };
43
}
44
45
use C4::Context;
46
use C4::Letters;
47
use C4::Dates qw/format_date/;
48
49
# These are defaults for command line options.
50
my $confirm;                              # -c: Confirm that the user has read and configured this script.
51
my $nomail;                               # -n: No mail. Will not send any emails.
52
my $verbose= 0;                           # -v: verbose
53
54
GetOptions( 'c'              => \$confirm,
55
            'n'              => \$nomail,
56
            'v'              => \$verbose,
57
       );
58
59
60
my $usage = << 'ENDUSAGE';
61
This script prepares for membership expiry reminders to be sent to
62
patrons. It queues them in the message queue, which is processed by
63
the process_message_queue.pl cronjob.
64
See the comments in the script for directions on changing the script.
65
This script has the following parameters :
66
    -c Confirm and remove this help & warning
67
    -n send No mail. Instead, all mail messages are printed on screen. Usefull for testing purposes.
68
    -v verbose
69
ENDUSAGE
70
71
unless ($confirm) {
72
    print $usage;
73
    print "Do you wish to continue? (y/n)";
74
    chomp($_ = <STDIN>);
75
    exit unless (/^y/i);
76
}
77
78
my $admin_adress = C4::Context->preference('KohaAdminEmailAddress');
79
warn 'getting upcoming membership expires' if $verbose;
80
my $upcoming_mem_expires = C4::Members::GetUpcomingMembershipExpires();
81
warn 'found ' . scalar( @$upcoming_mem_expires ) . ' issues' if $verbose;
82
83
84
UPCOMINGMEMEXP: foreach my $recent ( @$upcoming_mem_expires ) {
85
    my $from_address = $recent->{'branchemail'} || $admin_adress;
86
    my $letter_type = 'MEMEXP';
87
    my $letter = C4::Letters::getletter( 'members', $letter_type, $recent->{'branchcode'} );
88
    die "no letter of type '$letter_type' found. Please see sample_notices.sql" unless $letter;
89
90
    $letter = parse_letter({  letter    => $letter,
91
                              borrowernumber => $recent->{'borrowernumber'},
92
                              firstname => $recent->{'firstname'},
93
                              categorycode  => $recent->{'categorycode'},
94
                              branchcode => $recent->{'branchcode'},
95
                          });
96
    if ($letter) {
97
        if ($nomail) {
98
            print $letter->{'content'};
99
        } else {
100
             C4::Letters::EnqueueLetter( {  letter               => $letter,
101
                                            borrowernumber       =>  $recent->{'borrowernumber'},
102
                                            from_address           => $from_address,
103
                                            message_transport_type => 'email',
104
                                        } );
105
         }
106
       }
107
    }
108
109
110
=head1 METHODS
111
112
=head2 parse_letter
113
114
=cut
115
116
sub parse_letter {
117
    my $params = shift;
118
    foreach my $required ( qw( letter borrowernumber ) ) {
119
        return unless exists $params->{$required};
120
    }
121
    my $letter =  C4::Letters::GetPreparedLetter (
122
            module => 'members',
123
            letter_code => 'MEMEXP',
124
            branchcode => $params->{'branchcode'},
125
            tables => {'borrowers', $params->{'borrowernumber'},},
126
    );
127
}
128
129
1;
130
131
__END__

Return to bug 6810