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 1894-1899 sub AddReturn { Link Here
1894
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
1895
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
1895
        if C4::Context->preference("ReturnLog");
1896
        if C4::Context->preference("ReturnLog");
1896
    
1897
    
1898
    # Remove any OVERDUES related debarment if the borrower has no overdues
1899
    if ( $borrowernumber
1900
      && $borrower->{'debarred'}
1901
      && C4::Context->preference('AutoRemoveOverduesRestrictions')
1902
      && !HasOverdues( $borrowernumber )
1903
      && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
1904
    ) {
1905
        DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
1906
    }
1907
1897
    # FIXME: make this comment intelligible.
1908
    # FIXME: make this comment intelligible.
1898
    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1909
    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1899
    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1910
    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
Lines 2027-2045 sub _debar_user_on_return { Link Here
2027
2038
2028
            my $new_debar_dt =
2039
            my $new_debar_dt =
2029
              $dt_today->clone()->add_duration( $deltadays * $finedays );
2040
              $dt_today->clone()->add_duration( $deltadays * $finedays );
2030
            if ( $borrower->{debarred} ) {
2031
                my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2032
2041
2033
                # Update patron only if new date > old
2042
            Koha::Borrower::Debarments::AddUniqueDebarment({
2034
                if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) !=
2043
                borrowernumber => $borrower->{borrowernumber},
2035
                    -1 )
2044
                expiration     => $new_debar_dt->ymd(),
2036
                {
2045
                type           => 'SUSPENSION',
2037
                    return;
2046
            });
2038
                }
2039
2047
2040
            }
2041
            C4::Members::DebarMember( $borrower->{borrowernumber},
2042
                $new_debar_dt->ymd() );
2043
            return $new_debar_dt->ymd();
2048
            return $new_debar_dt->ymd();
2044
        }
2049
        }
2045
    }
2050
    }
Lines 2584-2589 sub AddRenewal { Link Here
2584
	}
2589
	}
2585
    }
2590
    }
2586
2591
2592
    # Remove any OVERDUES related debarment if the borrower has no overdues
2593
    my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2594
    if ( $borrowernumber
2595
      && $borrower->{'debarred'}
2596
      && !HasOverdues( $borrowernumber )
2597
      && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2598
    ) {
2599
        DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2600
    }
2601
2587
    # Log the renewal
2602
    # Log the renewal
2588
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2603
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2589
	return $datedue;
2604
	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 / +4 lines)
