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 1919-1924 sub AddReturn { Link Here
1919
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
1920
    logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
1920
        if C4::Context->preference("ReturnLog");
1921
        if C4::Context->preference("ReturnLog");
1921
    
1922
    
1923
    # Remove any OVERDUES related debarment if the borrower has no overdues
1924
    if ( $borrowernumber
1925
      && $borrower->{'debarred'}
1926
      && C4::Context->preference('AutoRemoveOverduesRestrictions')
1927
      && !HasOverdues( $borrowernumber )
1928
      && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
1929
    ) {
1930
        DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
1931
    }
1932
1922
    # FIXME: make this comment intelligible.
1933
    # FIXME: make this comment intelligible.
1923
    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1934
    #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1924
    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1935
    #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
Lines 2052-2070 sub _debar_user_on_return { Link Here
2052
2063
2053
            my $new_debar_dt =
2064
            my $new_debar_dt =
2054
              $dt_today->clone()->add_duration( $deltadays * $finedays );
2065
              $dt_today->clone()->add_duration( $deltadays * $finedays );
2055
            if ( $borrower->{debarred} ) {
2056
                my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2057
2066
2058
                # Update patron only if new date > old
2067
            Koha::Borrower::Debarments::AddUniqueDebarment({
2059
                if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) !=
2068
                borrowernumber => $borrower->{borrowernumber},
2060
                    -1 )
2069
                expiration     => $new_debar_dt->ymd(),
2061
                {
2070
                type           => 'SUSPENSION',
2062
                    return;
2071
            });
2063
                }
2064
2072
2065
            }
2066
            C4::Members::DebarMember( $borrower->{borrowernumber},
2067
                $new_debar_dt->ymd() );
2068
            return $new_debar_dt->ymd();
2073
            return $new_debar_dt->ymd();
2069
        }
2074
        }
2070
    }
2075
    }
Lines 2610-2615 sub AddRenewal { Link Here
2610
	}
2615
	}
2611
    }
2616
    }
2612
2617
2618
    # Remove any OVERDUES related debarment if the borrower has no overdues
2619
    my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2620
    if ( $borrowernumber
2621
      && $borrower->{'debarred'}
2622
      && !HasOverdues( $borrowernumber )
2623
      && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2624
    ) {
2625
        DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2626
    }
2627
2613
    # Log the renewal
2628
    # Log the renewal
2614
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2629
    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'});
2615
	return $datedue;
2630
	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 2236-2267 sub GetBorrowersNamesAndLatestIssue { Link Here
2236
    return $results;
2239
    return $results;
2237
}
2240
}
2238
2241
2239
=head2 DebarMember
2240
2241
my $success = DebarMember( $borrowernumber, $todate );
2242
2243
marks a Member as debarred, and therefore unable to checkout any more
2244
items.
2245
2246
return :
2247
true on success, false on failure
2248
2249
=cut
2250
2251
sub DebarMember {
2252
    my $borrowernumber = shift;
2253
    my $todate         = shift;
2254
2255
    return unless defined $borrowernumber;
2256
    return unless $borrowernumber =~ /^\d+$/;
2257
2258
    return ModMember(
2259
        borrowernumber => $borrowernumber,
2260
        debarred       => $todate
2261
    );
2262
2263
}
2264
2265
=head2 ModPrivacy
2242
=head2 ModPrivacy
2266
2243
2267
=over 4
2244
=over 4
Lines 2560-2565 sub AddEnrolmentFeeIfNeeded { Link Here
2560
    }
2537
    }
