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

(-)a/C4/Circulation.pm (-11 / +26 lines)
Lines 47-52 use Algorithm::CheckDigits; Link Here
47
use Data::Dumper;
47
use Data::Dumper;
48
use Koha::DateUtils;
48
use Koha::DateUtils;
49
use Koha::Calendar;
49
use Koha::Calendar;
50
use Koha::Borrower::Debarments;
50
use Carp;
51
use Carp;
51
use Date::Calc qw(
52
use Date::Calc qw(
52
  Today
53
  Today
Lines 1888-1893 sub AddReturn { Link Here
1888
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1889
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1889
        if C4::Context->preference("ReturnLog");
1890
        if C4::Context->preference("ReturnLog");
1890
    
1891
    
1892
    # Remove any OVERDUES related debarment if the borrower has no overdues
1893
    if ( $borrowernumber
1894
      && $borrower->{'debarred'}
1895
      && C4::Context->preference('AutoRemoveOverduesRestrictions')
1896
      && !HasOverdues( $borrowernumber )
1897
      && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
1898
    ) {
1899
        DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
1900
    }
1901
1891
    # FIXME: make this comment intelligible.
1902
    # FIXME: make this comment intelligible.
1892
    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1903
    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1893
    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1904
    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
Lines 2020-2038 sub _debar_user_on_return { Link Here
2020
2031
2021
            my $new_debar_dt =
2032
            my $new_debar_dt =
2022
              $dt_today->clone()->add_duration( $deltadays * $finedays );
2033
              $dt_today->clone()->add_duration( $deltadays * $finedays );
2023
            if ( $borrower->{debarred} ) {
2024
                my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2025
2034
2026
                # Update patron only if new date > old
2035
            Koha::Borrower::Debarments::AddUniqueDebarment({
2027
                if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) !=
2036
                borrowernumber => $borrower->{borrowernumber},
2028
                    -1 )
2037
                expiration     => $new_debar_dt->ymd(),
2029
                {
2038
                type           => 'SUSPENSION',
2030
                    return;
2039
            });
2031
                }
2032
2040
2033
            }
2034
            C4::Members::DebarMember( $borrower->{borrowernumber},
2035
                $new_debar_dt->ymd() );
2036
            return $new_debar_dt->ymd();
2041
            return $new_debar_dt->ymd();
2037
        }
2042
        }
2038
    }
2043
    }
Lines 2613-2618 sub AddRenewal { Link Here
2613
	}
2618
	}
2614
    }
2619
    }
2615
2620
2621
    # Remove any OVERDUES related debarment if the borrower has no overdues
2622
    my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2623
    if ( $borrowernumber
2624
      && $borrower->{'debarred'}
2625
      && !HasOverdues( $borrowernumber )
2626
      && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2627
    ) {
2628
        DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2629
    }
2630
2616
    # Log the renewal
2631
    # Log the renewal
2617
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2632
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2618
	return $datedue;
2633
	return $datedue;
(-)a/C4/Members.pm (-27 / +15 lines)
Lines 39-44 use C4::NewsChannels; #get slip news Link Here
39
use DateTime;
39
use DateTime;
40
use DateTime::Format::DateParse;
40
use DateTime::Format::DateParse;
41
use Koha::DateUtils;
41
use Koha::DateUtils;
42
use Koha::Borrower::Debarments qw(IsDebarred);
42
use Text::Unaccent qw( unac_string );
43
use Text::Unaccent qw( unac_string );
43
44
44
our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
45
our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
Lines 103-108 BEGIN { Link Here
103
104
104
        &IssueSlip
105
        &IssueSlip
105
        GetBorrowersWithEmail
106
        GetBorrowersWithEmail
107
108
        HasOverdues
106
    );
109
    );
107
110
108
    #Modify data
111
    #Modify data