Lines 72-81 BEGIN { Link Here
72
	push @EXPORT, qw(
72
	push @EXPORT, qw(
73
        &GetIssuesIteminfo
73
        &GetIssuesIteminfo
74
	);
74
	);
75
	# subs to move to Members.pm
75
76
	push @EXPORT, qw(
76
	# &GetIssuingRules - delete.
77
        &CheckBorrowerDebarred
77
	# use C4::Circulation::GetIssuingRule instead.
78
	);
78
	
79
	# subs to move to Biblio.pm
79
	# subs to move to Biblio.pm
80
	push @EXPORT, qw(
80
	push @EXPORT, qw(
81
        &GetItems
81
        &GetItems
Lines 1061-1095 sub GetOverduerules { Link Here
1061
}
1061
}
1062
1062
1063
1063
1064
=head2 CheckBorrowerDebarred
1065
1066
    ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
1067
1068
Check if the borrowers is already debarred
1069
1070
C<$debarredstatus> return 0 for not debarred and return 1 for debarred
1071
1072
C<$borrowernumber> contains the borrower number
1073
1074
=cut
1075
1076
# FIXME: Shouldn't this be in C4::Members?
1077
sub CheckBorrowerDebarred {
1078
    my ($borrowernumber) = @_;
1079
    my $dbh   = C4::Context->dbh;
1080
    my $query = qq|
1081
        SELECT debarred
1082
        FROM borrowers
1083
        WHERE borrowernumber=?
1084
        AND debarred > NOW()
1085
    |;
1086
    my $sth = $dbh->prepare($query);
1087
    $sth->execute($borrowernumber);
1088
    my $debarredstatus = $sth->fetchrow;
1089
    return $debarredstatus;
1090
}
1091
1092
1093
=head2 CheckExistantNotifyid
1064
=head2 CheckExistantNotifyid
1094
1065
1095
    ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
1066
    ($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 742-751 $template->param( Link Here
742
    debt_confirmed            => $debt_confirmed,
741
    debt_confirmed            => $debt_confirmed,
743
    SpecifyDueDate            => $duedatespec_allow,
742
    SpecifyDueDate            => $duedatespec_allow,
744
    CircAutocompl             => C4::Context->preference("CircAutocompl"),
743
    CircAutocompl             => C4::Context->preference("CircAutocompl"),
745
	AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"),
744
    AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"),
746
    export_remove_fields      => C4::Context->preference("ExportRemoveFields"),
745
    export_remove_fields      => C4::Context->preference("ExportRemoveFields"),
747
    export_with_csv_profile   => C4::Context->preference("ExportWithCsvProfile"),
746
    export_with_csv_profile   => C4::Context->preference("ExportWithCsvProfile"),
748
    canned_bor_notes_loop     => $canned_notes,
747
    canned_bor_notes_loop     => $canned_notes,
748
    debarments                => GetDebarments({ borrowernumber => $borrowernumber }),
749
);
749
);
750
750
751
output_html_with_http_headers $query, $cookie, $template->output;
751
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 424-426 INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES(' Link Here
424
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('HighlightOwnItemsOnOPAC','0','','If on, and a patron is logged into the OPAC, items from his or her home library will be emphasized and shown first in search results and item details.','YesNo');
424
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('HighlightOwnItemsOnOPAC','0','','If on, and a patron is logged into the OPAC, items from his or her home library will be emphasized and shown first in search results and item details.','YesNo');
425
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('HighlightOwnItemsOnOPACWhich','PatronBranch','PatronBranch|OpacURLBranch','Decides which branch''s items to emphasize. If PatronBranch, emphasize the logged in user''s library''s items. If OpacURLBranch, highlight the items of the Apache var BRANCHCODE defined in Koha''s Apache configuration file.','Choice');
425
INSERT INTO systempreferences (variable,value,options,explanation,type) VALUES ('HighlightOwnItemsOnOPACWhich','PatronBranch','PatronBranch|OpacURLBranch','Decides which branch''s items to emphasize. If PatronBranch, emphasize the logged in user''s library''s items. If OpacURLBranch, highlight the items of the Apache var BRANCHCODE defined in Koha''s Apache configuration file.','Choice');
426
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('UniqueItemFields', 'barcode', 'Space-separated list of fields that should be unique (used in acquisition module for item creation). Fields must be valid SQL column names of items table', '', 'Free');
426
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('UniqueItemFields', 'barcode', 'Space-separated list of fields that should be unique (used in acquisition module for item creation). Fields must be valid SQL column names of items table', '', 'Free');
427
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 6834-6839 if (C4::Context->preference("Version") < TransformToNum($DBversion)) { Link Here
6834
    SetVersion($DBversion);
6834
    SetVersion($DBversion);
6835
}
6835
}
6836
6836
6837
$DBversion ="3.11.00.XXX";
6838
if ( CheckVersion($DBversion) ) {
6839
    $dbh->do(q{
6840
CREATE TABLE borrower_debarments (
6841
  borrower_debarment_id int(11) NOT NULL AUTO_INCREMENT,
6842
  borrowernumber int(11) NOT NULL,
6843
  expiration date DEFAULT NULL,
6844
  `type` enum('SUSPENSION','OVERDUES','MANUAL') NOT NULL DEFAULT 'MANUAL',
6845
  `comment` text,
6846
  manager_id int(11) DEFAULT NULL,
6847
  created timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
6848
  updated timestamp NULL DEFAULT NULL,
6849
  PRIMARY KEY (borrower_debarment_id),
6850
  KEY borrowernumber (borrowernumber)
6851
) ENGINE=InnoDB  DEFAULT CHARSET=utf8;
6852
    });
6853
6854
    $dbh->do(q{
6855
INSERT INTO borrower_debarments ( borrowernumber, expiration, comment ) SELECT borrowernumber, debarred, debarredcomment FROM borrowers WHERE debarred IS NOT NULL
6856
    });
6857
6858
    $dbh->do(q{
6859
INSERT IGNORE INTO systempreferences (variable,value,explanation,type) VALUES
6860
('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo')
6861
    });
6862
6863
    print "Upgrade to $DBversion done (Bug 2720 - Overdues which debar automatically should undebar automatically when returned)\n";
6864
    SetVersion($DBversion);
6865
}
6866
6837
=head1 FUNCTIONS
6867
=head1 FUNCTIONS
6838
6868
6839
=head2 TableExists($table)
6869
=head2 TableExists($table)
(-)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 673-686 No patron matched <span class="ex">[% message %]</span> Link Here
673
673
674
            [% IF ( userdebarred ) %]
674
            [% IF ( userdebarred ) %]
675
               <li class="blocker">
675
               <li class="blocker">
676
               <span class="circ-hlt"> Restricted:</span> Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %]
676
                   <span class="circ-hlt"> Restricted:</span> Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %]