2561
}
2538
}
2562
2539
2540
sub HasOverdues {
2541
    my ( $borrowernumber ) = @_;
2542
2543
    my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2544
    my $sth = C4::Context->dbh->prepare( $sql );
2545
    $sth->execute( $borrowernumber );
2546
    my ( $count ) = $sth->fetchrow_array();
2547
2548
    return $count;
2549
}
2550
2563
END { }    # module clean-up code here (global destructor)
2551
END { }    # module clean-up code here (global destructor)
2564
2552
2565
1;
2553
1;
(-)a/C4/Overdues.pm (-33 / +4 lines)
Lines 62-71 BEGIN { Link Here
62
	push @EXPORT, qw(
62
	push @EXPORT, qw(
63
        &GetIssuesIteminfo
63
        &GetIssuesIteminfo
64
	);
64
	);
65
	# subs to move to Members.pm
65
66
	push @EXPORT, qw(
66
     # &GetIssuingRules - delete.
67
        &CheckBorrowerDebarred
67
   # use C4::Circulation::GetIssuingRule instead.
68
	);
68
69
	# subs to move to Biblio.pm
69
	# subs to move to Biblio.pm
70
	push @EXPORT, qw(
70
	push @EXPORT, qw(
71
        &GetItems
71
        &GetItems
Lines 759-793 sub GetBranchcodesWithOverdueRules { Link Here
759
    return @branches;
759
    return @branches;
760
}
760
}
761
761
762
=head2 CheckBorrowerDebarred
763
764
    ($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
765
766
Check if the borrowers is already debarred
767
768
C<$debarredstatus> return 0 for not debarred and return 1 for debarred
769
770
C<$borrowernumber> contains the borrower number
771
772
=cut
773
774
# FIXME: Shouldn't this be in C4::Members?
775
sub CheckBorrowerDebarred {
776
    my ($borrowernumber) = @_;
777
    my $dbh   = C4::Context->dbh;
778
    my $query = qq|
779
        SELECT debarred
780
        FROM borrowers
781
        WHERE borrowernumber=?
782
        AND debarred > NOW()
783
    |;
784
    my $sth = $dbh->prepare($query);
785
    $sth->execute($borrowernumber);
786
    my $debarredstatus = $sth->fetchrow;
787
    return $debarredstatus;
788
}
789
790
791
=head2 CheckItemNotify
762
=head2 CheckItemNotify
792
763
793
Sql request to check if the document has alreday been notified
764
Sql request to check if the document has alreday been notified
(-)a/Koha/Borrower/Debarments.pm (+333 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'}
226
          if ( $debarment->{'expiration'}
227
            && $debarment->{'expiration'} gt $params->{'expiration'} );
228
229
        $params->{'borrower_debarment_id'} =
230
          $debarment->{'borrower_debarment_id'};
231
        $r = ModDebarment($params);
232
    } else {
233
234
        $r = AddDebarment($params);
235
    }
236
237
    _UpdateBorrowerDebarmentFlags($borrowernumber);
238
239
    return $r;
240
}
241
242
=head2 DelUniqueDebarment
243
244
my $success = _DelUniqueDebarment({
245
    borrowernumber => $borrowernumber,
246
    type           => $type,
247
});
248
249
Deletes a unique debarment of the type defined by the key type.
250
The current unique debarment types are OVERDUES, and SUSPENSION
251
252
Required keys: borrowernumber, type
253
254
=cut
255
256
sub DelUniqueDebarment {
257
    my ($params) = @_;
258
259
    my $borrowernumber = $params->{'borrowernumber'};
260
    my $type           = $params->{'type'};
261
262
    return unless ( $borrowernumber && $type );
263
264
    my $debarment = @{ GetDebarments( { borrowernumber => $borrowernumber, type => $type } ) }[0];
265
266
    return unless ( $debarment );
267
268
    return DelDebarment( $debarment->{'borrower_debarment_id'} );
269
}
270
271
=head2 _UpdateBorrowerDebarmentFlags
272
273
my $success = _UpdateBorrowerDebarmentFlags( $borrowernumber );
274
275
So as not to create additional latency, the fields borrowers.debarred
276
and borrowers.debarredcomment remain in the borrowers table. Whenever
277
the a borrowers debarrments are modified, this subroutine is run to
278
decide if the borrower is currently debarred and update the 'quick flags'
279
in the borrowers table accordingly.
280
281
=cut
282
283
sub _UpdateBorrowerDebarmentFlags {
284
    my ($borrowernumber) = @_;
285
286
    return unless ($borrowernumber);
287
288
    my $dbh = C4::Context->dbh;
289
290
    my $sql = q{
291
        SELECT COUNT(*), COUNT(*) - COUNT(expiration), MAX(expiration), GROUP_CONCAT(comment SEPARATOR '\n') FROM borrower_debarments
292
        WHERE ( expiration > CURRENT_DATE() OR expiration IS NULL ) AND borrowernumber = ?
293
    };
294
    my $sth = $dbh->prepare($sql);
295
    $sth->execute($borrowernumber);
296
    my ( $count, $indefinite_expiration, $expiration, $comment ) = $sth->fetchrow_array();
297
298
    if ($count) {
299
        $expiration = "9999-12-31" if ($indefinite_expiration);
300
    } else {
301
        $expiration = undef;
302
        $comment    = undef;
303
    }
304
305
    return $dbh->do( "UPDATE borrowers SET debarred = ?, debarredcomment = ? WHERE borrowernumber = ?", {}, ( $expiration, $comment, $borrowernumber ) );
306
}
307
308
=head2 _GetBorrowernumberByDebarmentId
309
310
my $borrowernumber = _GetBorrowernumberByDebarmentId( $borrower_debarment_id );
311
312
=cut
313
314
sub _GetBorrowernumberByDebarmentId {
315
    my ($borrower_debarment_id) = @_;
316
317
    return unless ($borrower_debarment_id);
318
319
    my $sql = "SELECT borrowernumber FROM borrower_debarments WHERE borrower_debarment_id = ?";
320
    my $sth = C4::Context->dbh->prepare($sql);
321
    $sth->execute($borrower_debarment_id);
322
    my ($borrowernumber) = $sth->fetchrow_array();
323
324
    return $borrowernumber;
325
}
326
327
1;
328
329
=head2 AUTHOR
330
331
Kyle M Hall <kyle@bywatersoltuions.com>
332
333
=cut
(-)a/circ/circulation.pl (-9 / +9 lines)
Lines 32-38 use C4::Dates qw/format_date/; Link Here
32
use C4::Branch; # GetBranches
32
use C4::Branch; # GetBranches
33
use C4::Koha;   # GetPrinter
33
use C4::Koha;   # GetPrinter
34
use C4::Circulation;
34
use C4::Circulation;
35
use C4::Overdues qw/CheckBorrowerDebarred/;
36
use C4::Members;
35
use C4::Members;
37
use C4::Biblio;
36
use C4::Biblio;
38
use C4::Search;
37
use C4::Search;
Lines 41-46 use C4::Reserves; Link Here
41
use C4::Context;
40
use C4::Context;
42
use CGI::Session;
41
use CGI::Session;
43
use C4::Members::Attributes qw(GetBorrowerAttributes);
42
use C4::Members::Attributes qw(GetBorrowerAttributes);
43
use Koha::Borrower::Debarments qw(GetDebarments);
44
use Koha::DateUtils;
44
use Koha::DateUtils;
45
45
46
use Date::Calc qw(
46
use Date::Calc qw(
Lines 266-278 if ($borrowernumber) { Link Here
266
        finetotal    => $fines
266
        finetotal    => $fines
267
    );
267
    );
268
268
269
    my $debar = CheckBorrowerDebarred($borrowernumber);
269
    $template->param(
270
    if ($debar) {
270
        'userdebarred'    => $borrower->{debarred},
271
        $template->param( 'userdebarred'    => 1 );
271
        'debarredcomment' => $borrower->{debarredcomment},
272
        $template->param( 'debarredcomment' => $borrower->{debarredcomment} );
272
    );
273
        if ( $debar ne "9999-12-31" ) {
273
    if ( $borrower->{debarred} ne "9999-12-31" ) {
274
            $template->param( 'userdebarreddate' => C4::Dates::format_date($debar) );
274
        $template->param( 'userdebarreddate' => C4::Dates::format_date( $borrower->{debarred} ) );
275
        }
276
    }
275
    }
277
276
278
}
277
}
Lines 776-785 $template->param( Link Here
776
    debt_confirmed            => $debt_confirmed,
775
    debt_confirmed            => $debt_confirmed,
777
    SpecifyDueDate            => $duedatespec_allow,
776
    SpecifyDueDate            => $duedatespec_allow,
778
    CircAutocompl             => C4::Context->preference("CircAutocompl"),
777
    CircAutocompl             => C4::Context->preference("CircAutocompl"),
779
	AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"),
778
    AllowRenewalLimitOverride => C4::Context->preference("AllowRenewalLimitOverride"),
780
    export_remove_fields      => C4::Context->preference("ExportRemoveFields"),
779
    export_remove_fields      => C4::Context->preference("ExportRemoveFields"),
781
    export_with_csv_profile   => C4::Context->preference("ExportWithCsvProfile"),
780
    export_with_csv_profile   => C4::Context->preference("ExportWithCsvProfile"),
782
    canned_bor_notes_loop     => $canned_notes,
781
    canned_bor_notes_loop     => $canned_notes,
782
    debarments                => GetDebarments({ borrowernumber => $borrowernumber }),
783
);
783
);
784
784
785
output_html_with_http_headers $query, $cookie, $template->output;
785
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/installer/data/mysql/sysprefs.sql (-1 / +2 lines)
Lines 43-49 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
43
('AutomaticItemReturn','1',NULL,'If ON, Koha will automatically set up a transfer of this item to its homebranch','YesNo'),
43
('AutomaticItemReturn','1',NULL,'If ON, Koha will automatically set up a transfer of this item to its homebranch','YesNo'),
44
('autoMemberNum','1','','If ON, patron number is auto-calculated','YesNo'),
44
('autoMemberNum','1','','If ON, patron number is auto-calculated','YesNo'),
45
('AutoResumeSuspendedHolds','1',NULL,'Allow suspended holds to be automatically resumed by a set date.','YesNo'),
45
('AutoResumeSuspendedHolds','1',NULL,'Allow suspended holds to be automatically resumed by a set date.','YesNo'),
46
('AutoSelfCheckAllowed','0','','For corporate and special libraries which want web-based self-check available from any PC without the need for a manual staff login. Most libraries will want to leave this turned off. If on, requires self-check ID and password to be entered in AutoSelfCheckID and AutoSelfCheckPass sysprefs.','YesNo'),
46
('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo'),
47
('AutoSelfCheckAllowed','0','For corporate and special libraries which want web-based self-check available from any PC without the need for a manual staff login. Most libraries will want to leave this turned off. If on, requires self-check ID and password to be entered in AutoSelfCheckID and AutoSelfCheckPass sysprefs.','YesNo'),
47
('AutoSelfCheckID','','','Staff ID with circulation rights to be used for automatic web-based self-check. Only applies if AutoSelfCheckAllowed syspref is turned on.','free'),
48
('AutoSelfCheckID','','','Staff ID with circulation rights to be used for automatic web-based self-check. Only applies if AutoSelfCheckAllowed syspref is turned on.','free'),
48
('AutoSelfCheckPass','','','Password to be used for automatic web-based self-check. Only applies if AutoSelfCheckAllowed syspref is turned on.','free'),
49
('AutoSelfCheckPass','','','Password to be used for automatic web-based self-check. Only applies if AutoSelfCheckAllowed syspref is turned on.','free'),
49
('Babeltheque','0','','Turn ON Babeltheque content  - See babeltheque.com to subscribe to this service','YesNo'),
50
('Babeltheque','0','','Turn ON Babeltheque content  - See babeltheque.com to subscribe to this service','YesNo'),
(-)a/installer/data/mysql/updatedatabase.pl (+30 lines)
Lines 7067-7072 if ( CheckVersion($DBversion) ) { Link Here
7067
    SetVersion($DBversion);
7067
    SetVersion($DBversion);
7068
}
7068
}
7069
7069
7070
$DBversion ="3.13.00.XXX";
7071
if ( CheckVersion($DBversion) ) {
7072
    $dbh->do(q{
7073
CREATE TABLE borrower_debarments (
7074
  borrower_debarment_id int(11) NOT NULL AUTO_INCREMENT,
7075
  borrowernumber int(11) NOT NULL,
7076
  expiration date DEFAULT NULL,
7077
  `type` enum('SUSPENSION','OVERDUES','MANUAL') NOT NULL DEFAULT 'MANUAL',
7078
  `comment` text,
7079
  manager_id int(11) DEFAULT NULL,
7080
  created timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
7081
  updated timestamp NULL DEFAULT NULL,
7082
  PRIMARY KEY (borrower_debarment_id),
7083
  KEY borrowernumber (borrowernumber)
7084
) ENGINE=InnoDB  DEFAULT CHARSET=utf8;
7085
    });
7086
7087
    $dbh->do(q{
7088
INSERT INTO borrower_debarments ( borrowernumber, expiration, comment ) SELECT borrowernumber, debarred, debarredcomment FROM borrowers WHERE debarred IS NOT NULL
7089
    });
7090
7091
    $dbh->do(q{
7092
INSERT IGNORE INTO systempreferences (variable,value,explanation,type) VALUES
7093
('AutoRemoveOverduesRestrictions','0','Defines whether an OVERDUES debarment should be lifted automatically if all overdue items are returned by the patron.','YesNo')
7094
    });
7095
7096
    print "Upgrade to $DBversion done (Bug 2720 - Overdues which debar automatically should undebar automatically when returned)\n";
7097
    SetVersion($DBversion);
7098
}
7099
7070
=head1 FUNCTIONS
7100
=head1 FUNCTIONS
7071
7101
7072
=head2 TableExists($table)
7102
=head2 TableExists($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/borrower_debarments.inc (+64 lines)
Line 0 Link Here
1
<script type="text/javascript">
2
   //<![CDATA[
3
4
        function confirm_remove_restriction() {
5
            return confirm(_("Remove restriction?"));
6
        }
7
8
    //]]>
9
</script>
10
11
<div id="reldebarments">
12
    [% UNLESS debarments %]<p>Patron is currently unrestricted.</p>[% END %]
13
14
    <table>
15
        <thead>
16
            <tr>
17
                 <th>Type</th>
18
                 <th>Comment</th>
19
                 <th>Expiration</th>
20
                 [% IF ( CAN_user_borrowers ) %]
21
                     <th>&nbsp;</th>
22
                 [% END %]
23
            </tr>
24
        </thead>
25
26
        <tbody>
27
            [% FOREACH d IN debarments %]
28
                <tr>
29
                    <td>[% d.type %]</td>
30
                    <td>[% d.comment %]</td>
31
                    <td>[% IF d.expiration %] [% d.expiration | $KohaDates %] [% ELSE %] <i>Indefinite</i> [% END %]</td>
32
                    [% IF ( CAN_user_borrowers )%]
33
                        <td>
34
                            <a href="/cgi-bin/koha/members/mod_debarment.pl?borrowernumber=[% borrowernumber %]&amp;borrower_debarment_id=[% d.borrower_debarment_id %]&amp;action=del" onclick="return confirm_remove_restriction()">
35
                                Remove
36
                            </a>
37
                        </td>
38
                    [% END %]
39
                </tr>
40
            [% END %]
41
        </tbody>
42
43
        [% IF ( CAN_user_borrowers )%]
44
            <form method="post" action="/cgi-bin/koha/members/mod_debarment.pl">
45
                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
46
                <input type="hidden" name="action" value="add" />
47
48
                <tfoot>
49
                    <tr>
50
                        <td>MANUAL</td>
51
                        <td><input type="text" name="comment" /></td>
52
                        <td>
53
                            <input name="expiration" id="expiration" size="10" readonly="readonly" value="" class="datepicker" />
54
                            <a href='#' onclick="document.getElementById('expiration').value='';">Clear Date</a>
55
                        </td>
56
                        <td>
57
                            <input type="submit" value="Add restriction" />
58
                        </td>
59
                    </tr>
60
                </tfoot>
61
            </form>
62
        [% END %]
63
    </table>
64
</div>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref (+6 lines)
Lines 138-143 Circulation: Link Here
138
                  no: "Don't allow"
138
                  no: "Don't allow"
139
            - staff to override and check out items when the patron has reached the maximum number of allowed checkouts.
139
            - staff to override and check out items when the patron has reached the maximum number of allowed checkouts.
140
        -
140
        -
141
            - pref: AutoRemoveOverduesRestrictions
142
              choices:
143
                  yes: "Do"
144
                  no: "Do not"
145
            - allow OVERDUES restrictions triggered by sent notices to be cleared automatically when all overdue items are returned by a patron.
146
        -
141
            - pref: AllowNotForLoanOverride
147
            - pref: AllowNotForLoanOverride
142
              choices:
148
              choices:
143
                  yes: Allow
149
                  yes: Allow
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt (-8 / +6 lines)
Lines 699-712 No patron matched <span class="ex">[% message %]</span> Link Here
699
699
700
            [% IF ( userdebarred ) %]
700
            [% IF ( userdebarred ) %]
701
               <li class="blocker">
701
               <li class="blocker">
702
               <span class="circ-hlt"> Restricted:</span> Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %]