Lines 636-642 sub IsMemberBlocked { Link Here
636
    my $borrowernumber = shift;
639
    my $borrowernumber = shift;
637
    my $dbh            = C4::Context->dbh;
640
    my $dbh            = C4::Context->dbh;
638
641
639
    my $blockeddate = CheckBorrowerDebarred($borrowernumber);
642
    my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
640
643
641
    return ( 1, $blockeddate ) if $blockeddate;
644
    return ( 1, $blockeddate ) if $blockeddate;
642
645
Lines 2214-2245 sub GetBorrowersNamesAndLatestIssue { Link Here
2214
    return $results;
2217
    return $results;
2215
}
2218
}
2216
2219
2217
=head2 DebarMember
2218
2219
my $success = DebarMember( $borrowernumber, $todate );
2220
2221
marks a Member as debarred, and therefore unable to checkout any more
2222
items.
2223
2224
return :
2225
true on success, false on failure
2226
2227
=cut
2228
2229
sub DebarMember {
2230
    my $borrowernumber = shift;
2231
    my $todate         = shift;
2232
2233
    return unless defined $borrowernumber;
2234
    return unless $borrowernumber =~ /^\d+$/;
2235
2236
    return ModMember(
2237
        borrowernumber => $borrowernumber,
2238
        debarred       => $todate
2239
    );
2240
2241
}
2242
2243
=head2 ModPrivacy
2220
=head2 ModPrivacy
2244
2221
2245
=over 4
2222
=over 4
Lines 2509-2514 sub AddMember_Opac { Link Here
2509
    return ( $borrowernumber, $password );
2486
    return ( $borrowernumber, $password );
2510
}
2487
}
2511
2488
2489
sub HasOverdues {
2490
    my ( $borrowernumber ) = @_;
2491
2492
    my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2493
    my $sth = C4::Context->dbh->prepare( $sql );
2494
    $sth->execute( $borrowernumber );
2495
    my ( $count ) = $sth->fetchrow_array();
2496
2497
    return $count;
2498
}
2499
2512
END { }    # module clean-up code here (global destructor)
2500
END { }    # module clean-up code here (global destructor)
2513
2501
2514
1;
2502
1;
(-)a/C4/Overdues.pm (-33 lines)
Lines 76-85 BEGIN { Link Here
76
	# &GetIssuingRules - delete.
76
	# &GetIssuingRules - delete.
77
	# use C4::Circulation::GetIssuingRule instead.
77
	# use C4::Circulation::GetIssuingRule instead.
78
	
78
	
79
	# subs to move to Members.pm
80
	push @EXPORT, qw(
81
        &CheckBorrowerDebarred
82
	);
83
	# subs to move to Biblio.pm
79
	# subs to move to Biblio.pm
84
	push @EXPORT, qw(
80
	push @EXPORT, qw(
85
        &GetItems
81
        &GetItems
Lines 1100-1134 sub GetOverduerules { Link Here
1100
}
1096
}
1101
1097
1102
1098
1103
=head2 CheckBorrowerDebarred
1104
1105
    ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
1106
1107
Check if the borrowers is already debarred
1108
1109
C<$debarredstatus> return 0 for not debarred and return 1 for debarred
1110
1111
C<$borrowernumber> contains the borrower number
1112
1113
=cut
1114
1115
# FIXME: Shouldn't this be in C4::Members?
1116
sub CheckBorrowerDebarred {
1117
    my ($borrowernumber) = @_;
1118
    my $dbh   = C4::Context->dbh;
1119
    my $query = qq|
1120
        SELECT debarred
1121
        FROM borrowers
1122
        WHERE borrowernumber=?
1123
        AND debarred > NOW()
1124
    |;
1125
    my $sth = $dbh->prepare($query);
1126
    $sth->execute($borrowernumber);
1127
    my $debarredstatus = $sth->fetchrow;
1128
    return $debarredstatus;
1129
}
1130
1131
1132
=head2 CheckExistantNotifyid
1099
=head2 CheckExistantNotifyid
1133
1100
1134
    ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
1101
    ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
(-)a/Koha/Borrower/Debarments.pm (+329 lines)
Line 0 Link Here
1
package Koha::Borrower::Debarments;
2
3
# Copyright 2013 ByWater Solutions
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along with
17
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18
# Suite 330, Boston, MA  02111-1307 USA
19
20
use Modern::Perl;
21
22
use C4::Context;
23
24
use parent qw( Exporter );
25
26
our @EXPORT = qw(
27
  GetDebarments
28
29
  AddDebarment
30
  DelDebarment
31
  ModDebarment
32
33
  AddUniqueDebarment
34
  DelUniqueDebarment
35
36
  IsDebarred
37
);
38
39
=head1 Koha::Borrower::Debarments
40
41
Koha::Borrower::Debarments - Module for managing borrower debarments
42
43
=cut
44
45
=head2 GetDebarments
46
47
my $arrayref = GetDebarments( $borrowernumber, { key => $value } );
48
49
=cut
50
51
sub GetDebarments {
52
    my ($params) = @_;
53
54
    return unless ( $params->{'borrowernumber'} );
55
56
    my @keys   = keys %$params;
57
    my @values = values %$params;
58
59
    my $where = join( ' AND ', map { "$_ = ?" } @keys );
60
    my $sql   = "SELECT * FROM borrower_debarments WHERE $where";
61
    my $sth   = C4::Context->dbh->prepare($sql);
62
    $sth->execute(@values);
63
64
    return $sth->fetchall_arrayref( {} );
65
}
66
67
=head2 AddDebarment
68
69
my $success = AddDebarment({
70
    borrowernumber => $borrowernumber,
71
    expiration     => $expiration,
72
    type           => $type, ## enum('FINES','OVERDUES','MANUAL')
73
    comment        => $comment,
74
});
75
76
Creates a new debarment.
77
78
Required keys: borrowernumber, type
79
80
=cut
81
82
sub AddDebarment {
83
    my ($params) = @_;
84
85
    my $borrowernumber = $params->{'borrowernumber'};
86
    my $expiration     = $params->{'expiration'} || undef;
87
    my $type           = $params->{'type'} || 'MANUAL';
88
    my $comment        = $params->{'comment'} || undef;
89
90
    return unless ( $borrowernumber && $type );
91
92
    my $manager_id;
93
    $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
94
95
    my $sql = "
96
        INSERT INTO borrower_debarments ( borrowernumber, expiration, type, comment, manager_id, created )
97
        VALUES ( ?, ?, ?, ?, ?, NOW() )
98
    ";
99
100
    my $r = C4::Context->dbh->do( $sql, {}, ( $borrowernumber, $expiration, $type, $comment, $manager_id ) );
101
102
    _UpdateBorrowerDebarmentFlags($borrowernumber);
103
104
    return $r;
105
}
106
107
=head2 DelDebarment
108
109
my $success = DelDebarment( $borrower_debarment_id );
110
111
Deletes a debarment.
112
113
=cut
114
115
sub DelDebarment {
116
    my ($id) = @_;
117
118
    my $borrowernumber = _GetBorrowernumberByDebarmentId($id);
119
120
    my $sql = "DELETE FROM borrower_debarments WHERE borrower_debarment_id = ?";
121
122
    my $r = C4::Context->dbh->do( $sql, {}, ($id) );
123
124
    _UpdateBorrowerDebarmentFlags($borrowernumber);
125
126
    return $r;
127
}
128
129
=head2 ModDebarment
130
131
my $success = ModDebarment({
132
    borrower_debarment_id => $borrower_debarment_id,
133
    expiration            => $expiration,
134
    type                  => $type, ## enum('FINES','OVERDUES','MANUAL')
135
    comment               => $comment,
136
});
137
138
Updates an existing debarment.
139
140
Required keys: borrower_debarment_id
141
142
=cut
143
144
sub ModDebarment {
145
    my ($params) = @_;
146
147
    my $borrower_debarment_id = $params->{'borrower_debarment_id'};
148
149
    return unless ($borrower_debarment_id);
150
151
    delete( $params->{'borrower_debarment_id'} );
152
153
    delete( $params->{'created'} );
154
    delete( $params->{'updated'} );
155
156
    $params->{'manager_id'} = C4::Context->userenv->{'number'} if C4::Context->userenv;
157
158
    my @keys   = keys %$params;
159
    my @values = values %$params;
160
161
    my $sql = join( ',', map { "$_ = ?" } @keys );
162
163
    $sql = "UPDATE borrower_debarments SET $sql, updated = NOW() WHERE borrower_debarment_id = ?";
164
165
    my $r = C4::Context->dbh->do( $sql, {}, ( @values, $borrower_debarment_id ) );
166
167
    _UpdateBorrowerDebarmentFlags( _GetBorrowernumberByDebarmentId($borrower_debarment_id) );
168
169
    return $r;
170
}
171
172
=head2 IsDebarred
173
174
my $debarment_expiration = IsDebarred( $borrowernumber );
175
176
Returns the date a borrowers debarment will expire, or
177
undef if the borrower is not debarred
178
179
=cut
180
181
sub IsDebarred {
182
    my ($borrowernumber) = @_;
183
184
    return unless ($borrowernumber);
185
186
    my $sql = "SELECT debarred FROM borrowers WHERE borrowernumber = ?";
187
    my $sth = C4::Context->dbh->prepare($sql);
188
    $sth->execute($borrowernumber);
189
    my ($debarred) = $sth->fetchrow_array();
190
191
    return $debarred;
192
}
193
194
=head2 AddUniqueDebarment
195
196
my $success = AddUniqueDebarment({
197
    borrowernumber => $borrowernumber,
198
    type           => $type,
199
    expiration     => $expiration,
200
    comment        => $comment,
201
});
202
203
Creates a new debarment of the type defined by the key type.
204
If a unique debarment already exists of the given type, it is updated instead.
205
The current unique debarment types are OVERDUES, and SUSPENSION
206
207
Required keys: borrowernumber, type
208
209
=cut
210
211
sub AddUniqueDebarment {
212
    my ($params) = @_;
213
214
    my $borrowernumber = $params->{'borrowernumber'};
215
    my $type           = $params->{'type'};
216
217
    return unless ( $borrowernumber && $type );
218
219
    my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
220
221
    my $r;
222
    if ($debarment) {
223
224
        # We don't want to shorten a unique debarment's period, so if this 'update' would do so, just keep the current expiration date instead
225
        $params->{'expiration'} = $debarment->{'expiration'} if ( $debarment->{'expiration'} && $debarment->{'expiration'} < $params->{'expiration'} );
226
227
        $params->{'borrower_debarment_id'} = $debarment->{'borrower_debarment_id'};
228
        $r = ModDebarment($params);
229
    } else {
230
        $r = AddDebarment($params);
231
    }
232
233
    _UpdateBorrowerDebarmentFlags($borrowernumber);
234
235
    return $r;
236
}
237
238
=head2 DelUniqueDebarment
239
240
my $success = _DelUniqueDebarment({
241
    borrowernumber => $borrowernumber,
242
    type           => $type,
243
});
244
245
Deletes a unique debarment of the type defined by the key type.
246
The current unique debarment types are OVERDUES, and SUSPENSION
247
248
Required keys: borrowernumber, type
249
250
=cut
251
252
sub DelUniqueDebarment {
253
    my ($params) = @_;
254
255
    my $borrowernumber = $params->{'borrowernumber'};
256
    my $type           = $params->{'type'};
257
258
    return unless ( $borrowernumber && $type );
259
260
    my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
261
262
    return unless ( $debarment );
263
264
    return DelDebarment( $debarment->{'borrower_debarment_id'} );
265
}
266
267
=head2 _UpdateBorrowerDebarmentFlags
268
269
my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );
270
271
So as not to create additional latency, the fields borrowers.debarred
272
and borrowers.debarredcomment remain in the borrowers table. Whenever
273
the a borrowers debarrments are modified, this subroutine is run to
274
decide if the borrower is currently debarred and update the 'quick flags'
275
in the borrowers table accordingly.
276
277
=cut
278
279
sub _UpdateBorrowerDebarmentFlags {
280
    my ($borrowernumber) = @_;
281
282
    return unless ($borrowernumber);
283
284
    my $dbh = C4::Context->dbh;
285
286
    my $sql = q{
287
        SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
288
        WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
289
    };
290
    my $sth = $dbh->prepare($sql);
291
    $sth->execute($borrowernumber);
292
    my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
293
294
    if ($count) {
295
        $expiration = "9999-12-31" if ($indefinite_expiration);
296
    } else {
297
        $expiration = undef;
298
        $comment    = undef;
299
    }
300
301
    return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
302
}
303
304
=head2 _GetBorrowernumberByDebarmentId
305
306
my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
307
308
=cut
309
310
sub _GetBorrowernumberByDebarmentId {
311
    my ($borrower_debarment_id) = @_;
312
313
    return unless ($borrower_debarment_id);
314
315
    my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
316
    my $sth = C4::Context->dbh->prepare($sql);
317
    $sth->execute($borrower_debarment_id);
318
    my ($borrowernumber) = $sth->fetchrow_array();
319
320
    return $borrowernumber;
321
}
322
323
1;
324
325
=head2 AUTHOR
326
327
Kyle M Hall <kyle@bywatersoltuions.com>
328
329
=cut
(-)a/circ/circulation.pl (-9 / +9 lines)
Lines 31-43 use C4::Dates qw/format_date/; Link Here
31
use C4::Branch; # GetBranches
31
use C4::Branch; # GetBranches
32
use C4::Koha;   # GetPrinter
32
use C4::Koha;   # GetPrinter
33
use C4::Circulation;
33
use C4::Circulation;
34
use C4::Overdues qw/CheckBorrowerDebarred/;
35
use C4::Members;
34
use C4::Members;
36
use C4::Biblio;
35
use C4::Biblio;
37
use C4::Reserves;
36
use C4::Reserves;
38
use C4::Context;
37
use C4::Context;
39
use CGI::Session;
38
use CGI::Session;
40
use C4::Members::Attributes qw(GetBorrowerAttributes);
39
use C4::Members::Attributes qw(GetBorrowerAttributes);
40
use Koha::Borrower::Debarments qw(GetDebarments);
41
use Koha::DateUtils;
41
use Koha::DateUtils;
42
42
43
use Date::Calc qw(
43
use Date::Calc qw(
Lines 263-275 if ($borrowernumber) { Link Here
263
        finetotal    => $fines
263
        finetotal    => $fines
264
    );
264
    );
265
265
266
    my $debar = CheckBorrowerDebarred($borrowernumber);
266
    $template->param(
267
    if ($debar) {
267
        'userdebarred'    => $borrower->{debarred},
268
        $template->param( 'userdebarred'    => 1 );
268
        'debarredcomment' => $borrower->{debarredcomment},
269
        $template->param( 'debarredcomment' => $borrower->{debarredcomment} );
269
    );
270
        if ( $debar ne "9999-12-31" ) {
270
    if ( $borrower->{debarred} ne "9999-12-31" ) {
271
            $template->param( 'userdebarreddate' => C4::Dates::format_date($debar) );
271
        $template->param( 'userdebarreddate' => C4::Dates::format_date( $borrower->{debarred} ) );
272
        }
273
    }
272
    }
274
273
275
}
274
}
Lines 736-745 $template->param( Link Here
736
    debt_confirmed            => $debt_confirmed,
735
    debt_confirmed            => $debt_confirmed,
737
    SpecifyDueDate            => $duedatespec_allow,
736
    SpecifyDueDate            => $duedatespec_allow,
738
    CircAutocompl             => C4::Context->preference("CircAutocompl"),
737
    CircAutocompl             => C4::Context->preference("CircAutocompl"),
739
	AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"),
738
    AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"),
740
    export_remove_fields      => C4::Context->preference("ExportRemoveFields"),
739
    export_remove_fields      => C4::Context->preference("ExportRemoveFields"),
741
    export_with_csv_profile   => C4::Context->preference("ExportWithCsvProfile"),
740
    export_with_csv_profile   => C4::Context->preference("ExportWithCsvProfile"),
742
    canned_bor_notes_loop     => $canned_notes,
741
    canned_bor_notes_loop     => $canned_notes,
742
    debarments                => GetDebarments({ borrowernumber => $borrowernumber }),
743
);
743
);
744
744
745
output_html_with_http_headers $query, $cookie, $template->output;
745
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 420-422 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES(' Link Here
420
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('UNIMARCAuthorsFacetsSeparator',', ', 'UNIMARC authors facets separator', NULL, 'short');
420
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('UNIMARCAuthorsFacetsSeparator',', ', 'UNIMARC authors facets separator', NULL, 'short');
421
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('UseKohaPlugins','1','Enable or disable the ability to use Koha Plugins.','','YesNo');
421
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('UseKohaPlugins','1','Enable or disable the ability to use Koha Plugins.','','YesNo');
422
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('TimeFormat','24hr','12hr|24hr','Defines the global time format for visual output.','Choice');
422
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('TimeFormat','24hr','12hr|24hr','Defines the global time format for visual output.','Choice');
423
INSERT IGNORE INTO systempreferences (variable,value,explanation,type) VALUES ('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo');
(-)a/installer/data/mysql/updatedatabase.pl (+30 lines)
Lines 6661-6666 if ( CheckVersion($DBversion) ) { Link Here
6661
   SetVersion ($DBversion);
6661
   SetVersion ($DBversion);
6662
}
6662
}
6663
6663
6664
$DBversion ="3.11.00.XXX";
6665
if ( CheckVersion($DBversion) ) {
6666
    $dbh->do(q{
6667
CREATE TABLE borrower_debarments (
6668
  borrower_debarment_id int(11) NOT NULL AUTO_INCREMENT,
6669
  borrowernumber int(11) NOT NULL,
6670
  expiration date DEFAULT NULL,
6671
  `type` enum('SUSPENSION','OVERDUES','MANUAL') NOT NULL DEFAULT 'MANUAL',
6672
  `comment` text,
6673
  manager_id int(11) DEFAULT NULL,
6674
  created timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
6675
  updated timestamp NULL DEFAULT NULL,
6676
  PRIMARY KEY (borrower_debarment_id),
6677
  KEY borrowernumber (borrowernumber)
6678
) ENGINE=InnoDB  DEFAULT CHARSET=utf8;
6679
    });
6680
    
6681
    $dbh->do(q{
6682
INSERT INTO borrower_debarments ( borrowernumber, expiration, comment ) SELECT borrowernumber, debarred, debarredcomment FROM borrowers WHERE debarred IS NOT NULL
6683
    });
6684
6685
    $dbh->do(q{
6686
INSERT IGNORE INTO systempreferences (variable,value,explanation,type) VALUES 
6687
('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo')
6688
    });
6689
    
6690
    print "Upgrade to $DBversion done (Bug 2720 - Overdues which debar automatically should undebar automatically when returned)\n";
6691
    SetVersion($DBversion);
6692
}
6693
6664
6694
6665
=head1 FUNCTIONS
6695
=head1 FUNCTIONS
6666
6696
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc (+54 lines)
Line 0 Link Here
1
<div id="reldebarments">
2
    [% UNLESS debarments %]<p>Patron is currently unrestricted.</p>[% END %]