677
               <form class="inline compact" action="/cgi-bin/koha/members/setstatus.pl" method="post">
677
                   <a href="#reldebarments" onclick="$('#debarments-tab-link').click()">View restrictions</a>
678
	                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
678
               </li>
679
	                <input type="hidden" name="destination" value="circ" />
679
            [% END %]
680
	                <input type="hidden" name="cardnumber" value="[% cardnumber %]" />
681
	                <input type="submit" value="Lift restriction" />
682
               </form>
683
			</li>[% END %]
684
680
685
        	[% 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>
681
        	[% 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>
686
            [% END %]
682
            [% END %]
Lines 780-785 No patron matched <span class="ex">[% message %]</span> Link Here
780
    [% ELSE %]
776
    [% ELSE %]
781
            <a href="#reserves">0 Holds</a>
777
            <a href="#reserves">0 Holds</a>
782
    [% END %]</li>
778
    [% END %]</li>
779
    <li><a id="debarments-tab-link" href="#reldebarments">[% debarments.size %] Restrictions</a></li>
783
780
784
</ul>
781
</ul>
785
782
Lines 1092-1097 No patron matched <span class="ex">[% message %]</span> Link Here
1092
</div>
1089
</div>
1093
[% END %]<!-- end displayrelissues -->
1090
[% END %]<!-- end displayrelissues -->
1094
1091
1092
[% INCLUDE borrower_debarments.inc %]
1095
1093
1096
<div id="reserves">
1094
<div id="reserves">
1097
[% IF ( reservloop ) %]
1095
[% IF ( reservloop ) %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt (-31 lines)
Lines 1281-1287 Link Here
1281
			[% FOREACH flagloo IN flagloop %]
1281
			[% FOREACH flagloo IN flagloop %]
1282
				<li><label class="radio" for="yes[% flagloo.name %]">
1282
				<li><label class="radio" for="yes[% flagloo.name %]">
1283
                [% IF ( flagloo.key == 'gonenoaddress' ) %]Gone no address:[% END %]
1283
                [% IF ( flagloo.key == 'gonenoaddress' ) %]Gone no address:[% END %]
1284
				[% IF ( flagloo.key == 'debarred' ) %]Restricted:[% END %]
1285
                [% IF ( flagloo.key == 'lost' ) %]Lost card:[% END %]
1284
                [% IF ( flagloo.key == 'lost' ) %]Lost card:[% END %]
1286
                </label>
1285
                </label>
1287
				<label for="yes[% flagloo.name %]">Yes </label>
1286
				<label for="yes[% flagloo.name %]">Yes </label>
Lines 1299-1334 Link Here
1299
1298
1300
            </li>
1299
            </li>
1301
			[% END %]
1300
			[% END %]
1302
			<li>
1303
				<label for="yesdebarred" class="radio">Restricted: </label>
1304
				[% IF ( debarred ) %]
1305
				<label for="yesdebarred">Yes </label>
1306
				<input type="radio" id="yesdebarred" name="debarred" value="1" checked="checked"/>
1307
                <label for="nodebarred">No </label>
1308
                <input type="radio" id="nodebarred" name="debarred" value="0"/>
1309
				[% ELSE %]
1310
				<label for="yesdebarred">Yes </label>
1311
				<input type="radio" id="yesdebarred" name="debarred" value="1" />
1312
                <label for="nodebarred">No </label>
1313
                <input type="radio" id="nodebarred" name="debarred" value="0" checked="checked"/>
1314
				[% END %]
1315
1316
                <span id="debarreduntil"><label for="datedebarred" class="inline">Until:</label>
1317
                                [% IF opduplicate %]
1318
                                    <input type="text" name="datedebarred" id="datedebarred" class="debarred datepicker" value="[% datedebarred %]" onclick="this.value=''" />
1319
                                [% ELSE %]
1320
                                    <input type="text" name="datedebarred" id="datedebarred" class="debarred datepicker" value="[% datedebarred %]" />
1321
                                [% END %]
1322
                <span class="hint">(optional)</span> </span>
1323
                </li>
1324
                <li>
1325
		        <label for="debarredcomment" class="radio">Comment:</label>
1326
			       [% IF ( opduplicate ) %] 
1327
			           <textarea id="debarredcomment" name="debarredcomment" cols="55" rows="3" onclick="this.value=''">[% debarredcomment %]</textarea>
1328
			       [% ELSE %]
1329
				   <textarea id="debarredcomment" name="debarredcomment" cols="55" rows="3">[% debarredcomment %]</textarea>
1330
			       [% END %]
1331
	        </li>
1332
1301
1333
			</ol>
1302
			</ol>
1334
			</fieldset>
1303
			</fieldset>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt (-4 / +4 lines)
Lines 194-203 function validate1(date) { Link Here
194
        <ul>
194
        <ul>
195
        [% IF ( userdebarred ) %]
195
        [% IF ( userdebarred ) %]
196
            <li class="blocker">Patron is restricted[% IF ( userdebarreddate ) %] until [% userdebarreddate%] [% IF (debarredcomment ) %]([% debarredcomment %])[% END %][% END %]
196
            <li class="blocker">Patron is restricted[% IF ( userdebarreddate ) %] until [% userdebarreddate%] [% IF (debarredcomment ) %]([% debarredcomment %])[% END %][% END %]
197
            <form class="inline compact" action="/cgi-bin/koha/members/setdebar.pl" method="post">
197
            <a href="#reldebarments" onclick="$('#debarments-tab-link').click()">View restrictions</a>
198
                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
199
                <input type="submit" value="Lift restriction" />
200
            </form>
201
            </li>
198
            </li>
202
        [% END %]
199
        [% END %]
203
        [% IF ( gonenoaddress ) %]<li class="blocker">Patron's address is in doubt.</li>[% END %]
200
        [% IF ( gonenoaddress ) %]<li class="blocker">Patron's address is in doubt.</li>[% END %]
Lines 439-444 function validate1(date) { Link Here
439
            <a href="#onhold">[% countreserv %] Hold(s)</a>    [% ELSE %]
436
            <a href="#onhold">[% countreserv %] Hold(s)</a>    [% ELSE %]
440
            <a href="#onhold">0 Holds</a>
437
            <a href="#onhold">0 Holds</a>
441
    [% END %]</li>
438
    [% END %]</li>
439
        <li><a id="debarments-tab-link" href="#reldebarments">[% debarments.size %] Restrictions</a></li>
442
    </ul>
440
    </ul>
443
441
444
    <form action="/cgi-bin/koha/reserve/renewscript.pl" method="post" class="checkboxed">
442
    <form action="/cgi-bin/koha/reserve/renewscript.pl" method="post" class="checkboxed">
Lines 614-619 function validate1(date) { Link Here
614
    [% END %]
612
    [% END %]
615
</div>
613
</div>
616
614
615
[% INCLUDE borrower_debarments.inc %]
616
617
<div id="onhold">
617
<div id="onhold">
618
[% IF ( reservloop ) %]
618
[% IF ( reservloop ) %]
619
<form action="/cgi-bin/koha/reserve/modrequest.pl" method="post">
619
<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 661-669 if (C4::Context->preference('uppercasesurnames')) { Link Here
661
    $data{'contactname'} &&= uc( $data{'contactname'} );
651
    $data{'contactname'} &&= uc( $data{'contactname'} );
662
}
652
}
663
653
664
$data{debarred} = C4::Overdues::CheckBorrowerDebarred($borrowernumber);
654
foreach (qw(dateenrolled dateexpiry dateofbirth)) {
665
$data{datedebarred} = $data{debarred} if ( $data{debarred} && $data{debarred} ne "9999-12-31" );
666
foreach (qw(dateenrolled dateexpiry dateofbirth datedebarred)) {
667
	$data{$_} = format_date($data{$_});	# back to syspref for display
655
	$data{$_} = format_date($data{$_});	# back to syspref for display
668
	$template->param( $_ => $data{$_});
656
	$template->param( $_ => $data{$_});
669
}
657
}
(-)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 147-153 for (qw(gonenoaddress lost borrowernotes)) { Link Here
147
	 $data->{$_} and $template->param(flagged => 1) and last;
146
	 $data->{$_} and $template->param(flagged => 1) and last;
148
}
147
}
149
148
150
my $debar = CheckBorrowerDebarred($borrowernumber);
149
my $debar = $data->{'debarred'};
151
if ($debar) {
150
if ($debar) {
152
    $template->param( 'userdebarred' => 1, 'flagged' => 1 );
151
    $template->param( 'userdebarred' => 1, 'flagged' => 1 );
153
    if ( $debar ne "9999-12-31" ) {
152
    if ( $debar ne "9999-12-31" ) {
Lines 425-430 $template->param( Link Here
425
    AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'),
424
    AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'),
426
    SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'),
425
    SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'),
427
    RoutingSerials => C4::Context->preference('RoutingSerials'),
426
    RoutingSerials => C4::Context->preference('RoutingSerials'),
427
    debarments => GetDebarments({ borrowernumber => $borrowernumber }),
428
);
428
);
429
$template->param( $error => 1 ) if $error;
429
$template->param( $error => 1 ) if $error;
430
430
(-)a/members/setdebar.pl (-50 lines)
Lines 1-50 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
checkauth( $input, 0, { borrowers => 1 }, 'intranet' );
40
41
my $borrowernumber = $input->param('borrowernumber');
42
43
my $dbh = C4::Context->dbh;
44
my $sth =
45
  $dbh->prepare("Update borrowers set debarred = NULL where borrowernumber = ?");
46
$sth->execute( $borrowernumber );
47
$sth->finish;
48
49
print $input->redirect(
50
    "/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
(-)a/misc/cronjobs/overdue_notices.pl (-1 / +5 lines)
Lines 41-46 use C4::Debug; Link Here
41
use C4::Letters;
41
use C4::Letters;
42
use C4::Overdues qw(GetFine);
42
use C4::Overdues qw(GetFine);
43
use C4::Budgets qw(GetCurrency);
43
use C4::Budgets qw(GetCurrency);
44
use Koha::Borrower::Debarments qw(AddUniqueDebarment);
44
45
45
=head1 NAME
46
=head1 NAME
46
47
Lines 515-521 END_SQL Link Here
515
                if ( $overdue_rules->{"debarred$i"} ) {
516
                if ( $overdue_rules->{"debarred$i"} ) {
516
    
517
    
517
                    #action taken is debarring
518
                    #action taken is debarring
518
                    C4::Members::DebarMember($borrowernumber, '9999-12-31');
519
                    AddUniqueDebarment({
520
                        borrowernumber => $borrowernumber,
521
                        type => 'OVERDUES',
522
                    });
519
                    $verbose and warn "debarring $borr\n";
523
                    $verbose and warn "debarring $borr\n";
520
                }
524
                }
521
                my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
525
                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 32-38 sub methods : Test( 1 ) { Link Here
32
                       GetOverdueDelays 
32
                       GetOverdueDelays 
33
                       CheckAccountLineLevelInfo 
33
                       CheckAccountLineLevelInfo 
34
                       GetOverduerules
34
                       GetOverduerules
35
                       CheckBorrowerDebarred
36
                       CheckExistantNotifyid 
35
                       CheckExistantNotifyid 
37
                       CheckAccountLineItemInfo 
36
                       CheckAccountLineItemInfo 
38
                       CheckItemNotify 
37
                       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