702
                   <span class="circ-hlt"> Restricted:</span> Patron's account is restricted [% IF (userdebarreddate ) %] until [% userdebarreddate %] [% END %] [% IF (debarredcomment ) %] with the comment "[% debarredcomment %]"[% END %]
703
               <form class="inline compact" action="/cgi-bin/koha/members/setstatus.pl" method="post">
703
                   <a href="#reldebarments" onclick="$('#debarments-tab-link').click()">View restrictions</a>
704
	                <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
704
               </li>
705
	                <input type="hidden" name="destination" value="circ" />
705
            [% END %]
706
	                <input type="hidden" name="cardnumber" value="[% cardnumber %]" />
707
	                <input type="submit" value="Lift restriction" />
708
               </form>
709
			</li>[% END %]
710
706
711
        	[% 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>
707
        	[% 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>
712
            [% END %]
708
            [% END %]
Lines 806-811 No patron matched <span class="ex">[% message %]</span> Link Here
806
    [% ELSE %]
802
    [% ELSE %]
807
            <a href="#reserves">0 Holds</a>
803
            <a href="#reserves">0 Holds</a>
808
    [% END %]</li>
804
    [% END %]</li>
805
    <li><a id="debarments-tab-link" href="#reldebarments">[% debarments.size %] Restrictions</a></li>
809
806
810
</ul>
807
</ul>
811
808
Lines 1118-1123 No patron matched <span class="ex">[% message %]</span> Link Here
1118
</div>
1115
</div>
1119
[% END %]<!-- end displayrelissues -->
1116
[% END %]<!-- end displayrelissues -->
1120
1117
1118
[% INCLUDE borrower_debarments.inc %]
1121
1119
1122
<div id="reserves">
1120
<div id="reserves">
1123
[% IF ( reservloop ) %]
1121
[% IF ( reservloop ) %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/members/memberentrygen.tt (-31 / +45 lines)
Lines 1-3 Link Here
1
[% USE KohaDates %]
1
[% INCLUDE 'doc-head-open.inc' %]
2
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Patrons &rsaquo; 
3
<title>Koha &rsaquo; Patrons &rsaquo; 
3
[% IF ( opadd ) %]Add[% ELSIF ( opduplicate ) %]Duplicate[% ELSE %] Modify[% END %] [% IF ( categoryname ) %] [% categoryname %] patron[% ELSE %][% IF ( I ) %] Organization patron[% END %][% IF ( A ) %] Adult patron[% END %][% IF ( C ) %] Child patron[% END %][% IF ( P ) %] Professional patron[% END %][% IF ( S ) %] Staff patron[% END %][% END %][% UNLESS ( opadd ) %] [% surname %], [% firstname %][% END %]</title>
4
[% IF ( opadd ) %]Add[% ELSIF ( opduplicate ) %]Duplicate[% ELSE %] Modify[% END %] [% IF ( categoryname ) %] [% categoryname %] patron[% ELSE %][% IF ( I ) %] Organization patron[% END %][% IF ( A ) %] Adult patron[% END %][% IF ( C ) %] Child patron[% END %][% IF ( P ) %] Professional patron[% END %][% IF ( S ) %] Staff patron[% END %][% END %][% UNLESS ( opadd ) %] [% surname %], [% firstname %][% END %]</title>
Lines 1275-1281 Link Here
1275
			[% FOREACH flagloo IN flagloop %]
1276
			[% FOREACH flagloo IN flagloop %]
1276
				<li><label class="radio" for="yes[% flagloo.name %]">
1277
				<li><label class="radio" for="yes[% flagloo.name %]">
1277
                [% IF ( flagloo.key == 'gonenoaddress' ) %]Gone no address:[% END %]
1278
                [% IF ( flagloo.key == 'gonenoaddress' ) %]Gone no address:[% END %]
1278
				[% IF ( flagloo.key == 'debarred' ) %]Restricted:[% END %]
1279
                [% IF ( flagloo.key == 'lost' ) %]Lost card:[% END %]
1279
                [% IF ( flagloo.key == 'lost' ) %]Lost card:[% END %]
1280
                </label>
1280
                </label>
1281
				<label for="yes[% flagloo.name %]">Yes </label>
1281
				<label for="yes[% flagloo.name %]">Yes </label>
Lines 1293-1332 Link Here
1293
1293
1294
            </li>
1294
            </li>
1295
			[% END %]
1295
			[% END %]
1296
			<li>
1297
				<label for="yesdebarred" class="radio">Restricted: </label>
1298
				[% IF ( debarred ) %]
1299
				<label for="yesdebarred">Yes </label>
1300
				<input type="radio" id="yesdebarred" name="debarred" value="1" checked="checked"/>
1301
                <label for="nodebarred">No </label>
1302
                <input type="radio" id="nodebarred" name="debarred" value="0"/>
1303
				[% ELSE %]
1304
				<label for="yesdebarred">Yes </label>
1305
				<input type="radio" id="yesdebarred" name="debarred" value="1" />
1306
                <label for="nodebarred">No </label>
1307
                <input type="radio" id="nodebarred" name="debarred" value="0" checked="checked"/>
1308
				[% END %]
1309
1310
                <span id="debarreduntil"><label for="datedebarred" class="inline">Until:</label>
1311
                                [% IF opduplicate %]
1312
                                    <input type="text" name="datedebarred" id="datedebarred" class="debarred datepicker" value="[% datedebarred %]" onclick="this.value=''" />
1313
                                [% ELSE %]
1314
                                    <input type="text" name="datedebarred" id="datedebarred" class="debarred datepicker" value="[% datedebarred %]" />
1315
                                [% END %]
1316
                <span class="hint">(optional)</span> </span>
1317
                </li>
1318
                <li>
1319
		        <label for="debarredcomment" class="radio">Comment:</label>
1320
			       [% IF ( opduplicate ) %] 
1321
			           <textarea id="debarredcomment" name="debarredcomment" cols="55" rows="3" onclick="this.value=''">[% debarredcomment %]</textarea>
1322
			       [% ELSE %]
1323
				   <textarea id="debarredcomment" name="debarredcomment" cols="55" rows="3">[% debarredcomment %]</textarea>
1324
			       [% END %]
1325
	        </li>
1326
1296
1327
			</ol>
1297
			</ol>
1328
			</fieldset>
1298
			</fieldset>
1329
    
1299
    
1300
              <fieldset class="rows">
1301
                <legend>Patron restrictions</legend>
1302
1303
                [% UNLESS debarments %]<p>Patron is currently unrestricted.</p>[% END %]
1304
1305
                <table>
1306
                    <thead>
1307
                        <tr>
1308
                             <th>Type</th>
1309
                             <th>Comment</th>
1310
                             <th>Expiration</th>
1311
                             <th>Remove?</th>
1312
                        </tr>
1313
                    </thead>
1314
1315
                    <tbody>
1316
                        [% FOREACH d IN debarments %]
1317
                            <tr>
1318
                                <td>[% d.type %]</td>
1319
                                <td>[% d.comment %]</td>
1320
                                <td>[% IF d.expiration %] [% d.expiration | $KohaDates %] [% ELSE %] <i>Indefinite</i> [% END %]</td>
1321
                                <td>
1322
                                    <input type="checkbox" id="debarment_[% d.borrower_debarment_id %]" name="remove_debarment" value="[% d.borrower_debarment_id %]" />
1323
                                </td>
1324
                            </tr>
1325
                        [% END %]
1326
                    </tbody>
1327
1328
                    <tfoot>
1329
                        <tr>
1330
                            <td>
1331
                                Add new
1332
                                <input type="checkbox" id="add_debarment" name="add_debarment" value="1" />
1333
                            </td>
1334
                            <td><input type="text" id="debarred_comment" name="debarred_comment" onchange="$('#add_debarment').prop('checked', true);" /></td>
1335
                            <td>
1336
                                <input name="debarred_expiration" id="debarred_expiration" size="10" readonly="readonly" value="" class="datepicker" onchange="$('#add_debarment').prop('checked', true);" />
1337
                                <a href='javascript:void(0)' onclick="$('#debarred_expiration').val('');">Clear date</a>
1338
                            </td>
1339
                            <td><a class="btn" href='javascript:void(0)' onclick="$('#debarred_expiration').val(''); $('#add_debarment').prop('checked', false); $('#debarred_comment').val('');">Clear new restriction</a></td>
1340
                        </tr>
1341
                    </tfoot>
1342
                </table>
1343
            </fieldset>
1330
		[% END %]
1344
		[% END %]
1331
1345
1332
[% END %]
1346
[% END %]
(-)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 / +27 lines)
Lines 41-46 use C4::Log; Link Here
41
use C4::Letters;
41
use C4::Letters;
42
use C4::Branch; # GetBranches
42
use C4::Branch; # GetBranches
43
use C4::Form::MessagingPreferences;
43
use C4::Form::MessagingPreferences;
44
use Koha::Borrower::Debarments;
45
use Koha::DateUtils;
44
46
45
use vars qw($debug);
47
use vars qw($debug);
46
48
Lines 62-67 my ($template, $loggedinuser, $cookie) Link Here
62
           flagsrequired => {borrowers => 1},
64
           flagsrequired => {borrowers => 1},
63
           debug => ($debug) ? 1 : 0,
65
           debug => ($debug) ? 1 : 0,
64
       });