3
4
    <table>
5
        <thead>
6
            <tr>
7
                 <th>Type</th>
8
                 <th>Comment</th>
9
                 <th>Expiration</th>
10
                 [% IF ( CAN_user_borrowers ) %]
11
                     <th>&nbsp;</th>
12
                 [% END %]
13
            </tr>
14
        </thead>
15
16
        <tbody>
17
            [% FOREACH d IN debarments %]
18
                <tr>
19
                    <td>[% d.type %]</td>
20
                    <td>[% d.comment %]</td>
21
                    <td>[% IF d.expiration %] [% d.expiration | $KohaDates %] [% ELSE %] <i>Indefinite</i> [% END %]</td>
22
                    [% IF ( CAN_user_borrowers )%]
23
                        <td>
24
                            <a href="/cgi-bin/koha/members/mod_debarment.pl?borrowernumber=[% borrowernumber %]&borrower_debarment_id=[% d.borrower_debarment_id %]&action=del" onclick="return confirm(_('Remove debarment?'))">
25
                                <img src="/intranet-tmpl/[% theme %]/img/x.png" border="0" alt="Remove debarment" />
26
                            </a>
27
                        </td>
28
                    [% END %]
29
                </tr>
30
            [% END %]
31
        </tbody>
32
33
        [% IF ( CAN_user_borrowers )%]
