Bug 16849: Move IsDebarred to Koha::Patron->is_debarred
[koha.git] / Koha / Patron.pm
1 package Koha::Patron;
2
3 # Copyright ByWater Solutions 2014
4 # Copyright PTFS Europe 2016
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 3 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 use Modern::Perl;
22
23 use Carp;
24
25 use C4::Context;
26 use Koha::Database;
27 use Koha::DateUtils;
28 use Koha::Issues;
29 use Koha::OldIssues;
30 use Koha::Patron::Categories;
31 use Koha::Patron::Images;
32 use Koha::Patrons;
33
34 use base qw(Koha::Object);
35
36 =head1 NAME
37
38 Koha::Patron - Koha Patron Object class
39
40 =head1 API
41
42 =head2 Class Methods
43
44 =cut
45
46 =head3 guarantor
47
48 Returns a Koha::Patron object for this patron's guarantor
49
50 =cut
51
52 sub guarantor {
53     my ( $self ) = @_;
54
55     return unless $self->guarantorid();
56
57     return Koha::Patrons->find( $self->guarantorid() );
58 }
59
60 sub image {
61     my ( $self ) = @_;
62
63     return Koha::Patron::Images->find( $self->borrowernumber )
64 }
65
66 =head3 guarantees
67
68 Returns the guarantees (list of Koha::Patron) of this patron
69
70 =cut
71
72 sub guarantees {
73     my ( $self ) = @_;
74
75     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
76 }
77
78 =head3 siblings
79
80 Returns the siblings of this patron.
81
82 =cut
83
84 sub siblings {
85     my ( $self ) = @_;
86
87     my $guarantor = $self->guarantor;
88
89     return unless $guarantor;
90
91     return Koha::Patrons->search(
92         {
93             guarantorid => {
94                 '!=' => undef,
95                 '=' => $guarantor->id,
96             },
97             borrowernumber => {
98                 '!=' => $self->borrowernumber,
99             }
100         }
101     );
102 }
103
104 =head3 wants_check_for_previous_checkout
105
106     $wants_check = $patron->wants_check_for_previous_checkout;
107
108 Return 1 if Koha needs to perform PrevIssue checking, else 0.
109
110 =cut
111
112 sub wants_check_for_previous_checkout {
113     my ( $self ) = @_;
114     my $syspref = C4::Context->preference("checkPrevCheckout");
115
116     # Simple cases
117     ## Hard syspref trumps all
118     return 1 if ($syspref eq 'hardyes');
119     return 0 if ($syspref eq 'hardno');
120     ## Now, patron pref trumps all
121     return 1 if ($self->checkprevcheckout eq 'yes');
122     return 0 if ($self->checkprevcheckout eq 'no');
123
124     # More complex: patron inherits -> determine category preference
125     my $checkPrevCheckoutByCat = Koha::Patron::Categories
126         ->find($self->categorycode)->checkprevcheckout;
127     return 1 if ($checkPrevCheckoutByCat eq 'yes');
128     return 0 if ($checkPrevCheckoutByCat eq 'no');
129
130     # Finally: category preference is inherit, default to 0
131     if ($syspref eq 'softyes') {
132         return 1;
133     } else {
134         return 0;
135     }
136 }
137
138 =head3 do_check_for_previous_checkout
139
140     $do_check = $patron->do_check_for_previous_checkout($item);
141
142 Return 1 if the bib associated with $ITEM has previously been checked out to
143 $PATRON, 0 otherwise.
144
145 =cut
146
147 sub do_check_for_previous_checkout {
148     my ( $self, $item ) = @_;
149
150     # Find all items for bib and extract item numbers.
151     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
152     my @item_nos;
153     foreach my $item (@items) {
154         push @item_nos, $item->itemnumber;
155     }
156
157     # Create (old)issues search criteria
158     my $criteria = {
159         borrowernumber => $self->borrowernumber,
160         itemnumber => \@item_nos,
161     };
162
163     # Check current issues table
164     my $issues = Koha::Issues->search($criteria);
165     return 1 if $issues->count; # 0 || N
166
167     # Check old issues table
168     my $old_issues = Koha::OldIssues->search($criteria);
169     return $old_issues->count;  # 0 || N
170 }
171
172 =head2 is_debarred
173
174 my $debarment_expiration = $patron->is_debarred;
175
176 Returns the date a patron debarment will expire, or undef if the patron is not
177 debarred
178
179 =cut
180
181 sub is_debarred {
182     my ($self) = @_;
183
184     return unless $self->debarred;
185     return $self->debarred
186       if $self->debarred =~ '^9999'
187       or dt_from_string( $self->debarred ) > dt_from_string;
188     return;
189 }
190
191 =head3 type
192
193 =cut
194
195 sub _type {
196     return 'Borrower';
197 }
198
199 =head1 AUTHOR
200
201 Kyle M Hall <kyle@bywatersolutions.com>
202 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
203
204 =cut
205
206 1;