66
       });
67
65
my $guarantorid    = $input->param('guarantorid');
68
my $guarantorid    = $input->param('guarantorid');
66
my $borrowernumber = $input->param('borrowernumber');
69
my $borrowernumber = $input->param('borrowernumber');
67
my $actionType     = $input->param('actionType') || '';
70
my $actionType     = $input->param('actionType') || '';
Lines 90-95 my $borrower_data; Link Here
90
my $NoUpdateLogin;
93
my $NoUpdateLogin;
91
my $userenv = C4::Context->userenv;
94
my $userenv = C4::Context->userenv;
92
95
96
97
## Deal with debarments
98
$template->param(
99
    debarments => GetDebarments( { borrowernumber => $borrowernumber } ) );
100
my @debarments_to_remove = $input->param('remove_debarment');
101
foreach my $d ( @debarments_to_remove ) {
102
    DelDebarment( $d );
103
}
104
if ( $input->param('add_debarment') ) {
105
106
    my $expiration = $input->param('debarred_expiration');
107
    $expiration = $expiration ? output_pref( dt_from_string($expiration), 'iso' ) : undef;
108
109
    AddUniqueDebarment(
110
        {
111
            borrowernumber => $borrowernumber,
112
            type           => 'MANUAL',
113
            comment        => $input->param('debarred_comment'),
114
            expiration     => $expiration,
115
        }
116
    );
117
}
118
93
$template->param("uppercasesurnames" => C4::Context->preference('uppercasesurnames'));
119
$template->param("uppercasesurnames" => C4::Context->preference('uppercasesurnames'));
94
120
95
my $minpw = C4::Context->preference('minPasswordLength');
121
my $minpw = C4::Context->preference('minPasswordLength');
Lines 142-157 if ( $op eq 'insert' || $op eq 'modify' || $op eq 'save' || $op eq 'duplicate' ) Link Here
142
        }