34
            <form method="post" action="/cgi-bin/koha/members/mod_debarment.pl">
35
                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
36
                <input type="hidden" name="action" value="add" />
37
38
                <tfoot>
39
                    <tr>
40
                        <td>MANUAL</td>
41
                        <td><input type="text" name="comment" /></td>
42
                        <td>
43
                            <input name="expiration" id="expiration" size="10" readonly="readonly" value="" class="datepicker" />
44
                            <a href='#' onclick="document.getElementById('expiration').value='';">Clear Date</a>
45
                        </td>
46
                        <td>
47
                            <input type="submit" value="Add restriction" />
48
                        </td>
49
                    </tr>
50
                </tfoot>
51
            </form>
52
        [% END %]
53
    </table>
54
</div>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref (+6 lines)
Lines 126-131 Circulation: Link Here
126
126
127
    Checkout Policy:
127
    Checkout Policy:
128
        -
128
        -
129
            - pref: AutoRemoveOverduesRestrictions
130
              choices:
131
                  yes: "Do"
132
                  no: "Do not"
133
            - allow OVERDUES restrictions triggered by sent notices to be cleared automatically when all overdue items are returned by a patron.
134
        -
129
            - pref: AllowNotForLoanOverride
135
            - pref: AllowNotForLoanOverride
130
              choices:
136
              choices:
131
                  yes: Allow
137
                  yes: Allow
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt (-8 / +6 lines)
Lines 658-671 No patron matched <span class="ex">[% message %]</span> Link Here
658
658
659
            [% IF ( userdebarred ) %]
659
            [% IF ( userdebarred ) %]
660
               <li class="blocker">
660
               <li class="blocker">
661
               <span class="circ-hlt"> Restricted:</span> Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %]
661
                   <span class="circ-hlt"> Restricted:</span> Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %]
662
               <form class="inline compact" action="/cgi-bin/koha/members/setstatus.pl" method="post">
662
                   <a href="#reldebarments" onclick="$('#debarments-tab-link').click()">View restrictions</a>
663
	                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
663
               </li>
664
	                <input type="hidden" name="destination" value="circ" />
664
            [% END %]
665
	                <input type="hidden" name="cardnumber" value="[% cardnumber %]" />
666
	                <input type="submit" value="Lift restriction" />
667
               </form>
668
			</li>[% END %]
669
665
670
        	[% IF ( odues ) %]<li>[% IF ( nonreturns ) %]<span class="circ-hlt">Overdues:</span> Patron has <span class="circ-hlt">ITEMS OVERDUE</span>. See highlighted items <a href="#checkouts">below</a>[% END %]</li>
666
        	[% IF ( odues ) %]<li>[% IF ( nonreturns ) %]<span class="circ-hlt">Overdues:</span> Patron has <span class="circ-hlt">ITEMS OVERDUE</span>. See highlighted items <a href="#checkouts">below</a>[% END %]</li>
671
            [% END %]
667
            [% END %]
Lines 765-770 No patron matched <span class="ex">[% message %]</span> Link Here
765
    [% ELSE %]
761
    [% ELSE %]
766
            <a href="#reserves">0 Holds</a>
762
            <a href="#reserves">0 Holds</a>
767
    [% END %]</li>
763
    [% END %]</li>
764
    <li><a id="debarments-tab-link" href="#reldebarments">[% debarments.size %] Restrictions</a></li>
