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