168
        }
143
    }
169
    }
144
170
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();
171
    my $dateobject = C4::Dates->new();
156
    my $syspref = $dateobject->regexp();		# same syspref format for all 3 dates
172
    my $syspref = $dateobject->regexp();		# same syspref format for all 3 dates
157
    my $iso     = $dateobject->regexp('iso');	#
173
    my $iso     = $dateobject->regexp('iso');	#
Lines 661-669 if (C4::Context->preference('uppercasesurnames')) { Link Here
661
    $data{'contactname'} &&= uc( $data{'contactname'} );
677
    $data{'contactname'} &&= uc( $data{'contactname'} );
662
}
678
}
663
679
664
$data{debarred} = C4::Overdues::CheckBorrowerDebarred($borrowernumber);
680
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
681
	$data{$_} = format_date($data{$_});	# back to syspref for display
668
	$template->param( $_ => $data{$_});
682
	$template->param( $_ => $data{$_});
669
}
683
}
(-)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
=head1 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 430-435 $template->param( Link Here
430
    AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'),
429
    AutoResumeSuspendedHolds => C4::Context->preference('AutoResumeSuspendedHolds'),
431
    SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'),
430
    SuspendHoldsIntranet => C4::Context->preference('SuspendHoldsIntranet'),
432
    RoutingSerials => C4::Context->preference('RoutingSerials'),
431
    RoutingSerials => C4::Context->preference('RoutingSerials'),
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 (-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 / +11 lines)
Lines 42-47 use C4::Letters; Link Here
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
44
45
use Koha::Borrower::Debarments qw(AddUniqueDebarment);
46
use Koha::DateUtils;
47
45
=head1 NAME
48
=head1 NAME
46
49
47
overdue_notices.pl - prepare messages to be sent to patrons for overdue items
50
overdue_notices.pl - prepare messages to be sent to patrons for overdue items
Lines 515-521 END_SQL Link Here
515
                if ( $overdue_rules->{"debarred$i"} ) {
518
                if ( $overdue_rules->{"debarred$i"} ) {
516
    
519
    
517
                    #action taken is debarring
520
                    #action taken is debarring
518
                    C4::Members::DebarMember($borrowernumber, '9999-12-31');
521
                    AddUniqueDebarment(
522
                        {
523
                            borrowernumber => $borrowernumber,
524
                            type           => 'OVERDUES',
525
                            comment => "Restriction added by overdues process "
526
                              . output_pref( dt_from_string() ),
527
                        }
528
                    );
519
                    $verbose and warn "debarring $borr\n";
529
                    $verbose and warn "debarring $borr\n";
520
                }
530
                }
521
                my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
531
                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 25-31 sub methods : Test( 1 ) { Link Here
25
                       NumberNotifyId
25
                       NumberNotifyId
26
                       AmountNotify
26
                       AmountNotify
27
                       GetItems 
27
                       GetItems 
28
                       CheckBorrowerDebarred
29
                       CheckItemNotify 
28
                       CheckItemNotify 
30
                       GetOverduesForBranch 
29
                       GetOverduesForBranch 
31
                       AddNotifyLine 
30
                       AddNotifyLine 
(-)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