768
765
769
</ul>
766
</ul>
770
767
Lines 1054-1059 No patron matched <span class="ex">[% message %]</span> Link Here
1054
</div>
1051
</div>
1055
[% END %]<!-- end displayrelissues -->
1052
[% END %]<!-- end displayrelissues -->
1056
1053
1054
[% INCLUDE borrower_debarments.inc %]
1057
1055
1058
<div id="reserves">
1056
<div id="reserves">
1059
[% IF ( reservloop ) %]
1057
[% IF ( reservloop ) %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt (-31 lines)
Lines 1277-1283 Link Here
1277
			[% FOREACH flagloo IN flagloop %]
1277
			[% FOREACH flagloo IN flagloop %]
1278
				<li><label class="radio" for="yes[% flagloo.name %]">
1278
				<li><label class="radio" for="yes[% flagloo.name %]">
1279
                [% IF ( flagloo.key == 'gonenoaddress' ) %]Gone no address:[% END %]
1279
                [% IF ( flagloo.key == 'gonenoaddress' ) %]Gone no address:[% END %]
1280
				[% IF ( flagloo.key == 'debarred' ) %]Restricted:[% END %]
1281
                [% IF ( flagloo.key == 'lost' ) %]Lost card:[% END %]
1280
                [% IF ( flagloo.key == 'lost' ) %]Lost card:[% END %]
1282
                </label>
1281
                </label>
1283
				<label for="yes[% flagloo.name %]">Yes </label>
1282
				<label for="yes[% flagloo.name %]">Yes </label>
Lines 1295-1330 Link Here
1295
1294
1296
            </li>
1295
            </li>
1297
			[% END %]
1296
			[% END %]
1298
			<li>
1299
				<label for="yesdebarred" class="radio">Restricted: </label>
1300
				[% IF ( debarred ) %]
1301
				<label for="yesdebarred">Yes </label>
1302
				<input type="radio" id="yesdebarred" name="debarred" value="1" checked="checked"/>
1303
                <label for="nodebarred">No </label>
1304
                <input type="radio" id="nodebarred" name="debarred" value="0"/>
1305
				[% ELSE %]
1306
				<label for="yesdebarred">Yes </label>
1307
				<input type="radio" id="yesdebarred" name="debarred" value="1" />
1308
                <label for="nodebarred">No </label>
1309
                <input type="radio" id="nodebarred" name="debarred" value="0" checked="checked"/>
1310
				[% END %]
1311
1312
                <span id="debarreduntil"><label for="datedebarred" class="inline">Until:</label>
1313
                                [% IF opduplicate %]
1314
                                    <input type="text" name="datedebarred" id="datedebarred" class="debarred datepicker" value="[% datedebarred %]" onclick="this.value=''" />
1315
                                [% ELSE %]
1316
                                    <input type="text" name="datedebarred" id="datedebarred" class="debarred datepicker" value="[% datedebarred %]" />
1317
                                [% END %]
1318
                <span class="hint">(optional)</span> </span>
1319
                </li>
1320
                <li>
1321
		        <label for="debarredcomment" class="radio">Comment:</label>
1322
			       [% IF ( opduplicate ) %] 
1323
			           <textarea id="debarredcomment" name="debarredcomment" cols="55" rows="3" onclick="this.value=''">[% debarredcomment %]</textarea>
1324
			       [% ELSE %]
1325
				   <textarea id="debarredcomment" name="debarredcomment" cols="55" rows="3">[% debarredcomment %]</textarea>
1326
			       [% END %]
1327
	        </li>
1328
1297
1329
			</ol>
1298
			</ol>
1330
			</fieldset>
1299
			</fieldset>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt (-4 / +4 lines)
Lines 188-197 function validate1(date) { Link Here
188
        <ul>
188
        <ul>
189
        [% IF ( userdebarred ) %]
189
        [% IF ( userdebarred ) %]
190
            <li class="blocker">Patron is restricted[% IF ( userdebarreddate ) %] until [% userdebarreddate%] [% IF (debarredcomment ) %]([% debarredcomment %])[% END %][% END %]
190
            <li class="blocker">Patron is restricted[% IF ( userdebarreddate ) %] until [% userdebarreddate%] [% IF (debarredcomment ) %]([% debarredcomment %])[% END %][% END %]
191
            <form class="inline compact" action="/cgi-bin/koha/members/setdebar.pl" method="post">
191
            <a href="#reldebarments" onclick="$('#debarments-tab-link').click()">View restrictions</a>
192
                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
193
                <input type="submit" value="Lift restriction" />
194
            </form>
195
            </li>
192
            </li>
196
        [% END %]
193
        [% END %]
197
        [% IF ( gonenoaddress ) %]<li class="blocker">Patron's address is in doubt.</li>[% END %]
194
        [% IF ( gonenoaddress ) %]<li class="blocker">Patron's address is in doubt.</li>[% END %]
Lines 433-438 function validate1(date) { Link Here
433
            <a href="#onhold">[% countreserv %] Hold(s)</a>    [% ELSE %]
430
            <a href="#onhold">[% countreserv %] Hold(s)</a>    [% ELSE %]
434
            <a href="#onhold">0 Holds</a>
431
            <a href="#onhold">0 Holds</a>
435
    [% END %]</li>
432
    [% END %]</li>
433
        <li><a id="debarments-tab-link" href="#reldebarments">[% debarments.size %] Restrictions</a></li>
436
    </ul>
434
    </ul>
437
435
438
    <form action="/cgi-bin/koha/reserve/renewscript.pl" method="post" class="checkboxed">
436
    <form action="/cgi-bin/koha/reserve/renewscript.pl" method="post" class="checkboxed">
Lines 608-613 function validate1(date) { Link Here
608
    [% END %]
606
    [% END %]
609
</div>
607
</div>
610
608
609
[% INCLUDE borrower_debarments.inc %]
610
611
<div id="onhold">
611
<div id="onhold">
612
[% IF ( reservloop ) %]
612
[% IF ( reservloop ) %]
613
<form action="/cgi-bin/koha/reserve/modrequest.pl" method="post">
613
<form action="/cgi-bin/koha/reserve/modrequest.pl" method="post">
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/modborrowers.tt (-6 lines)
Lines 210-216 Link Here
210
                                                <th>Category</th>
210
                                                <th>Category</th>
211
                                                <th>Registration date</th>
211
                                                <th>Registration date</th>
212
                                                <th>Expiry date</th>
212
                                                <th>Expiry date</th>
213
                                                <th>Restricted</th>
214
                                                [% FOREACH attrh IN attributes_header %]
213
                                                [% FOREACH attrh IN attributes_header %]
215
                                                    <th>[% attrh.attribute %]</th>
214
                                                    <th>[% attrh.attribute %]</th>
216
                                                [% END %]
215
                                                [% END %]
Lines 229-235 Link Here
229
                                                    <td>[% borrower.categorycode %]</td>
228
                                                    <td>[% borrower.categorycode %]</td>
230
                                                    <td>[% borrower.dateenrolled | $KohaDates %]</td>
229
                                                    <td>[% borrower.dateenrolled | $KohaDates %]</td>
231
                                                    <td>[% borrower.dateexpiry | $KohaDates %]</td>
230
                                                    <td>[% borrower.dateexpiry | $KohaDates %]</td>
232
                                                    <td>[% borrower.debarred | $KohaDates %]</td>
233
                                                    [% FOREACH pa IN borrower.patron_attributes %]
231
                                                    [% FOREACH pa IN borrower.patron_attributes %]
234
                                                        [% IF ( pa.code ) %]
232
                                                        [% IF ( pa.code ) %]
235
                                                            <td>[% pa.code %]=[% pa.value %]</td>
233
                                                            <td>[% pa.code %]=[% pa.value %]</td>
Lines 274-283 Link Here
274
                                                Registration date:
272
                                                Registration date:
275
                                                [% CASE 'dateexpiry' %]
273
                                                [% CASE 'dateexpiry' %]
276
                                                Expiry date:
274
                                                Expiry date:
277
                                                [% CASE 'debarred' %]
278
                                                Restricted:
279
                                                [% CASE 'debarredcomment' %]
280
                                                Restriction comment:
281
                                                [% CASE 'borrowernotes' %]
275
                                                [% CASE 'borrowernotes' %]
282
                                                Circulation note:
276
                                                Circulation note:
283
                                            [% END %]
277
                                            [% END %]
(-)a/members/memberentry.pl (-13 / +1 lines)
Lines 142-157 if ( $op eq 'insert' || $op eq 'modify' || $op eq 'save' || $op eq 'duplicate' ) Link Here
142
        }
142
        }
143
    }
143
    }
144
144
145
    ## Manipulate debarred
146
    if ( $newdata{debarred} ) {
147
        $newdata{debarred} = $newdata{datedebarred} ? $newdata{datedebarred} : "9999-12-31";
148
    } elsif ( exists( $newdata{debarred} ) && !( $newdata{debarred} ) ) {
149
        undef( $newdata{debarred} );
150
        undef( $newdata{debarredcomment} );
151
    } elsif ( exists( $newdata{debarredcomment} ) && $newdata{debarredcomment} eq "" ) {
152
        undef( $newdata{debarredcomment} );
153
    }
154
    
155
    my $dateobject = C4::Dates->new();
145
    my $dateobject = C4::Dates->new();
156
    my $syspref = $dateobject->regexp();		# same syspref format for all 3 dates
146
    my $syspref = $dateobject->regexp();		# same syspref format for all 3 dates
157
    my $iso     = $dateobject->regexp('iso');	#
147
    my $iso     = $dateobject->regexp('iso');	#
Lines 650-658 if (C4::Context->preference('uppercasesurnames')) { Link Here
650
	$data{'contactname'}=uc($data{'contactname'});
640
	$data{'contactname'}=uc($data{'contactname'});
651
}
641
}
652
642
653
$data{debarred} = C4::Overdues::CheckBorrowerDebarred($borrowernumber);
643
foreach (qw(dateenrolled dateexpiry dateofbirth)) {
654
$data{datedebarred} = $data{debarred} if ( $data{debarred} && $data{debarred} ne "9999-12-31" );
655
foreach (qw(dateenrolled dateexpiry dateofbirth datedebarred)) {
656
	$data{$_} = format_date($data{$_});	# back to syspref for display
644
	$data{$_} = format_date($data{$_});	# back to syspref for display
657
	$template->param( $_ => $data{$_});
645
	$template->param( $_ => $data{$_});
658
}
646
}
(-)a/members/mod_debarment.pl (+63 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2013 ByWater Solutions
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use CGI;
23
24
use C4::Auth;
25
use Koha::DateUtils;
26
use Koha::Borrower::Debarments;
27
28
my $cgi = new CGI;
29
30
my ( $loggedinuser, $cookie, $sessionID ) = checkauth( $cgi, 0, { borrowers => 1 } );
31
32
my $borrowernumber = $cgi->param('borrowernumber');
33
my $action         = $cgi->param('action');
34
35
if ( $action eq 'del' ) {
36
    DelDebarment( $cgi->param('borrower_debarment_id') );
37
} elsif ( $action eq 'add' ) {
38
    my $expiration = $cgi->param('expiration');
39
    if ($expiration) {
40
        $expiration = dt_from_string($expiration);
41
        $expiration = $expiration->ymd();
42
    }
43
44
    AddDebarment(
45
        {   borrowernumber => $borrowernumber,
46
            type           => 'MANUAL',
47
            comment        => $cgi->param('comment'),
48
            expiration     => $expiration,
49
        }
50
    );
51
}
52
53
if ( $ENV{HTTP_REFERER} =~ /moremember/ ) {
54
    print $cgi->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
55
} else {
56
    print $cgi->redirect("/cgi-bin/koha/circ/circulation.pl?borrowernumber=$borrowernumber");
57
}
58
59
=head2 author
60
61
Kyle M Hall <kyle@bywatersolutions.com>
62
63
=cut
(-)a/members/moremember.pl (-3 / +3 lines)
Lines 48-58 use C4::Koha; Link Here
48
use C4::Letters;
48
use C4::Letters;
49
use C4::Biblio;
49
use C4::Biblio;
50
use C4::Branch; # GetBranchName
50
use C4::Branch; # GetBranchName
51
use C4::Overdues qw/CheckBorrowerDebarred/;
52
use C4::Form::MessagingPreferences;
51
use C4::Form::MessagingPreferences;
53
use List::MoreUtils qw/uniq/;
52
use List::MoreUtils qw/uniq/;
54
use C4::Members::Attributes qw(GetBorrowerAttributes);
53
use C4::Members::Attributes qw(GetBorrowerAttributes);
55
54
use Koha::Borrower::Debarments qw(GetDebarments);
56
#use Smart::Comments;
55
#use Smart::Comments;
57
#use Data::Dumper;
56
#use Data::Dumper;
58
use DateTime;
57
use DateTime;
Lines 153-159 for (qw(gonenoaddress lost borrowernotes)) { Link Here
153
	 $data->{$_} and $template->param(flagged => 1) and last;
152
	 $data->{$_} and $template->param(flagged => 1) and last;
154
}
153
}
155
154
156
my $debar = CheckBorrowerDebarred($borrowernumber);
155
my $debar = $data->{'debarred'};
157
if ($debar) {
156
if ($debar) {
158
    $template->param( 'userdebarred' => 1, 'flagged' => 1 );
157
    $template->param( 'userdebarred' => 1, 'flagged' => 1 );
159
    if ( $debar ne "9999-12-31" ) {
158
    if ( $debar ne "9999-12-31" ) {
Lines 430-435 $template->param( Link Here
430
    activeBorrowerRelationship => (C4::Context->preference('borrowerRelationship') ne ''),
429
    activeBorrowerRelationship => (C4::Context->preference('borrowerRelationship') ne ''),
431
    AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'),
430
    AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'),
432
    SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'),
431
    SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'),
432
    debarments => GetDebarments({ borrowernumber => $borrowernumber }),
433
);
433
);
434
$template->param( $error => 1 ) if $error;
434
$template->param( $error => 1 ) if $error;
435
435
(-)a/members/setdebar.pl (-53 lines)
Lines 1-53 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2000-2002 Katipo Communications
4
# Parts copyright 2011 BibLibre
5
#
6
# This file is part of Koha.
7
#
8
# Koha is free software; you can redistribute it and/or modify it under the
9
# terms of the GNU General Public License as published by the Free Software
10
# Foundation; either version 2 of the License, or (at your option) any later
11
# version.
12
#
13
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License along
18
# with Koha; if not, write to the Free Software Foundation, Inc.,
19
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21
22
=head1 setdebar.pl
23
24
script to set or lift debarred status
25
written 2/8/04
26
by oleonard@athenscounty.lib.oh.us
27
28
=cut
29
30
use strict;
31
use warnings;
32
33
use CGI;
34
use C4::Context;
35
use C4::Auth;
36
37
my $input = new CGI;
38
39
my $flagsrequired;
40
$flagsrequired->{borrowers} = 1;
41
my ( $loggedinuser, $cookie, $sessionID ) =
42
  checkauth( $input, 0, $flagsrequired );
43
44
my $borrowernumber = $input->param('borrowernumber');
45
46
my $dbh = C4::Context->dbh;
47
my $sth =
48
  $dbh->prepare("Update borrowers set debarred = NULL where borrowernumber = ?");
49
$sth->execute( $borrowernumber );
50
$sth->finish;
51
52
print $input->redirect(
53
    "/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
(-)a/misc/cronjobs/overdue_notices.pl (-1 / +5 lines)
Lines 40-45 use C4::Dates qw/format_date/; Link Here
40
use C4::Debug;
40
use C4::Debug;
41
use C4::Letters;
41
use C4::Letters;
42
use C4::Overdues qw(GetFine);
42
use C4::Overdues qw(GetFine);
43
use Koha::Borrower::Debarments qw(AddUniqueDebarment);
43
44
44
=head1 NAME
45
=head1 NAME
45
46
Lines 514-520 END_SQL Link Here
514
                if ( $overdue_rules->{"debarred$i"} ) {
515
                if ( $overdue_rules->{"debarred$i"} ) {
515
    
516
    
516
                    #action taken is debarring
517
                    #action taken is debarring
517
                    C4::Members::DebarMember($borrowernumber, '9999-12-31');
518
                    AddUniqueDebarment({
519
                        borrowernumber => $borrowernumber,
520
                        type => 'OVERDUES',
521
                    });
518
                    $verbose and warn "debarring $borr\n";
522
                    $verbose and warn "debarring $borr\n";
519
                }
523
                }
520
                my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
524
                my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
(-)a/opac/opac-reserve.pl (-1 / +1 lines)
Lines 307-313 if ( $borr->{lost} && ($borr->{lost} == 1) ) { Link Here
307
                     lost    => 1
307
                     lost    => 1
308
                    );
308
                    );
309
}
309
}
310
if ( CheckBorrowerDebarred($borrowernumber) ) {
310
if ( $borr->{'debarred'} ) {
311
    $noreserves = 1;
311
    $noreserves = 1;
312
    $template->param(
312
    $template->param(
313
                     message  => 1,
313
                     message  => 1,
(-)a/opac/opac-user.pl (-2 / +1 lines)
Lines 30-36 use C4::Members; Link Here
30
use C4::Members::AttributeTypes;
30
use C4::Members::AttributeTypes;
31
use C4::Members::Attributes qw/GetBorrowerAttributeValue/;
31
use C4::Members::Attributes qw/GetBorrowerAttributeValue/;
32
use C4::Output;
32
use C4::Output;
33
use C4::Overdues qw/CheckBorrowerDebarred/;
34
use C4::Biblio;
33
use C4::Biblio;
35
use C4::Items;
34
use C4::Items;
36
use C4::Letters;
35
use C4::Letters;
Lines 80-86 my ($warning_year, $warning_month, $warning_day) = split /-/, $borr->{'dateexpir Link Here
80
79
81
$borr->{'ethnicity'} = fixEthnicity( $borr->{'ethnicity'} );
80
$borr->{'ethnicity'} = fixEthnicity( $borr->{'ethnicity'} );
82
81
83
my $debar = CheckBorrowerDebarred($borrowernumber);
82
my $debar = $borr->{'debarred'};
84
my $userdebarred;
83
my $userdebarred;
85
84
86
if ($debar) {
85
if ($debar) {
(-)a/t/db_dependent/Borrower_Debarments.t (+102 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
use strict;
4
use warnings;
5
6
use C4::Context;
7
use C4::Members;
8
9
use Test::More tests => 18;
10
11
BEGIN {
12
    use FindBin;
13
    use lib $FindBin::Bin;
14
    use_ok('Koha::Borrower::Debarments');
15
}
16
17
# Get a borrower with no current debarments
18
my $dbh   = C4::Context->dbh;
19
my $query = "
20
    SELECT b.borrowernumber FROM borrowers b
21
    LEFT JOIN borrower_debarments bd ON ( b.borrowernumber = bd.borrowernumber )
22
    WHERE b.debarred IS NULL AND b.debarredcomment IS NULL AND bd.borrowernumber IS NULL
23
    LIMIT 1
24
";
25
my $sth = $dbh->prepare($query);
26
$sth->execute;
27
my ($borrowernumber) = $sth->fetchrow_array();
28
diag("Using borrowernumber: $borrowernumber");
29
30
31
my $success = AddDebarment({
32
    borrowernumber => $borrowernumber,
33
    expiration => '9999-06-10',
34
    type => 'MANUAL',
35
    comment => 'Test 1',
36
});
37
ok( $success, "AddDebarment returned true" );
38
39
40
my $debarments = GetDebarments({ borrowernumber => $borrowernumber });
41
ok( @$debarments == 1, "GetDebarments returns 1 debarment" );
42
ok( $debarments->[0]->{'type'} eq 'MANUAL', "Correctly stored 'type'" );
43
ok( $debarments->[0]->{'expiration'} eq '9999-06-10', "Correctly stored 'expiration'" );
44
ok( $debarments->[0]->{'comment'} eq 'Test 1', "Correctly stored 'comment'" );
45
46
47
$success = AddDebarment({
48
    borrowernumber => $borrowernumber,
49
    comment => 'Test 2',
50
});
51
52
$debarments = GetDebarments({ borrowernumber => $borrowernumber });
53
ok( @$debarments == 2, "GetDebarments returns 2 debarments" );
54
ok( $debarments->[1]->{'type'} eq 'MANUAL', "Correctly stored 'type'" );
55
ok( !$debarments->[1]->{'expiration'}, "Correctly stored debarrment with no expiration" );
56
ok( $debarments->[1]->{'comment'} eq 'Test 2', "Correctly stored 'comment'" );
57
58
59
ModDebarment({
60
    borrower_debarment_id => $debarments->[1]->{'borrower_debarment_id'},
61
    comment => 'Test 3',
62
    expiration => '9998-06-10',
63
});
64
$debarments = GetDebarments({ borrowernumber => $borrowernumber });
65
ok( $debarments->[1]->{'comment'} eq 'Test 3', "ModDebarment functions correctly" );
66
67
68
my $borrower = GetMember( borrowernumber => $borrowernumber );
69
ok( $borrower->{'debarred'} eq '9999-06-10', "Field borrowers.debarred set correctly" );
70
ok( $borrower->{'debarredcomment'} eq "Test 1\nTest 3", "Field borrowers.debarredcomment set correctly" );
71
72
73
AddUniqueDebarment({
74
    borrowernumber => $borrowernumber,
75
    type           => 'OVERDUES'
76
});
77
$debarments = GetDebarments({
78
    borrowernumber => $borrowernumber,
79
    type => 'OVERDUES',
80
});
81
ok( @$debarments == 1, "GetDebarments returns 1 OVERDUES debarment" );
82
ok( $debarments->[0]->{'type'} eq 'OVERDUES', "AddOverduesDebarment created new debarment correctly" );
83
84
AddUniqueDebarment({
85
    borrowernumber => $borrowernumber,
86
    expiration => '9999-11-09',
87
    type => 'OVERDUES'
88
});
89
$debarments = GetDebarments({
90
    borrowernumber => $borrowernumber,
91
    type => 'OVERDUES',
92
});
93
ok( @$debarments == 1, "GetDebarments returns 1 OVERDUES debarment after running AddOverduesDebarment twice" );
94
ok( $debarments->[0]->{'expiration'} eq '9999-11-09', "AddOverduesDebarment updated OVERDUES debarment correctly" );
95
96
97
$debarments = GetDebarments({ borrowernumber => $borrowernumber });
98
foreach my $d ( @$debarments ) {
99
    DelDebarment( $d->{'borrower_debarment_id'} );
100
}
101
$debarments = GetDebarments({ borrowernumber => $borrowernumber });
102
ok( @$debarments == 0, "DelDebarment functions correctly" )
(-)a/t/db_dependent/lib/KohaTest/Members/DebarMember.pm (-44 lines)
Lines 1-44 Link Here
1
package KohaTest::Members::DebarMember;
2
use base qw( KohaTest::Members );
3
4
use strict;
5
use warnings;
6
7
use Test::More;
8
9
use C4::Members;
10
sub testing_class { 'C4::Members' };
11
12
13
sub simple_usage : Test( 6 ) {
14
    my $self = shift;
15
16
    ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
17
18
    my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
19
    ok(     exists $details->{'flags'},                  'member details has a "flags" attribute');
20
    isa_ok( $details->{'flags'},                 'HASH', 'the "flags" attribute is a hashref');
21
    ok(     ! $details->{'flags'}->{'DBARRED'},          'this member is NOT debarred' );
22
23
    # Now, let's debar this member and see what happens
24
    my $success = C4::Members::DebarMember( $self->{'memberid'}, '2099-12-31' );
25
26
    ok( $success, 'we were able to debar the member' );
27
    
28
    $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
29
    ok( $details->{'flags'}->{'DBARRED'},         'this member is debarred now' )
30
      or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) );
31
}
32
33
sub incorrect_usage : Test( 2 ) {
34
    my $self = shift;
35
36
    my $result = C4::Members::DebarMember();
37
    ok( ! defined $result, 'DebarMember returns undef when passed no parameters' );
38
39
    $result = C4::Members::DebarMember( 'this is not a borrowernumber' );
40
    ok( ! defined $result, 'DebarMember returns undef when not passed a numeric argument' );
41
42
}
43
44
1;
(-)a/t/db_dependent/lib/KohaTest/Overdues.pm (-1 lines)
Lines 33-39 sub methods : Test( 1 ) { Link Here
33
                       GetOverdueDelays 
33
                       GetOverdueDelays 
34
                       CheckAccountLineLevelInfo 
34
                       CheckAccountLineLevelInfo 
35
                       GetOverduerules
35
                       GetOverduerules
36
                       CheckBorrowerDebarred
37
                       CheckExistantNotifyid 
36
                       CheckExistantNotifyid 
38
                       CheckAccountLineItemInfo 
37
                       CheckAccountLineItemInfo 
39
                       CheckItemNotify 
38
                       CheckItemNotify 
(-)a/tools/modborrowers.pl (-16 / +3 lines)
Lines 21-27 Link Here
21
#
21
#
22
# Batch Edit Patrons
22
# Batch Edit Patrons
23
# Modification for patron's fields:
23
# Modification for patron's fields:
24
# surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry debarred debarredcomment borrowernotes
24
# surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry borrowernotes
25
# And for patron attributes.
25
# And for patron attributes.
26
26
27
use Modern::Perl;
27
use Modern::Perl;
Lines 206-223 if ( $op eq 'show' ) { Link Here
206
        }
206
        }
207
        ,
207
        ,
208
        {
208
        {
209
            name => "debarred",
210
            type => "date",
211
            mandatory => ( grep /debarred/, @mandatoryFields ) ? 1 : 0,
212
        }
213
        ,
214
        {
215
            name => "debarredcomment",
216
            type => "text",
217
            mandatory => ( grep /debarredcomment/, @mandatoryFields ) ? 1 : 0,
218
        }
219
        ,
220
        {
221
            name => "borrowernotes",
209
            name => "borrowernotes",
222
            type => "text",
210
            type => "text",
223
            mandatory => ( grep /borrowernotes/, @mandatoryFields ) ? 1 : 0,
211
            mandatory => ( grep /borrowernotes/, @mandatoryFields ) ? 1 : 0,
Lines 235-241 if ( $op eq 'do' ) { Link Here
235
223
236
    my @disabled = $input->param('disable_input');
224
    my @disabled = $input->param('disable_input');
237
    my $infos;
225
    my $infos;
238
    for my $field ( qw/surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry debarred debarredcomment borrowernotes/ ) {
226
    for my $field ( qw/surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry borrowernotes/ ) {
239
        my $value = $input->param($field);
227
        my $value = $input->param($field);
240
        $infos->{$field} = $value if $value;
228
        $infos->{$field} = $value if $value;
241
        $infos->{$field} = "" if grep { /^$field$/ } @disabled;
229
        $infos->{$field} = "" if grep { /^$field$/ } @disabled;
Lines 327-333 sub GetBorrowerInfos { Link Here
327
    my $borrower = GetMember( %info );
315
    my $borrower = GetMember( %info );
328
    if ( $borrower ) {
316
    if ( $borrower ) {
329
        $borrower->{branchname} = GetBranchName( $borrower->{branchcode} );
317
        $borrower->{branchname} = GetBranchName( $borrower->{branchcode} );
330
        for ( qw(dateenrolled dateexpiry debarred) ) {
318
        for ( qw(dateenrolled dateexpiry) ) {
331
            my $userdate = $borrower->{$_};
319
            my $userdate = $borrower->{$_};
332
            unless ($userdate && $userdate ne "0000-00-00" and $userdate ne "9999-12-31") {
320
            unless ($userdate && $userdate ne "0000-00-00" and $userdate ne "9999-12-31") {
333
                $borrower->{$_} = '';
321
                $borrower->{$_} = '';
334
- 

Return to bug 2720